Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-24 19:13:10
|
Log Message:
-----------
Fixed conceptual error in compare_vec_solution. This should fix bug
#670. In my opinion the entire concept of vec_solution_cmp should be
reconsidered. In solving an underdetermined linear equation of the form
Ax-b=0 it seems to me that the solutions answer in the form:
x= a +bt+cu+ds where a,b,c,d are vectors should simply be evaluated
to see if it satisfies Ax-b=0 for 5 or six values of a,b,c,d --
checking the solution should use a
vector valued version of fun_cmp.
As it is, the student's coefficients for a,b,c,d are compared with the
instructors to see if they span the same space. This is quite a bit more
complicated -- and indeed the method came up with the wrong answer.
I believe I have the method corrected, but I would suggest that this
answer evaluator be replaced with one which operates more
directly and is therefore easier to maintain. Am I missing something in
this analysis? Has someone else created answer evaluators for this type
of problem?
-- Mike
Tags:
----
rel-2-1-patches
Modified Files:
--------------
pg/macros:
PGmorematrixmacros.pl
Revision Data
-------------
Index: PGmorematrixmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGmorematrixmacros.pl,v
retrieving revision 1.17
retrieving revision 1.17.8.1
diff -Lmacros/PGmorematrixmacros.pl -Lmacros/PGmorematrixmacros.pl -u -r1.17 -r1.17.8.1
--- macros/PGmorematrixmacros.pl
+++ macros/PGmorematrixmacros.pl
@@ -1,5 +1,5 @@
BEGIN{
- be_strict();
+ be_strict();
}
sub _PGmorematrixmacros_init{}
@@ -31,24 +31,24 @@
=cut
sub random_diag_matrix{ ## Builds and returns a random diagonal \$n by \$n matrix
-
- warn "Usage: \$new_matrix = random_diag_matrix(\$n)" if (@_ != 1);
-
- my $D = new Matrix($_[0],$_[0]);
- my $norm = 0;
- while( $norm == 0 ){
- foreach my $i (1..$_[0]){
- foreach my $j (1..$_[0]){
- if( $i != $j ){
- $D->assign($i,$j,0);
- }else{
- $D->assign($i,$j,random(-9,9,1));
- }
- }
- }
- $norm = abs($D);
- }
- return $D;
+
+ warn "Usage: \$new_matrix = random_diag_matrix(\$n)" if (@_ != 1);
+
+ my $D = new Matrix($_[0],$_[0]);
+ my $norm = 0;
+ while( $norm == 0 ){
+ foreach my $i (1..$_[0]){
+ foreach my $j (1..$_[0]){
+ if( $i != $j ){
+ $D->assign($i,$j,0);
+ }else{
+ $D->assign($i,$j,random(-9,9,1));
+ }
+ }
+ }
+ $norm = abs($D);
+ }
+ return $D;
}
sub swap_rows{
@@ -112,62 +112,62 @@
ANS( basis_cmp( vectors_as_array_ref_in_array_ref, options_hash ) );
- 1. a reference to an array of correct vectors
- 2. a hash with the following keys (all optional):
- mode -- 'basis' (default) (only a basis allowed)
- 'orthogonal' (only an orthogonal basis is allowed)
- 'unit' (only unit vectors in the basis allowed)
- 'orthonormal' (only orthogonal unit vectors in basis allowed)
- zeroLevelTol -- absolute tolerance to allow when answer is close
- to zero
-
- debug -- if set to 1, provides verbose listing of
- hash entries throughout fliters.
-
- help -- 'none' (default) (is quiet on all errors)
- 'dim' (Tells student if wrong number of vectors are entered)
- 'length' (Tells student if there is a vector of the wrong length)
- 'orthogonal' (Tells student if their vectors are not orthogonal)
- (This is only in orthogonal mode)
- 'unit' (Tells student if there is a vector not of unit length)
- (This is only in unit mode)
- 'orthonormal' (Gives errors from orthogonal and orthonormal)
- (This is only in orthonormal mode)
- 'verbose' (Gives all the above answer messages)
+ 1. a reference to an array of correct vectors
+ 2. a hash with the following keys (all optional):
+ mode -- 'basis' (default) (only a basis allowed)
+ 'orthogonal' (only an orthogonal basis is allowed)
+ 'unit' (only unit vectors in the basis allowed)
+ 'orthonormal' (only orthogonal unit vectors in basis allowed)
+ zeroLevelTol -- absolute tolerance to allow when answer is close
+ to zero
+
+ debug -- if set to 1, provides verbose listing of
+ hash entries throughout fliters.
+
+ help -- 'none' (default) (is quiet on all errors)
+ 'dim' (Tells student if wrong number of vectors are entered)
+ 'length' (Tells student if there is a vector of the wrong length)
+ 'orthogonal' (Tells student if their vectors are not orthogonal)
+ (This is only in orthogonal mode)
+ 'unit' (Tells student if there is a vector not of unit length)
+ (This is only in unit mode)
+ 'orthonormal' (Gives errors from orthogonal and orthonormal)
+ (This is only in orthonormal mode)
+ 'verbose' (Gives all the above answer messages)
- Returns an answer evaluator.
+ Returns an answer evaluator.
EXAMPLES:
- basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
- -- correct answer is any basis for R^3.
- basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
- -- correct answer is any orthonormal basis
- for this space such as:
- [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
+ basis_cmp([[1,0,0],[0,1,0],[0,0,1]])
+ -- correct answer is any basis for R^3.
+ basis_cmp([1,0,2,0],[0,1,0,0], 'mode'=>orthonormal )
+ -- correct answer is any orthonormal basis
+ for this space such as:
+ [1/sqrt(3),0,2/sqrt(3),0],[0,1,0,0]
=cut
sub basis_cmp {
- my $correctAnswer = shift;
- my %opt = @_;
+ my $correctAnswer = shift;
+ my %opt = @_;
- set_default_options( \%opt,
- 'zeroLevelTol' => $main::functZeroLevelTolDefault,
- 'debug' => 0,
- 'mode' => 'basis',
- 'help' => 'none',
- );
-
- # produce answer evaluator
- BASIS_CMP(
- 'correct_ans' => $correctAnswer,
- 'zeroLevelTol' => $opt{'zeroLevelTol'},
- 'debug' => $opt{'debug'},
- 'mode' => $opt{'mode'},
- 'help' => $opt{'help'},
- );
+ set_default_options( \%opt,
+ 'zeroLevelTol' => $main::functZeroLevelTolDefault,
+ 'debug' => 0,
+ 'mode' => 'basis',
+ 'help' => 'none',
+ );
+
+ # produce answer evaluator
+ BASIS_CMP(
+ 'correct_ans' => $correctAnswer,
+ 'zeroLevelTol' => $opt{'zeroLevelTol'},
+ 'debug' => $opt{'debug'},
+ 'mode' => $opt{'mode'},
+ 'help' => $opt{'help'},
+ );
}
=head BASIS_CMP
@@ -177,193 +177,199 @@
=cut
sub BASIS_CMP {
- my %mat_params = @_;
- my $zeroLevelTol = $mat_params{'zeroLevelTol'};
-
- # Check that everything is defined:
- $mat_params{debug} = 0 unless defined($mat_params{debug});
- $zeroLevelTol = $main::functZeroLevelTolDefault unless defined $zeroLevelTol;
- $mat_params{'zeroLevelTol'} = $zeroLevelTol;
+ my %mat_params = @_;
+ my $zeroLevelTol = $mat_params{'zeroLevelTol'};
+
+ # Check that everything is defined:
+ $mat_params{debug} = 0 unless defined($mat_params{debug});
+ $zeroLevelTol = $main::functZeroLevelTolDefault unless defined $zeroLevelTol;
+ $mat_params{'zeroLevelTol'} = $zeroLevelTol;
## This is where the correct answer should be checked someday.
- my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
+ my $matrix = Matrix->new_from_col_vecs($mat_params{'correct_ans'});
#construct the answer evaluator
- my $answer_evaluator = new AnswerEvaluator;
+ my $answer_evaluator = new AnswerEvaluator;
$answer_evaluator->{debug} = $mat_params{debug};
- $answer_evaluator->ans_hash(
- correct_ans => display_correct_vecs($mat_params{correct_ans}),
- rm_correct_ans => $matrix,
- zeroLevelTol => $mat_params{zeroLevelTol},
- debug => $mat_params{debug},
- mode => $mat_params{mode},
- help => $mat_params{help},
+ $answer_evaluator->ans_hash(
+ correct_ans => display_correct_vecs($mat_params{correct_ans}),
+ rm_correct_ans => $matrix,
+ zeroLevelTol => $mat_params{zeroLevelTol},
+ debug => $mat_params{debug},
+ mode => $mat_params{mode},
+ help => $mat_params{help},
);
- $answer_evaluator->install_pre_filter(
- sub {my $rh_ans = shift;
- $rh_ans->{_filter_name} = 'remove_white_space';
- $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace
- $rh_ans;
- }
- );
- $answer_evaluator->install_pre_filter(
- sub{my $rh_ans = shift;
- my @options = @_;
- $rh_ans->{_filter_name} = 'mung_student_answer';
- if( $rh_ans->{ans_label} =~ /ArRaY/ ){
- $rh_ans = ans_array_filter($rh_ans,@options);
- my @student_array = @{$rh_ans->{ra_student_ans}};
- my @array = ();
- for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
- {
- push( @array, Matrix->new_from_array_ref($student_array[$i]));
- }
- $rh_ans->{ra_student_ans} = \@array;
- $rh_ans;
- }else{
- $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
- vec_list_string($rh_ans, '_filter_name' => 'vec_list_string', @options);
- }
- }
- );#ra_student_ans is now the students answer as an array of vectors
- # anonymous subroutine to check dimension and length of the student vectors
- # if either is wrong, the answer is wrong.
- $answer_evaluator->install_pre_filter(
- sub{
- my $rh_ans = shift;
- $rh_ans->{_filter_name} = 'check_vector_size';
- my $length = $rh_ans->{rm_correct_ans}->[1];
- my $dim = $rh_ans->{rm_correct_ans}->[2];
- if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
- {
-
- $rh_ans->{score} = 0;
- if( $rh_ans->{help} =~ /dim|verbose/ )
- {
- $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
- }else{
- $rh_ans->throw_error('EVAL');
- }
- }
- for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
- {
- if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
- {
- $rh_ans->{score} = 0;
- if( $rh_ans->{help} =~ /length|verbose/ )
- {
- $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
- }else{
- $rh_ans->throw_error('EVAL');
- }
- }
- }
- $rh_ans;
- }
- );
- # Install prefilter for various modes
- if( $mat_params{mode} ne 'basis' )
- {
- if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
- {
- $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
- }
-
- if( $mat_params{mode} =~ /unit|orthonormal/ )
- {
- $answer_evaluator->install_pre_filter(\&are_unit_vecs);
-
- }
- }
- $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
- $answer_evaluator->install_post_filter(
- sub {my $rh_ans = shift;
- if ($rh_ans->catch_error('SYNTAX') ) {
- $rh_ans->{ans_message} = $rh_ans->{error_message};
- $rh_ans->clear_error('SYNTAX');
- }
- if ($rh_ans->catch_error('EVAL') ) {
- $rh_ans->{ans_message} = $rh_ans->{error_message};
- $rh_ans->clear_error('EVAL');
- }
- $rh_ans;
- }
- );
- $answer_evaluator;
+ $answer_evaluator->install_pre_filter(
+ sub {my $rh_ans = shift;
+ $rh_ans->{_filter_name} = 'remove_white_space';
+ $rh_ans->{student_ans} =~ s/\s+//g; # remove all whitespace
+ $rh_ans;
+ }
+ );
+ $answer_evaluator->install_pre_filter(
+ sub{my $rh_ans = shift;
+ my @options = @_;
+ $rh_ans->{_filter_name} = 'mung_student_answer';
+ if( $rh_ans->{ans_label} =~ /ArRaY/ ){
+ $rh_ans = ans_array_filter($rh_ans,@options);
+ my @student_array = @{$rh_ans->{ra_student_ans}};
+ my @array = ();
+ for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
+ {
+ push( @array, Matrix->new_from_array_ref($student_array[$i]));
+ }
+ $rh_ans->{ra_student_ans} = \@array;
+ $rh_ans;
+ }else{
+ $rh_ans->{student_ans} = math_constants($rh_ans->{student_ans});
+ vec_list_string($rh_ans, '_filter_name' => 'vec_list_string', @options);
+ }
+ }
+ );#ra_student_ans is now the students answer as an array of vectors
+ # anonymous subroutine to check dimension and length of the student vectors
+ # if either is wrong, the answer is wrong.
+ $answer_evaluator->install_pre_filter(
+ sub{
+ my $rh_ans = shift;
+ $rh_ans->{_filter_name} = 'check_vector_size';
+ my $length = $rh_ans->{rm_correct_ans}->[1];
+ my $dim = $rh_ans->{rm_correct_ans}->[2];
+ if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
+ {
+
+ $rh_ans->{score} = 0;
+ if( $rh_ans->{help} =~ /dim|verbose/ )
+ {
+ $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
+ }else{
+ $rh_ans->throw_error('EVAL');
+ }
+ }
+ for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
+ {
+ if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
+ {
+ $rh_ans->{score} = 0;
+ if( $rh_ans->{help} =~ /length|verbose/ )
+ {
+ $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
+ }else{
+ $rh_ans->throw_error('EVAL');
+ }
+ }
+ }
+ $rh_ans;
+ }
+ );
+ # Install prefilter for various modes
+ if( $mat_params{mode} ne 'basis' )
+ {
+ if( $mat_params{mode} =~ /orthogonal|orthonormal/ )
+ {
+ $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
+ }
+
+ if( $mat_params{mode} =~ /unit|orthonormal/ )
+ {
+ $answer_evaluator->install_pre_filter(\&are_unit_vecs);
+
+ }
+ }
+ $answer_evaluator->install_evaluator(\&compare_basis, %mat_params);
+ $answer_evaluator->install_post_filter(
+ sub {my $rh_ans = shift;
+ if ($rh_ans->catch_error('SYNTAX') ) {
+ $rh_ans->{ans_message} = $rh_ans->{error_message};
+ $rh_ans->clear_error('SYNTAX');
+ }
+ if ($rh_ans->catch_error('EVAL') ) {
+ $rh_ans->{ans_message} = $rh_ans->{error_message};
+ $rh_ans->clear_error('EVAL');
+ }
+ $rh_ans;
+ }
+ );
+ $answer_evaluator;
}
=head4 compare_basis
- compare_basis( $ans_hash, %options);
+ compare_basis( $ans_hash,
+ %options
+ ra_student_ans # a reference to the array of students answer vectors
+ rm_correct_ans, # a reference to the correct answer matrix
+ %options
+ )
- {ra_student_ans}, # a reference to the array of students answer vectors
- {rm_correct_ans}, # a reference to the correct answer matrix
- %options
- )
=cut
+
+
sub compare_basis {
- my ($rh_ans, %options) = @_;
- my @ch_coord;
- my @vecs = @{$rh_ans->{ra_student_ans}};
-
- # A lot of the follosing code was taken from Matrix::proj_coeff
- # calling this method recursively would be a waste of time since
- # the prof's matrix never changes and solve_LR is an expensive
- # operation. This way it is only done once.
- my $matrix = $rh_ans->{rm_correct_ans};
- my ($dim,$x_vector, $base_matrix);
- my $errors = undef;
- my $lin_space_tr= ~ $matrix;
- $matrix = $lin_space_tr * $matrix;
- my $matrix_lr = $matrix->decompose_LR();
-
- #finds the coefficient vectors for each of the students vectors
- for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ )
- {
-
- $vecs[$i] = $lin_space_tr*$vecs[$i];
- ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
- push( @ch_coord, $x_vector );
- $errors = "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" if $dim; # only print if the dim is not zero.
- }
-
- if( defined($errors))
- {
- $rh_ans->throw_error('EVAL', $errors) ;
- }else{
- my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);#creates change of coordinate matrix
- #existence of this matrix implies that
- #the all of the students answers are a
- #linear combo of the prof's
- $ch_coord_mat = $ch_coord_mat->decompose_LR();
-
- if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} )# if the det of the change of coordinate matrix is
- # non-zero, this implies the existence of an inverse
- # which implies all of the prof's vectors are a linear
- # combo of the students vectors, showing containment
- # both ways.
- {
- # I think sometimes if the students space has the same dimension as the profs space it
- # will get projected into the profs space even if it isn't a basis for that space.
- # this just checks that the prof's matrix times the change of coordinate matrix is actually
- #the students matrix
- if( abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) - ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord))) < $options{zeroLevelTol} )
- {
- $rh_ans->{score} = 1;
- }else{
- $rh_ans->{score} = 0;
- }
- }
- else{
- $rh_ans->{score}=0;
- }
- }
- $rh_ans;
-
+ my ($rh_ans, %options) = @_;
+ $rh_ans->{_filter_name} = "compare_basis";
+ my @ch_coord;
+ my @vecs = @{$rh_ans->{ra_student_ans}};
+
+ # A lot of the following code was taken from Matrix::proj_coeff
+ # calling this method recursively would be a waste of time since
+ # the prof's matrix never changes and solve_LR is an expensive
+ # operation. This way it is only done once.
+ my $matrix = $rh_ans->{rm_correct_ans};
+ my ($dim,$x_vector, $base_matrix);
+ my $errors = undef;
+ my $lin_space_tr= ~ $matrix; #transpose of the matrix
+ $matrix = $lin_space_tr * $matrix; #(~A * A)
+ my $matrix_lr = $matrix->decompose_LR();
+
+ #finds the coefficient vectors for each of the students vectors
+ for( my $i = 0; $i < scalar(@{$rh_ans->{ra_student_ans}}) ; $i++ ) {
+
+ $vecs[$i] = $lin_space_tr*$vecs[$i];
+ ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($vecs[$i]);
+ push( @ch_coord, $x_vector );
+ $errors = "A unique adapted answer could not be determined.
+ Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix
+ is $base_matrix\n" if $dim; # only print if the dim is not zero.
+ }
+
+ if( defined($errors)) {
+ $rh_ans->throw_error('EVAL', $errors) ;
+ } else {
+ my $ch_coord_mat = Matrix->new_from_col_vecs(\@ch_coord);
+ #creates change of coordinate matrix
+ #existence of this matrix implies that
+ #the all of the students answers are a
+ #linear combo of the prof's
+ $ch_coord_mat = $ch_coord_mat->decompose_LR();
+
+ if( abs($ch_coord_mat->det_LR()) > $options{zeroLevelTol} ) {
+ # if the det of the change of coordinate matrix is
+ # non-zero, this implies the existence of an inverse
+ # which implies all of the prof's vectors are a linear
+ # combo of the students vectors, showing containment
+ # both ways.
+
+ # I think sometimes if the students space has the same dimension as the profs space it
+ # will get projected into the profs space even if it isn't a basis for that space.
+ # this just checks that the prof's matrix times the change of coordinate matrix is actually
+ #the students matrix
+ if( abs(Matrix->new_from_col_vecs(\@{$rh_ans->{ra_student_ans}}) -
+ ($rh_ans->{rm_correct_ans})*(Matrix->new_from_col_vecs(\@ch_coord)))
+ < $options{zeroLevelTol} ) {
+ $rh_ans->{score} = 1;
+ } else {
+ $rh_ans->{score} = 0;
+ }
+ } else {
+ $rh_ans->{score}=0;
+ }
+ }
+ $rh_ans;
+
}
@@ -378,568 +384,565 @@
but a unmatched close parenthesis ends the vector, and since everything outside is ignored, no error is sent (other than the
later when the length of the vectors is checked.
In the end, the method returns an array of Matrix objects.
-
+
=cut
sub vec_list_string{
- my $rh_ans = shift;
- my %options = @_;
- my $i;
- my $entry = "";
- my $char;
- my @paren_stack;
- my $length = length($rh_ans->{student_ans});
- my @temp;
- my $j = 0;
- my @answers;
- my $paren;
- my $display_ans;
-
- for( $i = 0; $i < $length ; $i++ )
- {
- $char = substr($rh_ans->{student_ans},$i,1);
-
- if( $char =~ /\(|\[|\{/ ){
- push( @paren_stack, $char )
- }
-
- if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) )
- {
- if( $char !~ /,|\)|\]|\}/ ){
- $entry .= $char;
- }else{
- if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) )
- {
- if( length($entry) == 0 ){
- if( $char !~ /,/ ){
- $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
- }else{
- $rh_ans->{preview_text_string} .= ",";
- $rh_ans->{preview_latex_string} .= ",";
- $display_ans .= ",";
- }
- }else{
-
- # This parser code was origianally taken from PGanswermacros::check_syntax
- # but parts of it needed to be slighty modified for this context
- my $parser = new AlgParserWithImplicitExpand;
- my $ret = $parser -> parse($entry); #for use with loops
-
- if ( ref($ret) ) { ## parsed successfully
- $parser -> tostring();
- $parser -> normalize();
- $entry = $parser -> tostring();
- $rh_ans->{preview_text_string} .= $entry.",";
- $rh_ans->{preview_latex_string} .= $parser -> tolatex().",";
-
- } else { ## error in parsing
-
- $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
- $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
- $rh_ans->{'preview_text_string'} = '',
- $rh_ans->{'preview_latex_string'} = '',
- $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
- }
-
- my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
-
- if ($PG_eval_errors) {
- $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
- $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
- last;
- } else {
- $entry = prfmt($inVal,$options{format});
- $display_ans .= $entry.",";
- push(@temp , $entry);
- }
-
- if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1)
- {
- pop @paren_stack;
- chop($rh_ans->{preview_text_string});
- chop($rh_ans->{preview_latex_string});
- chop($display_ans);
- $rh_ans->{preview_text_string} .= "]";
- $rh_ans->{preview_latex_string} .= "]";
- $display_ans .= "]";
- if( scalar(@temp) > 0 )
- {
- push( @answers,Matrix->new_from_col_vecs([\@temp]));
- while(scalar(@temp) > 0 ){
- pop @temp;
- }
- }else{
- $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
- }
- }
- }
- $entry = "";
- }else{
- $paren = pop @paren_stack;
- if( scalar(@paren_stack) > 0 ){
- #this uses ASCII to check if the parens match up
- # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
- # ord ] = 93 , ord { = 123 , ord } = 125
- if( (ord($char) - ord($paren) <= 2) ){
- $entry = $entry . $char;
- }else{
- $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
- }
- }
- }
- }
- }else{
- $rh_ans->{preview_text_string} .= "[";
- $rh_ans->{preview_latex_string} .= "[";
- $display_ans .= "[";
- }
- }
- $rh_ans->{ra_student_ans} = \@answers;
- $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
- $rh_ans;
+ my $rh_ans = shift;
+ my %options = @_;
+ my $i;
+ my $entry = "";
+ my $char;
+ my @paren_stack;
+ my $length = length($rh_ans->{student_ans});
+ my @temp;
+ my $j = 0;
+ my @answers;
+ my $paren;
+ my $display_ans;
+
+ for( $i = 0; $i < $length ; $i++ ) {
+ $char = substr($rh_ans->{student_ans},$i,1);
+
+ if( $char =~ /\(|\[|\{/ ){
+ push( @paren_stack, $char )
+ }
+
+ if( !( $char =~ /\(|\[|\{/ && scalar(@paren_stack) == 1 ) ) {
+ if( $char !~ /,|\)|\]|\}/ ){
+ $entry .= $char;
+ } else {
+ if( $char =~ /,/ || ( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1 ) ) {
+ if( length($entry) == 0 ){
+ if( $char !~ /,/ ){
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
+ } else {
+ $rh_ans->{preview_text_string} .= ",";
+ $rh_ans->{preview_latex_string} .= ",";
+ $display_ans .= ",";
+ }
+ } else {
+
+ # This parser code was origianally taken from PGanswermacros::check_syntax
+ # but parts of it needed to be slighty modified for this context
+ my $parser = new AlgParserWithImplicitExpand;
+ my $ret = $parser -> parse($entry); #for use with loops
+
+ if ( ref($ret) ) { ## parsed successfully
+ $parser -> tostring();
+ $parser -> normalize();
+ $entry = $parser -> tostring();
+ $rh_ans->{preview_text_string} .= $entry.",";
+ $rh_ans->{preview_latex_string} .= $parser -> tolatex().",";
+
+ } else { ## error in parsing
+
+ $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
+ $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
+ $rh_ans->{'preview_text_string'} = '',
+ $rh_ans->{'preview_latex_string'} = '',
+ $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
+ }
+
+ my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
+
+ if ($PG_eval_errors) {
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
+ $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
+ last;
+ } else {
+ $entry = prfmt($inVal,$options{format});
+ $display_ans .= $entry.",";
+ push(@temp , $entry);
+ }
+
+ if( $char =~ /\)|\]|\}/ && scalar(@paren_stack) == 1) {
+ pop @paren_stack;
+ chop($rh_ans->{preview_text_string});
+ chop($rh_ans->{preview_latex_string});
+ chop($display_ans);
+ $rh_ans->{preview_text_string} .= "]";
+ $rh_ans->{preview_latex_string} .= "]";
+ $display_ans .= "]";
+ if( scalar(@temp) > 0 ) {
+ push( @answers,Matrix->new_from_col_vecs([\@temp]));
+ while(scalar(@temp) > 0 ){
+ pop @temp;
+ }
+ } else {
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer.');
+ }
+ }
+ }
+ $entry = "";
+ } else {
+ $paren = pop @paren_stack;
+ if( scalar(@paren_stack) > 0 ){
+ #this uses ASCII to check if the parens match up
+ # in ASCII ord ( = 40 , ord ) = 41 , ord [ = 91 ,
+ # ord ] = 93 , ord { = 123 , ord } = 125
+ if( (ord($char) - ord($paren) <= 2) ){
+ $entry = $entry . $char;
+ }else{
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer');
+ }
+ }
+ }
+ }
+ } else {
+ $rh_ans->{preview_text_string} .= "[";
+ $rh_ans->{preview_latex_string} .= "[";
+ $display_ans .= "[";
+ }
+ }
+ $rh_ans->{ra_student_ans} = \@answers;
+ $rh_ans->{student_ans} = $display_ans unless $rh_ans->{error_flag};
+ $rh_ans;
}
=head5
- This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
- answer entry methods. Running this filter is necessary to get all the entries out of the answer
- hash. Each entry is evaluated and the resulting number is put in the display for student answer
- as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
- and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
- for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
- string is also created, but this display method becomes confusing when large matrices are used.
+
+ This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension
+ answer entry methods. Running this filter is necessary to get all the entries out of the answer
+ hash. Each entry is evaluated and the resulting number is put in the display for student answer
+ as a string. For evaluation purposes an array of arrays of arrays is created called ra_student_ans
+ and placed in the hash. The entries are [array_number][row_number][column_number]. The latex strings
+ for each entry are taken from the parser and put, as a matrix, into the previewer. The preview text
+ string is also created, but this display method becomes confusing when large matrices are used.
+
=cut
sub ans_array_filter{
- my $rh_ans = shift;
- my %options = @_;
-# assign_option_aliases( \%opt,
+ my $rh_ans = shift;
+ my %options = @_;
+# assign_option_aliases( \%opt,
# );
- set_default_options(\%options,
- '_filter_name' => 'ans_array_filter',
- );
-# $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/; # CHANGE made to accomodate HTML 4.01 standards for name attribute
- $rh_ans->{ans_label} =~ /ArRaY(\d+)\_\_\d+:\d+:\d+\_\_/;
- my $ans_num = $1;
- my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
- my $key;
- my @array = ();
- my ($i,$j,$k) = (0,0,0);
-
- #the keys aren't in order, so their info has to be put into the array before doing anything with it
- foreach $key (@keys){
-# $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
-# ($i,$j,$k) = ($1,$2,$3);
-# $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
- $key =~ /ArRaY\d+\_\_(\d+):(\d+):(\d+)\_\_/;
- ($i,$j,$k) = ($1,$2,$3);
- $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'__'.$i.':'.$j.':'.$k.'__'};
-
- }
- $rh_ans->{debug_student_answer }= \@array;
- my $display_ans = "";
-
- for( $i=0; $i < scalar(@array) ; $i ++ )
- {
- $display_ans .= " [";
- $rh_ans->{preview_text_string} .= ' [';
- $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
- for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ )
- {
- $display_ans .= " [";
- $rh_ans->{preview_text_string} .= ' [';
- for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
- my $entry = $array[$i][$j][$k];
- $entry = math_constants($entry);
- # This parser code was origianally taken from PGanswermacros::check_syntax
- # but parts of it needed to be slighty modified for this context
- my $parser = new AlgParserWithImplicitExpand;
- my $ret = $parser -> parse($entry); #for use with loops
-
- if ( ref($ret) ) { ## parsed successfully
- $parser -> tostring();
- $parser -> normalize();
- $entry = $parser -> tostring();
- $rh_ans->{preview_text_string} .= $entry.",";
- $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
-
- } else { ## error in parsing
- $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
- $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
- $rh_ans->{'preview_text_string'} = '',
- $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
- }
-
- my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
- if ($PG_eval_errors) {
- $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
- $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
- last;
- } else {
- $entry = prfmt($inVal,$options{format});
- $display_ans .= $entry.",";
- $array[$i][$j][$k] = $entry;
- }
- }
- chop($rh_ans->{preview_text_string});
- chop($display_ans);
- $rh_ans->{preview_text_string} .= '] ,';
- $rh_ans->{preview_latex_string} .= '\\\\';
- $display_ans .= '] ,';
-
- }
- chop($rh_ans->{preview_text_string});
- chop($display_ans);
+ set_default_options(\%options,
+ _filter_name => 'ans_array_filter',
+ );
+# $rh_ans->{ans_label} =~ /ArRaY(\d+)\[\d+,\d+,\d+\]/; # CHANGE made to accomodate HTML 4.01 standards for name attribute
+ $rh_ans->{ans_label} =~ /ArRaY(\d+)\_\_\d+:\d+:\d+\_\_/;
+ my $ans_num = $1;
+ my @keys = grep /ArRaY$ans_num/, keys(%{$main::inputs_ref});
+ my $key;
+ my @array = ();
+ my ($i,$j,$k) = (0,0,0);
+
+ #the keys aren't in order, so their info has to be put into the array before doing anything with it
+ foreach $key (@keys){
+# $key =~ /ArRaY\d+\[(\d+),(\d+),(\d+)\]/;
+# ($i,$j,$k) = ($1,$2,$3);
+# $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'['.$i.','.$j.','.$k.']'};
+ $key =~ /ArRaY\d+\_\_(\d+):(\d+):(\d+)\_\_/;
+ ($i,$j,$k) = ($1,$2,$3);
+ $array[$i][$j][$k] = ${$main::inputs_ref}{'ArRaY'.$ans_num.'__'.$i.':'.$j.':'.$k.'__'};
+
+ }
+ #$rh_ans->{debug_student_answer }= \@array;
+ my $display_ans = "";
+
+ for( $i=0; $i < scalar(@array) ; $i ++ ) {
+ $display_ans .= " [";
+ $rh_ans->{preview_text_string} .= ' [';
+ $rh_ans->{preview_latex_string} .= '\begin{pmatrix} ';
+ for( $j = 0; $j < scalar( @{$array[$i]} ) ; $j++ ) {
+ $display_ans .= " [";
+ $rh_ans->{preview_text_string} .= ' [';
+ for( $k = 0; $k < scalar( @{$array[$i][$j]} ) ; $k ++ ){
+ my $entry = $array[$i][$j][$k];
+ $entry = math_constants($entry);
+ # This parser code was origianally taken from PGanswermacros::check_syntax
+ # but parts of it needed to be slighty modified for this context
+ my $parser = new AlgParserWithImplicitExpand;
+ my $ret = $parser -> parse($entry); #for use with loops
+
+ if ( ref($ret) ) { ## parsed successfully
+ $parser -> tostring();
+ $parser -> normalize();
+ $entry = $parser -> tostring();
+ $rh_ans->{preview_text_string} .= $entry.",";
+ $rh_ans->{preview_latex_string} .= $parser -> tolatex() . '& ';
+
+ } else { ## error in parsing
+ $rh_ans->{'student_ans'} = 'syntax error:'.$display_ans. $parser->{htmlerror},
+ $rh_ans->{'ans_message'} = $display_ans.$parser -> {error_msg},
+ $rh_ans->{'preview_text_string'} = '',
+ $rh_ans->throw_error('SYNTAX', 'syntax error in answer:'.$display_ans.$parser->{htmlerror} . "$main::BR" .$parser -> {error_msg}.".$main::BR");
+ }
+
+ my ($inVal,$PG_eval_errors,$PG_full_error_report) = PG_answer_eval($entry);
+ if ($PG_eval_errors) {
+ $rh_ans->throw_error('EVAL','There is a syntax error in your answer.') ;
+ $rh_ans->{ans_message} = clean_up_error_msg($PG_eval_errors);
+ last;
+ } else {
+ $entry = prfmt($inVal,$options{format});
+ $display_ans .= $entry.",";
+ $array[$i][$j][$k] = $entry;
+ }
+ }
+ chop($rh_ans->{preview_text_string});
+ chop($display_ans);
+ $rh_ans->{preview_text_string} .= '] ,';
+ $rh_ans->{preview_latex_string} .= '\\\\';
+ $display_ans .= '] ,';
+
+ }
+ chop($rh_ans->{preview_text_string});
+ chop($display_ans);
$rh_ans->{preview_text_string} .= '] ,';
$rh_ans->{preview_latex_string} .= '\end{pmatrix}'.' , ';
- $display_ans .= '] ,';
- }
- chop($rh_ans->{preview_text_string});
- chop($rh_ans->{preview_latex_string});
- chop($rh_ans->{preview_latex_string});
- chop($rh_ans->{preview_latex_string});
- chop($display_ans);
-
- my @temp = ();
- for( $i = 0 ; $i < scalar( @array ); $i++ ){
- push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
- push @temp , "," unless $i == scalar(@array) - 1;
- }
- $rh_ans->{student_ans} = mbox(\@temp);
- $rh_ans->{ra_student_ans} = \@array;
-
- $rh_ans;
+ $display_ans .= '] ,';
+ }
+ chop($rh_ans->{preview_text_string});
+ chop($rh_ans->{preview_latex_string});
+ chop($rh_ans->{preview_latex_string});
+ chop($rh_ans->{preview_latex_string});
+ chop($display_ans);
+
+ my @temp = ();
+ for( $i = 0 ; $i < scalar( @array ); $i++ ){
+ push @temp , display_matrix($array[$i], 'left'=>'.', 'right'=>'.');
+ push @temp , "," unless $i == scalar(@array) - 1;
+ }
+ $rh_ans->{student_ans} = mbox(\@temp);
+ $rh_ans->{ra_student_ans} = \@array;
+
+ $rh_ans;
}
sub are_orthogonal_vecs{
- my ($vec_ref , %opts) = @_;
- $vec_ref->{_filter_name} = 'are_orthogonal_vecs';
- my @vecs = ();
- if( ref($vec_ref) eq 'AnswerHash' )
- {
- @vecs = @{$vec_ref->{ra_student_ans}};
- }else{
- @vecs = @{$vec_ref};
- }
- my ($i,$j) = (0,0);
-
- my $num = scalar(@vecs);
- my $length = $vecs[0]->[1];
-
- for( ; $i < $num ; $i ++ )
- {
- for( $j = $i+1; $j < $num ; $j++ )
- {
- if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault )
- {
- if( ref( $vec_ref ) eq 'AnswerHash' ){
- $vec_ref->{score} = 0;
- if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
- {
- $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
- }else{
- $vec_ref->throw_error('EVAL');
- }
- return $vec_ref;
- }else{
- return 0;
- }
- }
- }
- }
- if( ref( $vec_ref ) eq 'AnswerHash' ){
- $vec_ref->{score} = 1;
- $vec_ref;
- }else{
- 1;
- }
+ my ($vec_ref , %opts) = @_;
+ $vec_ref->{_filter_name} = 'are_orthogonal_vecs';
+ my @vecs = ();
+ if( ref($vec_ref) eq 'AnswerHash' )
+ {
+ @vecs = @{$vec_ref->{ra_student_ans}};
+ }else{
+ @vecs = @{$vec_ref};
+ }
+
+ my $num = scalar(@vecs);
+ my $length = $vecs[0]->[1];
+
+ for( my $i=0; $i < $num ; $i ++ ) {
+ for( my $j = $i+1; $j < $num ; $j++ ) {
+ if( $vecs[$i]->scalar_product($vecs[$j]) > $main::functZeroLevelTolDefault ) {
+ if( ref( $vec_ref ) eq 'AnswerHash' ){
+ $vec_ref->{score} = 0;
+ if( $vec_ref->{help} =~ /orthogonal|orthonormal|verbose/ )
+ {
+ $vec_ref->throw_error('EVAL','You have entered vectors which are not orthogonal. ');
+ }else{
+ $vec_ref->throw_error('EVAL');
+ }
+ return $vec_ref;
+ } else {
+ return 0;
+ }
+ }
+ }
+ }
+ if( ref( $vec_ref ) eq 'AnswerHash' ){
+ $vec_ref->{score} = 1;
+ $vec_ref;
+ } else {
+ 1;
+ }
}
sub is_diagonal{
- my $matrix = shift;
- my %options = @_;
- my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
- my ($rh_ans);
- if ($process_ans_hash) {
- $rh_ans = $matrix;
- $matrix = $rh_ans->{ra_student_ans};
- }
-
- return 0 unless defined($matrix);
-
- if( ref($matrix) eq 'ARRAY' ){
- my @matrix = @{$matrix};
- @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
- if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
- warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
- }
-
- for( my $i = 0; $i < scalar( @matrix ) ; $i++ ){
- for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
- if( $matrix[$i][$j] != 0 and $i != $j )
- {
- if ($process_ans_hash){
- $rh_ans->throw_error('EVAL');
- return $rh_ans;
- } else {
- return 0;
- }
- }
- }
- }
- if ($process_ans_hash){
- return $rh_ans;
- } else {
- return 1;
- }
- }elsif( ref($matrix) eq 'Matrix' ){
- if( $matrix->[1] != $matrix->[2] ){
- warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
- if ($process_ans_hash){
- $rh_ans->throw_error('EVAL');
- return $rh_ans;
- } else {
- return 0;
- }
- }
- for( my $i = 0; $i < $matrix->[1] ; $i++ ){
- for( my $j = 0; $j < $matrix->[2] ; $j++ ){
- if( $matrix->[0][$i][$j] != 0 and $i != $j ){
- if ($process_ans_hash){
- $rh_ans->throw_error('EVAL');
- return $rh_ans;
- } else {
- return 0;
- }
- }
- }
- }
- if ($process_ans_hash){
- return $rh_ans;
- } else {
- return 1;
- }
- }else{
- warn "There is a problem with the problem, please alert your professor.";
- if ($process_ans_hash){
- $rh_ans->throw_error('EVAL');
- return $rh_ans;
- } else {
- return 0;
- }
- }
+ my $matrix = shift;
+ my %options = @_;
+ my $process_ans_hash = ( ref( $matrix ) eq 'AnswerHash' ) ? 1 : 0 ;
+ my ($rh_ans);
+ if ($process_ans_hash) {
+ $rh_ans = $matrix;
+ $matrix = $rh_ans->{ra_student_ans};
+ }
+
+ return 0 unless defined($matrix);
+
+ if( ref($matrix) eq 'ARRAY' ) {
+ my @matrix = @{$matrix};
+ @matrix = @{$matrix[0]} if ref($matrix[0][0]) eq 'ARRAY';
+ if( ref($matrix[0]) ne 'ARRAY' or scalar( @matrix ) != scalar( @{$matrix[0]} ) ){
+ warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
+ }
+
+ for( my $i = 0; $i < scalar( @matrix ) ; $i++ ) {
+ for( my $j = 0; $j < scalar( @{$matrix[0]} ); $j++ ){
+ if( $matrix[$i][$j] != 0 and $i != $j )
+ {
+ if ($process_ans_hash){
+ $rh_ans->throw_error('EVAL');
+ return $rh_ans;
+ } else {
+ return 0;
+ }
+ }
+ }
+ }
+ if ($process_ans_hash){
+ return $rh_ans;
+ } else {
+ return 1;
+ }
+ } elsif ( ref($matrix) eq 'Matrix' ) {
+ if( $matrix->[1] != $matrix->[2] ) {
+ warn "It is impossible for a non-square matrix to be diagonal, if you are a student, please tell your professor that there is a problem.";
+ if ($process_ans_hash){
+ $rh_ans->throw_error('EVAL');
+ return $rh_ans;
+ } else {
+ return 0;
+ }
+ }
+ for( my $i = 0; $i < $matrix->[1] ; $i++ ) {
+ for( my $j = 0; $j < $matrix->[2] ; $j++ ) {
+ if( $matrix->[0][$i][$j] != 0 and $i != $j ){
+ if ($process_ans_hash){
+ $rh_ans->throw_error('EVAL');
+ return $rh_ans;
+ } else {
+ return 0;
+ }
+ }
+ }
+ }
+ if ($process_ans_hash) {
+ return $rh_ans;
+ } else {
+ return 1;
+ }
+ } else {
+ warn "There is a problem with the problem, please alert your professor.";
+ if ($process_ans_hash){
+ $rh_ans->throw_error('EVAL');
+ return $rh_ans;
+ } else {
+ return 0;
+ }
+ }
}
sub are_unit_vecs{
- my ( $vec_ref,%opts ) = @_;
- $vec_ref->{_filter_name} = 'are_unit_vecs';
- my @vecs = ();
- if( ref($vec_ref) eq 'AnswerHash' )
- {
- @vecs = @{$vec_ref->{ra_student_ans}};
- }else{
- @vecs = @{$vec_ref};
- }
-
- my $i = 0;
- my $num = scalar(@vecs);
- my $length = $vecs[0]->[1];
-
- for( ; $i < $num ; $i ++ )
- {
- if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
- {
- if( ref( $vec_ref ) eq 'AnswerHash' ){
- $vec_ref->{score} = 0;
- if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
- {
- $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
- }else{
- $vec_ref->throw_error('EVAL');
- }
- return $vec_ref;
- }else{
- return 0;
- }
-
- }
- }
-
- if( ref( $vec_ref ) eq 'AnswerHash' ){
- $vec_ref->{score} = 1;
- $vec_ref;
- }else{
- 1;
- }
+ my ( $vec_ref,%opts ) = @_;
+ $vec_ref->{_filter_name} = 'are_unit_vecs';
+ my @vecs = ();
+ if( ref($vec_ref) eq 'AnswerHash' )
+ {
+ @vecs = @{$vec_ref->{ra_student_ans}};
+ }else{
+ @vecs = @{$vec_ref};
+ }
+
+ my $i = 0;
+ my $num = scalar(@vecs);
+ my $length = $vecs[0]->[1];
+
+ for( ; $i < $num ; $i ++ ) {
+ if( abs(sqrt($vecs[$i]->scalar_product($vecs[$i]))- 1) > $main::functZeroLevelTolDefault )
+ {
+ if( ref( $vec_ref ) eq 'AnswerHash' ){
+ $vec_ref->{score} = 0;
+ if( $vec_ref->{help} =~ /unit|orthonormal|verbose/ )
+ {
+ $vec_ref->throw_error('EVAL','You have entered vector(s) which are not of unit length.');
+ }else{
+ $vec_ref->throw_error('EVAL');
+ }
+ return $vec_ref;
+ }else{
+ return 0;
+ }
+
+ }
+ }
+
+ if( ref( $vec_ref ) eq 'AnswerHash' ){
+ $vec_ref->{score} = 1;
+ $vec_ref;
+ }else{
+ 1;
+ }
}
sub display_correct_vecs{
- my ( $ra_vecs,%opts ) = @_;
- my @ra_vecs = @{$ra_vecs};
- my @temp = ();
-
- for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ){
- push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
- push @temp, ",";
- }
-
- pop @temp;
-
- mbox(\@temp);
+ my ( $ra_vecs,%opts ) = @_;
+ my @ra_vecs = @{$ra_vecs};
+ my @temp = ();
+
+ for( my $i = 0 ; $i < scalar(@ra_vecs) ; $i++ ) {
+ push @temp, display_matrix(Matrix->new_from_col_vecs([$ra_vecs[$i]]),'left'=>'.','right'=>'.');
+ push @temp, ",";
+ }
+
+ pop @temp;
+
+ mbox(\@temp);
}
sub vec_solution_cmp{
- my $correctAnswer = shift;
- my %opt = @_;
+ my $correctAnswer = shift;
+ my %opt = @_;
- set_default_options( \%opt,
- 'zeroLevelTol' => $main::functZeroLevelTolDefault,
- 'debug' => 0,
- 'mode' => 'basis',
- 'help' => 'none',
- );
-
- $opt{debug} = 0 unless defined($opt{debug});
-
+ set_default_options( \%opt,
+ 'zeroLevelTol' => $main::functZeroLevelTolDefault,
+ 'debug' => 0,
+ 'mode' => 'basis',
+ 'help' => 'none',
+ );
+
+
## This is where the correct answer should be checked someday.
- my $matrix = Matrix->new_from_col_vecs($correctAnswer);
-
-
+ my $matrix = Matrix->new_from_col_vecs($correctAnswer);
+
+
#construct the answer evaluator
- my $answer_evaluator = new AnswerEvaluator;
+ my $answer_evaluator = new AnswerEvaluator;
- $answer_evaluator->{debug} = $opt{debug};
- $answer_evaluator->ans_hash( correct_ans => display_correct_vecs($correctAnswer),
- old_correct_ans => $correctAnswer,
- rm_correct_ans => $matrix,
- zeroLevelTol => $opt{zeroLevelTol},
- debug => $opt{debug},
- mode => $opt{mode},
- help => $opt{help},
- );
-
- $answer_evaluator->install_pre_filter(\&ans_array_filter);
- $answer_evaluator->install_pre_filter(sub{
- my ($rh_ans,@options) = @_;
- my @student_array = @{$rh_ans->{ra_student_ans}};
- my @array = ();
- for( my $i = 0; $i < scalar(@student_array) ; $i ++ )
- {
- push( @array, Matrix->new_from_array_ref($student_array[$i]));
- }
- $rh_ans->{ra_student_ans} = \@array;
- $rh_ans;
- });#ra_student_ans is now the students answer as an array of vectors
- # anonymous subroutine to check dimension and length of the student vectors
- # if either is wrong, the answer is wrong.
- $answer_evaluator->install_pre_filter(sub{
- my $rh_ans = shift;
- my $length = $rh_ans->{rm_correct_ans}->[1];
- my $dim = $rh_ans->{rm_correct_ans}->[2];
- if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
- {
-
- $rh_ans->{score} = 0;
- if( $rh_ans->{help} =~ /dim|verbose/ )
- {
- $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
- }else{
- $rh_ans->throw_error('EVAL');
- }
- }
- for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ )
- {
- if( $length != $rh_ans->{ra_student_ans}->[$i]->[1])
+ $answer_evaluator->{debug} = $opt{debug};
+ $answer_evaluator->ans_hash(
+ correct_ans => display_correct_vecs($correctAnswer),
+ old_correct_ans => $correctAnswer,
+ rm_correct_ans => $matrix,
+ zeroLevelTol => $opt{zeroLevelTol},
+ debug => $opt{debug},
+ mode => $opt{mode},
+ help => $opt{help},
+ );
+
+ $answer_evaluator->install_pre_filter(\&ans_array_filter);
+ $answer_evaluator->install_pre_filter(
+ sub{
+ my ($rh_ans,@options) = @_;
+ $rh_ans->{_filter_name} = "create student answer as an array of vectors";
+ my @student_array = @{$rh_ans->{ra_student_ans}};
+ my @array = ();
+ for( my $i = 0; $i < scalar(@student_array) ; $i ++ ) {
+ push( @array, Matrix->new_from_array_ref($student_array[$i]));
+ }
+ $rh_ans->{ra_student_ans} = \@array;
+ $rh_ans;
+ }
+ );
+ #ra_student_ans is now the students answer as an array of vectors
+ # anonymous subroutine to check dimension and length of the student vectors
+ # if either is wrong, the answer is wrong.
+ $answer_evaluator->install_pre_filter(
+ sub{
+ my $rh_ans = shift;
+ $rh_ans->{_filter_name} = "check_dimension_and_length";
+ my $length = $rh_ans->{rm_correct_ans}->[1];
+ my $dim = $rh_ans->{rm_correct_ans}->[2];
+ if( $dim != scalar(@{$rh_ans->{ra_student_ans}}))
{
+
$rh_ans->{score} = 0;
- if( $rh_ans->{help} =~ /length|verbose/ )
+ if( $rh_ans->{help} =~ /dim|verbose/ )
{
- $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
+ $rh_ans->throw_error('EVAL','You have entered the wrong number of vectors.');
}else{
$rh_ans->throw_error('EVAL');
}
}
- }
- $rh_ans;
- });
- # Install prefilter for various modes
- if( $opt{mode} ne 'basis' )
- {
- if( $opt{mode} =~ /orthogonal|orthonormal/ )
- {
- $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
- }
-
- if( $opt{mode} =~ /unit|orthonormal/ )
- {
- $answer_evaluator->install_pre_filter(\&are_unit_vecs);
-
- }
- }
-
- $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
-
- $answer_evaluator->install_post_filter(
- sub {my $rh_ans = shift;
- if ($rh_ans->catch_error('SYNTAX') ) {
- $rh_ans->{ans_message} = $rh_ans->{error_message};
- $rh_ans->clear_error('SYNTAX');
- }
- if ($rh_ans->catch_error('EVAL') ) {
- $rh_ans->{ans_message} = $rh_ans->{error_message};
- $rh_ans->clear_error('EVAL');
+ for( my $i = 0; $i < scalar( @{$rh_ans->{ra_student_ans} }) ; $i++ ) {
+ if( $length != $rh_ans->{ra_student_ans}->[$i]->[1]) {
+ $rh_ans->{score} = 0;
+ if( $rh_ans->{help} =~ /length|verbose/ ) {
+ $rh_ans->throw_error('EVAL','You have entered vector(s) of the wrong length.');
+ }else{
+ $rh_ans->throw_error('EVAL');
+ }
}
- $rh_ans;
- }
- );
- $answer_evaluator;
-
+ }
+ $rh_ans;
+ }
+ );
+ # Install prefilter for various modes
+ if( $opt{mode} ne 'basis' ) {
+ if( $opt{mode} =~ /orthogonal|orthonormal/ ) {
+ $answer_evaluator->install_pre_filter(\&are_orthogonal_vecs);
+ }
+
+ if( $opt{mode} =~ /unit|orthonormal/ ) {
+ $answer_evaluator->install_pre_filter(\&are_unit_vecs);
+
+ }
+ }
+
+ $answer_evaluator->install_evaluator(\&compare_vec_solution, %opt);
+
+ $answer_evaluator->install_post_filter(
+ sub {my $rh_ans = shift;
+ if ($rh_ans->catch_error('SYNTAX') ) {
+ $rh_ans->{ans_message} = $rh_ans->{error_message};
+ $rh_ans->clear_error('SYNTAX');
+ }
+ if ($rh_ans->catch_error('EVAL') ) {
+ $rh_ans->{ans_message} = $rh_ans->{error_message};
+ $rh_ans->clear_error('EVAL');
+ }
+ $rh_ans;
+ }
+ );
+ $answer_evaluator;
+
}
-
+
sub compare_vec_solution {
- my ( $rh_ans, %options ) = @_ ;
- my @space = @{$rh_ans->{ra_student_ans}};
- my $solution = shift @space;
-
- # A lot of the follosing code was taken from Matrix::proj_coeff
- # calling this method recursively would be a waste of time since
- # the prof's matrix never changes and solve_LR is an expensive
- # operation. This way it is only done once.
- my $matrix = $rh_ans->{rm_correct_ans};
- my ($dim,$x_vector, $base_matrix);
- my $errors = undef;
- my $lin_space_tr= ~ $matrix;
- $matrix = $lin_space_tr * $matrix;
- my $matrix_lr = $matrix->decompose_LR();
-
- #this section determines whether or not the first vector, a solution to
- #the system, is a linear combination of the prof's vectors in which there
- #is a nonzero coefficient on the first term, the prof's solution to the system
- $solution = $lin_space_tr*$solution;
- ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
- if( $dim ){
- $rh_ans->throw_error('EVAL', "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" ); # only print if the dim is not zero.
- $rh_ans->{score} = 0;
- $rh_ans;
- }elsif( abs($x_vector->[0][0][0]) <= $options{zeroLevelTol} )
- {
- $rh_ans->{score} = 0;
- $rh_ans;
- }else{
- $rh_ans->{score} = 1;
- my @correct_space = @{$rh_ans->{old_correct_ans}};
- shift @correct_space;
- $rh_ans->{rm_correct_ans} = Matrix->new_from_col_vecs(\@correct_space);
- $rh_ans->{ra_student_ans} = \@space;
- return compare_basis( $rh_ans, %options );
- }
+ my ( $rh_ans, %options ) = @_ ;
+ $rh_ans->{_filter_name} = "compare_vec_solution";
+ my @space = @{$rh_ans->{ra_student_ans}};
+ my $solution = shift @space;
+
+ # A lot of the following code was taken from Matrix::proj_coeff
+ # calling this method recursively would be a waste of time since
+ # the prof's matrix never changes and solve_LR is an expensive
+ # operation. This way it is only done once.
+ my $matrix = $rh_ans->{rm_correct_ans};
+ my ($dim,$x_vector, $base_matrix);
+ my $errors = undef;
+ my $lin_space_tr= ~ $matrix;
+ $matrix = $lin_space_tr * $matrix;
+ my $matrix_lr = $matrix->decompose_LR();
+
+ #this section determines whether or not the first vector, a solution to
+ #the system, is a linear combination of the prof's vectors in which there
+ #is a nonzero coefficient on the first term, the prof's solution to the system
+ $solution = $lin_space_tr*$solution;
+ ($dim,$x_vector, $base_matrix) = $matrix_lr->solve_LR($solution);
+ #$rh_ans->{debug_compare_vec_solution} = $x_vector->element(1,1);
+ if( $dim ){
+ $rh_ans->throw_error('EVAL', "A unique adapted answer could not be determined. Possibly the parameters have coefficient zero.<br> dim = $dim base_matrix is $base_matrix\n" ); # only print if the dim is not zero.
+ $rh_ans->{score} = 0;
+ $rh_ans;
+ } elsif( abs($x_vector->element(1,1) -1) >= $options{zeroLevelTol} ) {
+ # changes by MEG 6/24/05
+ # the student answer needs to be a linear combination of the instructors vectors
+ # and the coefficient of the first vector needs to be 1 (it is NOT enough that it be non-zero).
+ # if this is not the case, then the answer is wrong.
+ # replaced $x_vector->[0][0][0] by $x_vector->element(1,1) since this doesn't depend on the internal structure of the matrix object.
+
+ $rh_ans->{score} = 0;
+ $rh_ans;
+ } else {
+ $rh_ans->{score} = 1;
+ my @correct_space = @{$rh_ans->{old_correct_ans}};
+ shift @correct_space;
+ $rh_ans->{rm_correct_ans} = Matrix->new_...
[truncated message content] |
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-23 17:56:12
|
Log Message:
-----------
When sorting by clicking a label, concatonate visable user id's into a
string so that more my be sent without exceeding MSIE limit on URL's
Arnie
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.67
retrieving revision 1.68
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.67 -r1.68
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -94,10 +94,7 @@
sets => "assign_problem_sets",
};
-# Use param v_u in place of visible_users to shorten URL's in GET methods around line 1600 below.
-# This is a hack to get around: Maximum URL Length Is 2,083 Characters in Internet Explorer.
-# v_u appears 6 times in the code. Maybe we should replace the GET method by POST --- AKP
-use constant STATE_PARAMS => [qw(user effectiveUser key v_u no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)];
+use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)];
use constant SORT_SUBS => {
user_id => \&byUserID,
@@ -314,8 +311,11 @@
$self->{totalSets} = $db->listGlobalSets; # save for use in "assigned sets" links
$self->{allUserIDs} = \@allUserIDs;
- if (defined $r->param("v_u")) {
- $self->{visibleUserIDs} = [ $r->param("v_u") ];
+ if (defined $r->param("visable_user_string")) {
+ my @visableUserIDs = split /:/, $r->param("visable_user_string");
+ $self->{visibleUserIDs} = [ @visableUserIDs ];
+ } elsif (defined $r->param("visible_users")) {
+ $self->{visibleUserIDs} = [ $r->param("visible_users") ];
} elsif (defined $r->param("no_visible_users")) {
$self->{visibleUserIDs} = [];
} else {
@@ -486,7 +486,7 @@
print "\n<!-- state data here -->\n";
if (@visibleUserIDs) {
- print CGI::hidden(-name=>"v_u", -value=>\@visibleUserIDs);
+ print CGI::hidden(-name=>"visible_users", -value=>\@visibleUserIDs);
} else {
print CGI::hidden(-name=>"no_visible_users", -value=>"1");
}
@@ -1453,7 +1453,7 @@
params => {effectiveUser => $User->user_id}
);
- my $userListURL = $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName} )) . "&editMode=1&v_u=" . $User->user_id;
+ my $userListURL = $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName} )) . "&editMode=1&visible_users=" . $User->user_id;
my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/edit.gif";
my $imageLink = CGI::a({href => $userListURL}, CGI::img({src=>$imageURL, border=>0}));
@@ -1579,24 +1579,20 @@
# prepend selection checkbox? only if we're NOT editing!
unless($editMode or $passwordMode) {
- #warn "line 1573 visibleUserIDs=@visableUserIDs \n";
+ #warn "line 1582 visibleUserIDs=@visableUserIDs \n";
my %current_state =();
if (@visableUserIDs) {
# This is a hack to get around: Maximum URL Length Is 2,083 Characters in Internet Explorer.
- # Without passing visable users the URL is about 270 characters. If the total URL is under the limit
+ # Without passing visable users the URL is about 250 characters. If the total URL is under the limit
# we will pass visable users. If it is over, we will not pass any and all users will be displayed.
- # Maybe we should replace the GET method by POST --- AKP
+ # Maybe we should replace the GET method by POST (but this doesn't look good) --- AKP
- # calculate number of visableUserIDs and total length
- my $number_of_visableUserIDs = scalar(@visableUserIDs);
- my $total_length = 0;
- foreach (@visableUserIDs) {$total_length += length}
- # warn ("Number of visable users is $number_of_visableUserIDs. Total length of ids is $total_length\n");
- if ($total_length + 9*$number_of_visableUserIDs < 1800) {
+ my $visableUserIDsString = join ':', @visableUserIDs;
+ if (length($visableUserIDsString) < 1830) {
%current_state = (
primarySortField => "$primarySortField",
secondarySortField => "$secondarySortField",
- v_u => \@visableUserIDs
+ visable_user_string => "$visableUserIDsString"
);
} else {
%current_state = (
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-23 02:35:45
|
Log Message:
-----------
The TIMEOUT constant which is now defined in WeBWorK::Cosntants and is
(and was) used in WeBWorK::PG::Local gives the time in seconds
that is allowed for rendering one PG problem. The old value was 5 minutes
which was probably way too long. The default in WeBWorK::Constants has been
set to 60 seconds. If no value is set then 10 seconds is used.
-- Mike
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Constants.pm
webwork-modperl/lib/WeBWorK/PG:
Local.pm
Revision Data
-------------
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.26 -r1.27
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -65,6 +65,14 @@
$WeBWorK::ContentGenerator::Hardcopy::PreserveTempFiles = 0;
################################################################################
+# WeBWorK::PG::Local
+################################################################################
+# The maximum amount of time (in seconds) to work on a single problem.
+# At the end of this time a timeout message is sent to the browser.
+
+$WeBWorK::PG::Local::TIMEOUT = 60;
+
+################################################################################
# WeBWorK::PG::ImageGenerator
################################################################################
Index: Local.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/PG/Local.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/WeBWorK/PG/Local.pm -Llib/WeBWorK/PG/Local.pm -u -r1.17 -r1.18
--- lib/WeBWorK/PG/Local.pm
+++ lib/WeBWorK/PG/Local.pm
@@ -37,12 +37,13 @@
use strict;
use warnings;
+use WeBWorK::Constants;
use File::Path qw(rmtree);
use WeBWorK::PG::Translator;
use WeBWorK::Utils qw(readFile writeTimingLogEntry);
# Problem processing will time out after this number of seconds.
-use constant TIMEOUT => 5*60;
+use constant TIMEOUT => $WeBWorK::PG::Local::TIMEOUT || 10;
BEGIN {
# This safe compartment is used to read the large macro files such as
@@ -54,7 +55,7 @@
sub new {
my $invocant = shift;
- local $SIG{ALRM} = sub { die "Timeout after processing this problem for ", TIMEOUT, " seconds. Check for infinite loops in problem source.\n" };
+ local $SIG{ALRM} = \&alarm_handler;
alarm TIMEOUT;
my $result = eval { $invocant->new_helper(@_) };
alarm 0;
@@ -62,6 +63,12 @@
return $result;
}
+sub alarm_handler {
+ my $msg = "Timeout after processing this problem for ". TIMEOUT. " seconds. Check for infinite loops in problem source.\n";
+ warn $msg;
+ die $msg;
+
+}
sub new_helper {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-22 16:16:08
|
Log Message:
-----------
Tweaked documentation
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
ContentGenerator.pm
Revision Data
-------------
Index: ContentGenerator.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v
retrieving revision 1.136
retrieving revision 1.137
diff -Llib/WeBWorK/ContentGenerator.pm -Llib/WeBWorK/ContentGenerator.pm -u -r1.136 -r1.137
--- lib/WeBWorK/ContentGenerator.pm
+++ lib/WeBWorK/ContentGenerator.pm
@@ -721,6 +721,7 @@
=item options()
+Default is defined in this package.
Print an auxiliary options form, related to the content displayed in the
C<body>.
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-22 15:56:51
|
Log Message:
-----------
Additional changes to the writeLogs functions. Now surePathToFile
is used to make sure that the logs are created if they are not
already there.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Utils.pm
Revision Data
-------------
Index: Utils.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils.pm,v
retrieving revision 1.63
retrieving revision 1.64
diff -Llib/WeBWorK/Utils.pm -Llib/WeBWorK/Utils.pm -u -r1.63 -r1.64
--- lib/WeBWorK/Utils.pm
+++ lib/WeBWorK/Utils.pm
@@ -545,6 +545,7 @@
return;
}
my $logFile = $ce->{webworkFiles}->{logs}->{$facility};
+ surePathToFile($ce->{webworkDirs}->{root}, $logFile);
local *LOG;
if (open LOG, ">>", $logFile) {
print LOG "[", time2str("%a %b %d %H:%M:%S %Y", time), "] @message\n";
@@ -561,6 +562,7 @@
return;
}
my $logFile = $ce->{courseFiles}->{logs}->{$facility};
+ surePathToFile($ce->{courseDirs}->{root}, $logFile);
local *LOG;
if (open LOG, ">>", $logFile) {
print LOG "[", time2str("%a %b %d %H:%M:%S %Y", time), "] @message\n";
@@ -580,7 +582,6 @@
# [formatted date & time ] processID unixTime BeginEnd $function $details
sub writeTimingLogEntry($$$$) {
my ($ce, $function, $details, $beginEnd) = @_;
- return unless defined $ce->{webworkFiles}->{logs}->{timing};
$beginEnd = ($beginEnd eq "begin") ? ">" : ($beginEnd eq "end") ? "<" : "-";
writeLog($ce, "timing", "$$ ".time." $beginEnd $function [$details]");
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-22 15:24:25
|
Log Message:
-----------
Resetting Timing::Logfile to empty.
I have left the default value for dvipngArgs so that it works with
dvipng versions greater than 1.0
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Constants.pm
Revision Data
-------------
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.25 -r1.26
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -54,7 +54,7 @@
# If non-empty, timing data will be sent to the file named rather than STDERR.
#
-$WeBWorK::Timing::Logfile = "/home/gage/webwork2/logs/timing.log";
+$WeBWorK::Timing::Logfile = "";
################################################################################
# WeBWorK::ContentGenerator::Hardcopy
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-22 15:21:07
|
Log Message:
-----------
Use the Timing::HiRes module to calculate timing data for each
request. This gives more accurate timing data (using the unix
time gives only to the nearest second). I am printing the elapsed
time to 3 decimal places, it could be to 6 if that is desirable.
This will help us evaluate whether changes are increasing or decreasing
the speed with which requests are serviced.
Modified Files:
--------------
webwork-modperl/lib:
WeBWorK.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK.pm,v
retrieving revision 1.70
retrieving revision 1.71
diff -Llib/WeBWorK.pm -Llib/WeBWorK.pm -u -r1.70 -r1.71
--- lib/WeBWorK.pm
+++ lib/WeBWorK.pm
@@ -268,8 +268,11 @@
debug(("-" x 80) . "\n");
debug("Finally, we'll load the display module...\n");
- my $localStartTime = time;
-
+ # The "production timer" uses a finer grained HiRes timing module
+ # rather than the standard unix "time".
+ #my $localStartTime = time;
+ my $productionTimer = WeBWorK::Timing->new($label);
+ $productionTimer->start();
runtime_use($displayModule);
debug("...instantiate it...\n");
@@ -288,9 +291,11 @@
#$WeBWorK::timer->stop();
#$WeBWorK::timer->save();
- my $localStopTime = time;
- my $timeDiff = $localStopTime - $localStartTime;
- writeTimingLogEntry($ce,"[".$r->uri."]", sprintf("runTime = %.1f sec", $timeDiff)." ".$ce->{dbLayoutName},"" );
+ #my $localStopTime = time;
+ $productionTimer->stop();
+ #my $timeDiff = $localStopTime - $localStartTime;
+ my $productionTimeDiff = $productionTimer->{stop} - $productionTimer->{start};
+ writeTimingLogEntry($ce,"[".$r->uri."]", sprintf("runTime = %.3f sec", $productionTimeDiff)." ".$ce->{dbLayoutName},"" );
return $result;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-22 15:16:18
|
Log Message:
-----------
Added documentation to writeTimingLogEntry
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
Utils.pm
Revision Data
-------------
Index: Utils.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils.pm,v
retrieving revision 1.62
retrieving revision 1.63
diff -Llib/WeBWorK/Utils.pm -Llib/WeBWorK/Utils.pm -u -r1.62 -r1.63
--- lib/WeBWorK/Utils.pm
+++ lib/WeBWorK/Utils.pm
@@ -576,6 +576,8 @@
# $beginEnd - the string "begin", "intermediate", or "end"
# use the intermediate step begun or completed for INTERMEDIATE
# use an empty string for $details when calling for END
+# Information printed in format:
+# [formatted date & time ] processID unixTime BeginEnd $function $details
sub writeTimingLogEntry($$$$) {
my ($ce, $function, $details, $beginEnd) = @_;
return unless defined $ce->{webworkFiles}->{logs}->{timing};
|
|
From: jj v. a. <we...@ma...> - 2005-06-21 19:58:37
|
Log Message:
-----------
New context which allows students to use C(n,r) and P(n,r) in their
answers. To support this, the webwork versions of these functions
have been moved from PGaux... to PGcommon...
Modified Files:
--------------
pg/macros:
PGauxiliaryFunctions.pl
PGcommonFunctions.pl
Added Files:
-----------
pg/macros:
contextIntegerFunctions.pl
Revision Data
-------------
Index: PGauxiliaryFunctions.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGauxiliaryFunctions.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -Lmacros/PGauxiliaryFunctions.pl -Lmacros/PGauxiliaryFunctions.pl -u -r1.8 -r1.9
--- macros/PGauxiliaryFunctions.pl
+++ macros/PGauxiliaryFunctions.pl
@@ -193,44 +193,6 @@
return $num.$obj;
}
-# Combinations and permutations
-
-sub C {
- my $n = shift;
- my $k = shift;
- my $ans = 1;
-
- return(0) if ($k>$n);
- if($k>($n-$k)) { $k = $n-$k; }
- for (1..$k) { $ans = ($ans*($n-$_+1))/$_; }
- return $ans;
-}
-
-sub Comb {
- C(@_);
-}
-
-sub P {
- my $n = shift;
- my $k = shift;
- my $perm = 1;
-
- if($n != int($n) or $n < 0) {
- warn 'Non-negative integer required.';
- return;
- }
- if($k>$n) {
- warn 'Second argument of Permutation bigger than first.';
- return;
- }
- for (($n-$k+1)..$n) { $perm *= $_;}
- return $perm;
-}
-
-sub Perm {
- P(@_);
-}
-
#factorial
sub fact {
Index: PGcommonFunctions.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGcommonFunctions.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -Lmacros/PGcommonFunctions.pl -Lmacros/PGcommonFunctions.pl -u -r1.4 -r1.5
--- macros/PGcommonFunctions.pl
+++ macros/PGcommonFunctions.pl
@@ -62,6 +62,23 @@
sub sgn {$_[1] <=> 0}
+#our @ISA = qw(Parser::Function::numeric2);
+sub C {
+ shift; my ($n,$r) = @_; my $C = 1;
+ return (0) if($r>$n);
+ $r = $n-$r if ($r > $n-$r); # find the smaller of the two
+ for (1..$r) {$C = ($C*($n-$_+1))/$_}
+ return $C
+}
+
+sub P {
+ shift; my ($n,$r) = @_; my $P = 1;
+ return (0) if($r>$n);
+ for (1..$r) {$P *= ($n-$_+1)}
+ return $P
+}
+
+
#
# Back to main package
#
@@ -103,4 +120,9 @@
sub sgn {CommonFunction->Call('sgn',@_)}
+sub C {CommonFunction->Call('C', @_)}
+sub P {CommonFunction->Call('P', @_)}
+sub Comb {CommonFunction->Call('C', @_)}
+sub Perm {CommonFunction->Call('P', @_)}
+
1;
--- /dev/null
+++ macros/contextIntegerFunctions.pl
@@ -0,0 +1,53 @@
+loadMacros('Parser.pl');
+
+sub _contextIntegerFunctions_init {}; # don't reload this file
+
+######################################################################
+#
+# This is a Parser context that adds integer related functions C(n,r)
+# and P(n,r). They can be used by the problem author and also by
+# students if the answer checking is done by Parser. The latter is
+# the main purpose of this file.
+#
+# Note: by default, webwork problems do not permit students to use
+# C(n,r) and P(n,r) functions. Problems which do permit this
+# should alert the student in their text.
+#
+# Usage examples:
+# $b = random(2, 5); $a = $b+random(0, 5);
+# $c = C($a, $b);
+# ANS(Compute("P($a, $b)")->cmp);
+#
+# Note: If the context is set to something else, such as Numeric, it
+# can be set back with Context("IntegerFunctions").
+
+
+$context{IntegerFunctions} = Context("Numeric")->copy;
+
+package IntegerFunction2;
+our @ISA = qw(Parser::Function::numeric2); # checks for 2 numeric inputs
+
+sub C {
+ shift; my ($n,$r) = @_; my $C = 1;
+ return (0) if($r>$n);
+ $r = $n-$r if ($r > $n-$r); # find the smaller of the two
+ for (1..$r) {$C = ($C*($n-$_+1))/$_}
+ return $C
+}
+
+sub P {
+ shift; my ($n,$r) = @_; my $P = 1;
+ return (0) if($r>$n);
+ for (1..$r) {$P *= ($n-$_+1)}
+ return $P
+}
+
+package main;
+
+$context{'IntegerFunctions'}->functions->add(
+ C => {class => 'IntegerFunction2'},
+ P => {class => 'IntegerFunction2'},
+);
+
+Context("IntegerFunctions");
+
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-21 19:46:37
|
Log Message:
-----------
Put in hacks to get around: Maximum URL Length Is 2,083 Characters in Internet
Explorer. When sorting by clicking labels we use the GET method and send the
user_id's of the visable users so that we only sort visable users but for over
about 110 students this is above MSIE's limit. If the total URL is under the
limit we will pass visable users. If it is over, we will not pass any and all
users will be displayed. The is almost enought to amke me use FireFox.
Maybe we should replace the GET method by POST but that requires a greater change.
Arnie
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.66
retrieving revision 1.67
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.66 -r1.67
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -71,7 +71,7 @@
use WeBWorK::Utils qw(readFile readDirectory cryptPassword);
use WeBWorK::Authen qw(checkKey);
use Apache::Constants qw(:common REDIRECT DONE); #FIXME -- this should be called higher up in the object tree.
-use constant HIDE_USERS_THRESHHOLD => 50;
+use constant HIDE_USERS_THRESHHOLD => 200;
use constant EDIT_FORMS => [qw(cancelEdit saveEdit)];
use constant PASSWORD_FORMS => [qw(cancelPassword savePassword)];
use constant VIEW_FORMS => [qw(filter sort edit password import export add delete)];
@@ -94,7 +94,10 @@
sets => "assign_problem_sets",
};
-use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)];
+# Use param v_u in place of visible_users to shorten URL's in GET methods around line 1600 below.
+# This is a hack to get around: Maximum URL Length Is 2,083 Characters in Internet Explorer.
+# v_u appears 6 times in the code. Maybe we should replace the GET method by POST --- AKP
+use constant STATE_PARAMS => [qw(user effectiveUser key v_u no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)];
use constant SORT_SUBS => {
user_id => \&byUserID,
@@ -311,12 +314,12 @@
$self->{totalSets} = $db->listGlobalSets; # save for use in "assigned sets" links
$self->{allUserIDs} = \@allUserIDs;
- if (defined $r->param("visible_users")) {
- $self->{visibleUserIDs} = [ $r->param("visible_users") ];
+ if (defined $r->param("v_u")) {
+ $self->{visibleUserIDs} = [ $r->param("v_u") ];
} elsif (defined $r->param("no_visible_users")) {
$self->{visibleUserIDs} = [];
} else {
- if (@allUserIDs > HIDE_USERS_THRESHHOLD) {
+ if ((@allUserIDs > HIDE_USERS_THRESHHOLD) and (not defined $r->param("show_all_users") )) {
$self->{visibleUserIDs} = [];
} else {
$self->{visibleUserIDs} = [ @allUserIDs ];
@@ -483,7 +486,7 @@
print "\n<!-- state data here -->\n";
if (@visibleUserIDs) {
- print CGI::hidden(-name=>"visible_users", -value=>\@visibleUserIDs);
+ print CGI::hidden(-name=>"v_u", -value=>\@visibleUserIDs);
} else {
print CGI::hidden(-name=>"no_visible_users", -value=>"1");
}
@@ -1450,7 +1453,7 @@
params => {effectiveUser => $User->user_id}
);
- my $userListURL = $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName} )) . "&editMode=1&visible_users=" . $User->user_id;
+ my $userListURL = $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName} )) . "&editMode=1&v_u=" . $User->user_id;
my $imageURL = $ce->{webworkURLs}->{htdocs}."/images/edit.gif";
my $imageLink = CGI::a({href => $userListURL}, CGI::img({src=>$imageURL, border=>0}));
@@ -1578,19 +1581,37 @@
#warn "line 1573 visibleUserIDs=@visableUserIDs \n";
my %current_state =();
- if (@visableUserIDs) {
- %current_state = (
- primarySortField => "$primarySortField",
- secondarySortField => "$secondarySortField",
- visible_users => \@visableUserIDs
- );
- } else {
+ if (@visableUserIDs) {
+ # This is a hack to get around: Maximum URL Length Is 2,083 Characters in Internet Explorer.
+ # Without passing visable users the URL is about 270 characters. If the total URL is under the limit
+ # we will pass visable users. If it is over, we will not pass any and all users will be displayed.
+ # Maybe we should replace the GET method by POST --- AKP
+
+ # calculate number of visableUserIDs and total length
+ my $number_of_visableUserIDs = scalar(@visableUserIDs);
+ my $total_length = 0;
+ foreach (@visableUserIDs) {$total_length += length}
+ # warn ("Number of visable users is $number_of_visableUserIDs. Total length of ids is $total_length\n");
+ if ($total_length + 9*$number_of_visableUserIDs < 1800) {
+ %current_state = (
+ primarySortField => "$primarySortField",
+ secondarySortField => "$secondarySortField",
+ v_u => \@visableUserIDs
+ );
+ } else {
+ %current_state = (
+ primarySortField => "$primarySortField",
+ secondarySortField => "$secondarySortField",
+ show_all_users => "1"
+ );
+ }
+ } else {
%current_state = (
primarySortField => "$primarySortField",
secondarySortField => "$secondarySortField",
no_visible_users => "1"
- );
- }
+ );
+ }
@tableHeadings = (
"Select",
CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'user_id', %current_state})}, 'Login Name'),
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-21 17:45:31
|
Log Message:
-----------
When exporting classlist to a file, tell the user the name and location of the
resulting file (e.g. templates/math1.lst) so they can find it in the File Mannager
Arnie
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.65 -r1.66
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -1070,11 +1070,17 @@
sub export_handler {
my ($self, $genericParams, $actionParams, $tableParams) = @_;
+ my $r = $self->r;
+ my $ce = $r->ce;
+ my $dir = $ce->{courseDirs}->{templates};
my $scope = $actionParams->{"action.export.scope"}->[0];
my $target = $actionParams->{"action.export.target"}->[0];
my $new = $actionParams->{"action.export.new"}->[0];
+ #get name of templates directory as it appears in file manager
+ $dir =~ s|.*/||;
+
my $fileName;
if ($target eq "new") {
$fileName = $new;
@@ -1095,7 +1101,7 @@
$self->exportUsersToCSV($fileName, @userIDsToExport);
- return scalar @userIDsToExport . " users exported";
+ return scalar @userIDsToExport . " users exported to file $dir/$fileName";
}
sub cancelEdit_form {
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-21 02:15:42
|
Log Message:
-----------
The classlist data can now be sorted by clicking on headings.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.64
retrieving revision 1.65
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.64 -r1.65
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -94,7 +94,7 @@
sets => "assign_problem_sets",
};
-use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField)];
+use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField labelSortMethod)];
use constant SORT_SUBS => {
user_id => \&byUserID,
@@ -295,7 +295,7 @@
"Login Name",
"First Name",
"Last Name",
- "E-mail",
+ "Email Address",
"Student ID",
"Status",
"Section",
@@ -342,10 +342,16 @@
return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify student data"))
if $self->{passwordMode} and not $authz->hasPermissions($user, "modify_student_data");
-
- $self->{primarySortField} = $r->param("primarySortField") || "last_name";
- $self->{secondarySortField} = $r->param("secondarySortField") || "first_name";
- $self->{ternarySortField} = $r->param("ternarySortField") || "student_id";
+ if (defined $r->param("labelSortMethod")) {
+ $self->{primarySortField} = $r->param("labelSortMethod");
+ $self->{secondarySortField} = $r->param("primarySortField");
+ $self->{ternarySortField} = $r->param("secondarySortField");
+ }
+ else {
+ $self->{primarySortField} = $r->param("primarySortField") || "last_name";
+ $self->{secondarySortField} = $r->param("secondarySortField") || "first_name";
+ $self->{ternarySortField} = $r->param("ternarySortField") || "student_id";
+ }
my @allUsers = $db->getUsers(@allUserIDs);
my (%sections, %recitations);
@@ -402,7 +408,9 @@
#warn "editMode=$editMode\n";
#warn "passwordMode=$passwordMode\n";
#warn "primarySortField=$primarySortField\n";
-
+ #warn "secondarySortField=$secondarySortField\n";
+ #warn "ternarySortField=$ternarySortField\n";
+
########## get required users
my @Users = grep { defined $_ } @visibleUserIDs ? $db->getUsers(@visibleUserIDs) : ();
@@ -541,6 +549,9 @@
editMode => $editMode,
passwordMode => $passwordMode,
selectedUserIDs => \@selectedUserIDs,
+ primarySortField => $primarySortField,
+ secondarySortField => $secondarySortField,
+ visableUserIDs => \@visibleUserIDs,
);
@@ -603,7 +614,7 @@
-labels => {
all => "all users",
none => "no users",
- selected => "users checked below",
+ selected => "selected users",
# match_ids => "users with matching user IDs:",
match_regex => "users who match:",
# match_section => "users in selected section",
@@ -712,7 +723,7 @@
user_id => "Login Name",
first_name => "First Name",
last_name => "Last Name",
- email_address => "Email address",
+ email_address => "Email Address",
student_id => "Student ID",
status => "Enrollment Status",
section => "Section",
@@ -731,7 +742,7 @@
user_id => "Login Name",
first_name => "First Name",
last_name => "Last Name",
- email_address => "Email address",
+ email_address => "Email Address",
student_id => "Student ID",
status => "Enrollment Status",
section => "Section",
@@ -750,7 +761,7 @@
user_id => "Login Name",
first_name => "First Name",
last_name => "Last Name",
- email_address => "Email address",
+ email_address => "Email Address",
student_id => "Student ID",
status => "Enrollment Status",
section => "Section",
@@ -780,7 +791,7 @@
user_id => "Login Name",
first_name => "First Name",
last_name => "Last Name",
- email_address => "Email address",
+ email_address => "Email Address",
student_id => "Student ID",
status => "Enrollment Status",
section => "Section",
@@ -1524,6 +1535,8 @@
sub printTableHTML {
my ($self, $UsersRef, $PermissionLevelsRef, $fieldNamesRef, %options) = @_;
my $r = $self->r;
+ my $urlpath = $r->urlpath;
+ my $courseName = $urlpath->arg("courseID");
my $userTemplate = $self->{userTemplate};
my $permissionLevelTemplate = $self->{permissionLevelTemplate};
my @Users = @$UsersRef;
@@ -1534,7 +1547,10 @@
my $passwordMode = $options{passwordMode};
my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} };
# my $currentSort = $options{currentSort};
-
+ my $primarySortField = $options{primarySortField};
+ my $secondarySortField = $options{secondarySortField};
+ my @visableUserIDs = @{ $options{visableUserIDs} };
+
# names of headings:
my @realFieldNames = (
$userTemplate->KEYFIELDS,
@@ -1553,9 +1569,38 @@
# prepend selection checkbox? only if we're NOT editing!
unless($editMode or $passwordMode) {
- shift @tableHeadings; # Remove user id
- unshift @tableHeadings, "Select", "Act As", "Login Status", "Assigned Sets";
- }
+
+ #warn "line 1573 visibleUserIDs=@visableUserIDs \n";
+ my %current_state =();
+ if (@visableUserIDs) {
+ %current_state = (
+ primarySortField => "$primarySortField",
+ secondarySortField => "$secondarySortField",
+ visible_users => \@visableUserIDs
+ );
+ } else {
+ %current_state = (
+ primarySortField => "$primarySortField",
+ secondarySortField => "$secondarySortField",
+ no_visible_users => "1"
+ );
+ }
+ @tableHeadings = (
+ "Select",
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'user_id', %current_state})}, 'Login Name'),
+ "Login Status",
+ "Assigned Sets",
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'first_name', %current_state})}, 'First Name'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'last_name', %current_state})}, 'Last Name'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'email_address', %current_state})}, 'Email Address'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'student_id', %current_state})}, 'Student ID'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'status', %current_state})}, 'Status'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'section', %current_state})}, 'Section'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'recitation', %current_state})}, 'Recitation'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'comment', %current_state})}, 'Comment'),
+ CGI::a({href => $self->systemLink($urlpath->new(type=>'instructor_user_list', args=>{courseID => $courseName,} ), params=>{labelSortMethod=>'permission', %current_state})}, 'Permission Level'),
+ )
+ }
if($passwordMode) {
unshift @tableHeadings, "New Password";
}
|
|
From: jj v. a. <we...@ma...> - 2005-06-20 22:43:04
|
Log Message:
-----------
Allow access to new file comparison module. It is not linked to from
anywhere, but now you can bring it up with
http://server/webwork2/coursename/instructor/compare
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
URLPath.pm
Revision Data
-------------
Index: URLPath.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/URLPath.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -Llib/WeBWorK/URLPath.pm -Llib/WeBWorK/URLPath.pm -u -r1.22 -r1.23
--- lib/WeBWorK/URLPath.pm
+++ lib/WeBWorK/URLPath.pm
@@ -65,6 +65,7 @@
instructor_file_transfer /$courseID/instructor/files/
instructor_file_manager /$courseID/instructor/file_manager/
instructor_set_maker /$courseID/instructor/setmaker/
+ instructor_compare /$courseID/instructor/compare/
instructor_problem_editor /$courseID/instructor/pgProblemEditor/
instructor_problem_editor_withset /$courseID/instructor/pgProblemEditor/$setID/
@@ -210,7 +211,7 @@
parent => 'set_list',
kids => [ qw/instructor_user_list instructor_set_list instructor_add_users
instructor_set_assigner instructor_file_transfer instructor_file_manager
- instructor_problem_editor instructor_set_maker
+ instructor_problem_editor instructor_set_maker instructor_compare
instructor_scoring instructor_scoring_download instructor_mail_merge
instructor_answer_log instructor_preflight instructor_statistics
instructor_progress
@@ -301,6 +302,15 @@
produce => 'assigner/',
display => 'WeBWorK::ContentGenerator::Instructor::Assigner',
},
+ instructor_compare => {
+ name => 'File Compare',
+ parent => 'instructor_tools',
+ kids => [ qw// ],
+ match => qr|^compare/|,
+ capture => [ qw// ],
+ produce => 'comp/',
+ display => 'WeBWorK::ContentGenerator::Instructor::Compare',
+ },
instructor_set_maker => {
name => 'Library Browser',
parent => 'instructor_tools',
|
|
From: jj v. a. <we...@ma...> - 2005-06-20 22:40:49
|
Log Message:
-----------
New module for comparing two pg files in webwork. You get both rendered
versions of the files and diffs. This initial version is pretty much
just bare-bones.
Added Files:
-----------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
Compare.pm
Revision Data
-------------
--- /dev/null
+++ lib/WeBWorK/ContentGenerator/Instructor/Compare.pm
@@ -0,0 +1,136 @@
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $ $
+#=20
+# This program is free software; you can redistribute it and/or modify i=
t under
+# the terms of either: (a) the GNU General Public License as published b=
y the
+# Free Software Foundation; either version 2, or (at your option) any la=
ter
+# version, or (b) the "Artistic License" which comes with this package.
+#=20
+# This program is distributed in the hope that it will be useful, but WI=
THOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
+# FOR A PARTICULAR PURPOSE. See either the GNU General Public License o=
r the
+# Artistic License for more details.
+########################################################################=
########
+
+# TODO
+
+# background on rendered parts
+# search for files by regex name
+# get "similar" files by chardiff
+
+package WeBWorK::ContentGenerator::Instructor::Compare;
+use base qw(WeBWorK::ContentGenerator::Instructor);
+
+=3Dhead1 NAME
+
+WeBWorK::ContentGenerator::Instructor::Compare - Compare problems
+
+=3Dcut
+
+use strict;
+use warnings;
+
+use CGI::Pretty qw();
+use WeBWorK::Form;
+use WeBWorK::Utils qw(readDirectory max);
+use WeBWorK::Utils::Tasks qw(renderProblems);
+
+require WeBWorK::Utils::ListingDB;
+
+
+
+#sub pre_header_initialize {
+# my ($self) =3D @_;
+# my $r =3D $self->r;
+#}
+
+sub body {
+ my ($self) =3D @_;
+
+ my $r =3D $self->r;
+ my $ce =3D $r->ce; # course environment
+ my $db =3D $r->db; # database
+ my $j; # garden variety counter
+
+ my $userName =3D $r->param('user');
+
+ my $user =3D $db->getUser($userName); # checked
+ die "record for user $userName (real user) does not exist."
+ unless defined $user;
+
+ ### Check that this is a professor
+ my $authz =3D $r->authz;
+ unless ($authz->hasPermissions($userName, "modify_problem_sets")) {
+ print "User $userName returned " .
+ $authz->hasPermissions($user, "modify_problem_sets") .
+ " for permission";
+ return(CGI::div({class=3D>'ResultsWithError'},
+ CGI::em("You are not authorized to access the Instructor tools.")));
+ }
+
+ my $path1 =3D $r->param('path1') || '';
+ my $path2 =3D $r->param('path2') || '';
+ if ($r->param('clear')) {
+ $path1 =3D '';
+ $path2 =3D '';
+ }
+ my @pathlist =3D ();
+ push @pathlist, $path1 if $path1;
+ push @pathlist, $path2 if $path2;
+ my @rendered =3D renderProblems(r=3D> $r,
+ user =3D> $user,
+ problem_list =3D> \@pathlist,
+ displayMode =3D> 'images');
+
+ ########## Extract information computed in pre_header_initialize
+ print CGI::startform({-method=3D>"POST", -action=3D>$r->uri, -name=3D>'=
mainform'}),
+ $self->hidden_authen_fields;
+ print CGI::p('File 1: ', CGI::textfield(-name=3D>"path1",
+ -default=3D>"$path1",
+ -override=3D>1, -size=3D>90));
+ print CGI::p('File 2: ', CGI::textfield(-name=3D>"path2",
+ -default=3D>"$path2",
+ -override=3D>1, -size=3D>90));
+ print CGI::p(CGI::submit(-name=3D>"show_me",
+ -value=3D>"Show Files"));
+ print CGI::p(CGI::submit(-name=3D>"clear",
+ -value=3D>"Clear"));
+ print CGI::endform(), "\n";
+
+ for $j (@rendered) {
+ print '<hr size=3D"5" color=3D"blue" />';
+ if ($j->{flags}->{error_flag}) {
+ print CGI::p('Error');
+ } else {
+ print $j->{body_text}
+ }
+ }
+ print '<hr size=3D"5" color=3D"blue" />';
+ if (scalar(@pathlist)>1) {
+ print CGI::h2('Diff output');
+ # Here we call diff. Basic version first
+ my $diffout =3D `diff -u $ce->{courseDirs}->{templates}/$pathlist[0] $=
ce->{courseDirs}->{templates}/$pathlist[1]`;
+ print "\n<pre>\n";
+ print $diffout;
+ print "</pre>\n";
+
+ # If you have hdiff installed, you can get colorized diffs
+ #my $diffout =3D `hdiff -t " " -c "File 1" -C "File 2" -N $ce->{course=
Dirs}->{templates}/$pathlist[0] $ce->{courseDirs}->{templates}/$pathlist[=
1]`;
+ #print $diffout;
+ }
+
+ return "";=09
+}
+
+
+=3Dhead1 AUTHOR
+
+Written by John Jones, jj (at) asu.edu.
+
+=3Dcut
+
+
+
+1;
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-17 15:41:51
|
Log Message:
-----------
Sorting by permission now works.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.63
retrieving revision 1.64
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.63 -r1.64
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -106,7 +106,7 @@
section => \&bySection,
recitation => \&byRecitation,
comment => \&byComment,
-# permission => \&byPermission,
+ permission => \&byPermission,
};
use constant FIELD_PROPERTIES => {
@@ -301,7 +301,7 @@
"Section",
"Recitation",
"Comment",
- "Perm. Level"
+ "Permission Level"
);
$self->{prettyFieldNames} = \%prettyFieldNames;
@@ -401,6 +401,7 @@
#warn "selectedUserIDs=@selectedUserIDs\n";
#warn "editMode=$editMode\n";
#warn "passwordMode=$passwordMode\n";
+ #warn "primarySortField=$primarySortField\n";
########## get required users
@@ -410,6 +411,15 @@
my $primarySortSub = $sortSubs{$primarySortField};
my $secondarySortSub = $sortSubs{$secondarySortField};
my $ternarySortSub = $sortSubs{$ternarySortField};
+
+ # add permission level to user record hash so we can sort it if necessary
+ if ($primarySortField eq 'permission' or $secondarySortField eq 'permission' or $ternarySortField eq 'permission') {
+ foreach my $User (@Users) {
+ next unless $User;
+ my $permissionLevel = $db->getPermissionLevel($User->user_id);
+ $User->{permission} = $permissionLevel->permission;
+ }
+ }
# # don't forget to sort in opposite order of importance
@@ -696,8 +706,7 @@
"Sort by ",
CGI::popup_menu(
-name => "action.sort.primary",
-# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
-default => $actionParams{"action.sort.primary"}->[0] || "last_name",
-labels => {
user_id => "Login Name",
@@ -709,15 +718,14 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
-# permission => "Perm. Level" ## This isn't defined and I don't have time to fix it right now AKP
+ permission => "Permission Level"
},
-onchange => $onChange,
),
", then by ",
CGI::popup_menu(
-name => "action.sort.secondary",
-# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
-default => $actionParams{"action.sort.secondary"}->[0] || "first_name",
-labels => {
user_id => "Login Name",
@@ -729,15 +737,14 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
-# permission => "Perm. Level"
+ permission => "Permission Level"
},
-onchange => $onChange,
),
", then by ",
CGI::popup_menu(
-name => "action.sort.ternary",
-# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
-default => $actionParams{"action.sort.ternary"}->[0] || "user_id",
-labels => {
user_id => "Login Name",
@@ -749,7 +756,7 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
-# permission => "Perm. Level"
+ permission => "Permission Level"
},
-onchange => $onChange,
),
@@ -779,7 +786,7 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
- permission => "Perm. Level"
+ permission => "Permission Level"
);
return "Users sorted by $names{$primary}, then by $names{$secondary}, then by $names{$ternary}.";
@@ -1224,7 +1231,7 @@
sub bySection { lc $a->section cmp lc $b->section }
sub byRecitation { lc $a->recitation cmp lc $b->recitation }
sub byComment { lc $a->comment cmp lc $b->comment }
-#sub byPermission { $a->permission <=> $b->permission }
+sub byPermission { $a->{permission} <=> $b->{permission} } ## permission level is added to user record hash so we can sort it if necessary
# sub byLnFnUid { &byLastName || &byFirstName || &byUserID }
@@ -1526,7 +1533,7 @@
my $editMode = $options{editMode};
my $passwordMode = $options{passwordMode};
my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} };
- my $currentSort = $options{currentSort};
+# my $currentSort = $options{currentSort};
# names of headings:
my @realFieldNames = (
@@ -1535,7 +1542,7 @@
$permissionLevelTemplate->NONKEYFIELDS,
);
- my %sortSubs = %{ SORT_SUBS() };
+# my %sortSubs = %{ SORT_SUBS() };
#my @stateParams = @{ STATE_PARAMS() };
#my $hrefPrefix = $r->uri . "?" . $self->url_args(@stateParams); # $self->url_authen_args
my @tableHeadings;
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-16 15:34:24
|
Log Message:
-----------
New flag showAllErrors for when a custom checker is supplied. This
will cause all errors generated in the user's code to be reported
(normally, messages from the Value and Parser packages are ignored).
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.46 -r1.47
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -161,7 +161,7 @@
my $self = shift; my $other = shift; my $ans = shift;
return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
- if (!defined($equal) && $@ ne '' && !$$Value::context->{error}{flag}) {
+ if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
$$Value::context->setError("<I>An error occurred while checking your answer:</I>\n".
'<DIV STYLE="margin-left:1em">'.$@.'</DIV>','');
$$Value::context->{error}{flag} = $CMP_ERROR;
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-16 04:06:46
|
Log Message:
-----------
Fixed typos in comments.
Modified Files:
--------------
pg/macros:
answerCustom.pl
Revision Data
-------------
Index: answerCustom.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/answerCustom.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/answerCustom.pl -Lmacros/answerCustom.pl -u -r1.1 -r1.2
--- macros/answerCustom.pl
+++ macros/answerCustom.pl
@@ -99,10 +99,10 @@
# that should be included in the answer checker following those
# two required ones.
#
-# The checker will be passe a reference to the array of correct
-# answers, a reference ro the array of student answers, and
+# The checker will be passed a reference to the array of correct
+# answers, a reference to the array of student answers, and
# the answer evaluator object. Note that the correct and student
-# anwers are array references, not List structures (this is because
+# answers are array references, not List structures (this is because
# a list of formulas becomes a formula returning a list, so in order
# to keep the formulas separate, they are passed in an array).
#
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-16 04:06:02
|
Log Message:
-----------
Fixed a problem with auto-generated functions getting an incomplete
variable list.
Modified Files:
--------------
pg/lib/Value:
Formula.pm
Revision Data
-------------
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.26 -r1.27
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -81,15 +81,12 @@
if ($l->promotePrecedence($r)) {return $r->$call($l,!$flag)}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
my $formula = $pkg->blank; my $parser = $formula->{context}{parser};
- my $vars = {};
if (ref($r) eq $pkg) {
$formula->{context} = $r->{context};
- $vars = {%{$vars},%{$r->{variables}}};
$r = $r->{tree}->copy($formula);
}
if (ref($l) eq $pkg) {
$formula->{context} = $l->{context};
- $vars = {%{$vars},%{$l->{variables}}};
$l = $l->{tree}->copy($formula);
}
$l = $pkg->new($l) if (!ref($l) && Value::getType($formula,$l) eq "unknown");
@@ -99,8 +96,8 @@
$bop = 'U' if $bop eq '+' &&
($l->type =~ m/Interval|Union/ || $r->type =~ m/Interval|Union/);
$formula->{tree} = $parser->{BOP}->new($formula,$bop,$l,$r);
- $formula->{variables} = {%{$vars}};
- return $formula->eval if scalar(%{$vars}) == 0;
+ $formula->{variables} = $formula->{tree}->getVariables;
+ return $formula->eval if scalar(%{$formula->{variables}}) == 0;
return $formula;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-16 00:54:33
|
Log Message:
-----------
Fixed documentation for $graph->size()
Modified Files:
--------------
pg/lib:
WWPlot.pm
Revision Data
-------------
Index: WWPlot.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/WWPlot.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/WWPlot.pm -Llib/WWPlot.pm -u -r1.2 -r1.3
--- lib/WWPlot.pm
+++ lib/WWPlot.pm
@@ -116,10 +116,10 @@
=item size
- ($horizontal_pixels, $vertical_pixels) = $graph ->size();
+ ($horizontal_pixels, $vertical_pixels) = @{$graph ->size()};
Reads the size of the graph image in pixels. This cannot be reset. It is defined by
-the new constructor and cannot be changed.
+the new constructor and cannot be changed.
=item colors
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-15 23:57:40
|
Log Message:
-----------
Implements a Parser context in which only polynomials (of a single
variable) can be entered. Only sums of multiples of powers of the
variable are allowed to be entered (though the coefficients can
contain mathematical operations). An optional flag lets you specify
that only one term of each degree is allowed, so the student would
have to combine 1+x+x+x^2 to get 1+2x+x^2 in that case.
Added Files:
-----------
pg/macros:
contextLimitedPolynomial.pl
Revision Data
-------------
--- /dev/null
+++ macros/contextLimitedPolynomial.pl
@@ -0,0 +1,288 @@
+loadMacros("Parser.pl");
+
+sub _contextLimitedPolynomial_init {}; # don't load it again
+
+##########################################################
+#
+# Implements a context in which students can only
+# enter (expanded) polynomials (i.e., sums of multiples
+# of powers of x).
+#
+# Select the context using:
+#
+# Context("LimitedPolynomial");
+#
+# If you set the "singlePowers" flag, then only one monomial of
+# each degree can be included in the polynomial:
+#
+# Context("LimitedPolynomial")->flags->set(singlePowers=>1);
+#
+
+#
+# Handle common checking for BOPs
+#
+package LimitedPolynomial::BOP;
+
+#
+# Do original check and then if the operands are numbers, its OK.
+# Otherwise, do an operator-specific check for if the polynomial is OK.
+# Otherwise report an error.
+#
+sub _check {
+ my $self = shift;
+ my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
+ &{$super."::_check"}($self);
+ return if LimitedPolynomial::isConstant($self->{lop}) &&
+ LimitedPolynomial::isConstant($self->{rop});
+ return if $self->checkPolynomial;
+ $self->Error("Your answer doesn't look like a polynomial");
+}
+
+#
+# filled in by subclasses
+#
+sub checkPolynomial {return 0}
+
+#
+# Check that the powers of combined monomials are OK
+# and record the new power list
+#
+sub checkPowers {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ my $single = $self->{equation}{context}->flag('singlePowers');
+ $self->{isPoly} = 1;
+ $self->{powers} = $l->{powers}? {%{$l->{powers}}} : {};
+ $r->{powers} = {1=>1} if $r->class eq 'Variable';
+ return 1 unless $r->{powers};
+ foreach my $n (keys(%{$r->{powers}})) {
+ $self->Error("Polynomials can have at most one term of each degree")
+ if $self->{powers}{$n} && $single;
+ $self->{powers}{$n} = 1;
+ }
+ return 1;
+}
+
+package LimitedPolynomial;
+
+#
+# Check for a constant expression
+#
+sub isConstant {
+ my $self = shift;
+ return 1 if $self->{isConstant} || $self->class eq 'Constant';
+ return scalar(keys(%{$self->getVariables})) == 0;
+}
+
+##############################################
+#
+# Now we get the individual replacements for the operators
+# that we don't want to allow. We inherit everything from
+# the original Parser::BOP class, and just add the
+# polynomial checks here. Note that checkpolynomial
+# only gets called if at least one of the terms is not
+# a number.
+#
+
+package LimitedPolynomial::BOP::add;
+our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::add);
+
+sub checkPolynomial {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->Error("Addition is allowed only between monomials")
+ if $r->{isPoly};
+ $self->checkPowers;
+}
+
+##############################################
+
+package LimitedPolynomial::BOP::subtract;
+our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::subtract);
+
+sub checkPolynomial {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->Error("Subtraction is only allowed between monomials")
+ if $r->{isPoly};
+ $self->checkPowers;
+}
+
+##############################################
+
+package LimitedPolynomial::BOP::multiply;
+our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::multiply);
+
+sub checkPolynomial {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ if (LimitedPolynomial::isConstant($l) && ($r->{isPower} || $r->class eq 'Variable')) {
+ $r->{powers} = {1=>1} unless $r->{isPower};
+ $self->{powers} = {%{$r->{powers}}};
+ return 1;
+ }
+ $self->Error("Coefficients must come before variables in a polynomial")
+ if LimitedPolynomial::isConstant($r) && ($l->{isPower} || $l->class eq 'Variable');
+ $self->Error("Multiplication can only be used between coefficients and variables");
+}
+
+##############################################
+
+package LimitedPolynomial::BOP::divide;
+our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::divide);
+
+sub checkPolynomial {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->Error("You can only divide by a number in a polynomial")
+ unless LimitedPolynomial::isConstant($r);
+ $self->Error("You can only divide a single monomial by a number")
+ if $l->{isPoly} && $l->{isPoly} == 1;
+ $self->{isPoly} = $l->{isPoly};
+ $self->{powers} = {%{$l->{powers}}} if $l->{powers};
+ return 1;
+}
+
+##############################################
+
+package LimitedPolynomial::BOP::power;
+our @ISA = qw(LimitedPolynomial::BOP Parser::BOP::power);
+
+sub checkPolynomial {
+ my $self = shift;
+ my ($l,$r) = ($self->{lop},$self->{rop});
+ $self->{isPower} = 1;
+ $self->Error("You can only raise a variable to a power in a polynomial")
+ unless $l->class eq 'Variable';
+ $self->Error("Exponents must be constant in a polynomial")
+ unless LimitedPolynomial::isConstant($r);
+ my $n = Parser::Evaluate($r);
+ $r->Error($$Value::context->{error}{message}) if $$Value::context->{error}{flag};
+ $self->Error("Exponents must be positive integers in a polynomial")
+ unless $n > 0 && $n == int($n);
+ $self->{powers} = {$n=>1};
+ return 1;
+}
+
+##############################################
+##############################################
+#
+# Now we do the same for the unary operators
+#
+
+package LimitedPolynomial::UOP;
+
+sub _check {
+ my $self = shift;
+ my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
+ &{$super."::_check"}($self);
+ my $op = $self->{op};
+ return if LimitedPolynomail::isConstant($op);
+ $self->Error("You can only use '$self->{def}{string}' with monomials")
+ if $op->{isPoly};
+ $self->{isPoly} = 2;
+ $self->{powers} = {%{$op->{powers}}} if $op->{powers};
+}
+
+sub checkPolynomial {return 0}
+
+##############################################
+
+package LimitedPolynomial::UOP::plus;
+our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::plus);
+
+##############################################
+
+package LimitedPolynomial::UOP::minus;
+our @ISA = qw(LimitedPolynomial::UOP Parser::UOP::minus);
+
+##############################################
+##############################################
+#
+# Don't allow absolute values
+#
+
+package LimitedPolynomial::List::AbsoluteValue;
+our @ISA = qw(Parser::List::AbsoluteValue);
+
+sub _check {
+ my $self = shift;
+ $self->SUPER::_check;
+ return if LimitedPolynomial::isConstant($self->{coords}[0]);
+ $self->Error("Can't use absolute values in polynomials");
+}
+
+##############################################
+##############################################
+#
+# Only allow numeric function calls
+#
+
+package LimitedPolynomial::Function;
+
+sub _check {
+ my $self = shift;
+ my $super = ref($self); $super =~ s/LimitedPolynomial/Parser/;
+ &{$super."::_check"}($self);
+ my $arg = $self->{params}->[0];
+ return if LimitedPolynomial::isConstant($arg);
+ $self->Error("Function '$self->{name}' can only be used with numbers");
+}
+
+
+package LimitedPolynomial::Function::numeric;
+our @ISA = qw(LimitedPolynomial::Function Parser::Function::numeric);
+
+package LimitedPolynomial::Function::trig;
+our @ISA = qw(LimitedPolynomial::Function Parser::Function::trig);
+
+##############################################
+##############################################
+
+package main;
+
+#
+# Now build the new context that calls the
+# above classes rather than the usual ones
+#
+
+$context{LimitedPolynomial} = Context("Numeric");
+$context{LimitedPolynomial}->operators->set(
+ '+' => {class => 'LimitedPolynomial::BOP::add'},
+ '-' => {class => 'LimitedPolynomial::BOP::subtract'},
+ '*' => {class => 'LimitedPolynomial::BOP::multiply'},
+ '* ' => {class => 'LimitedPolynomial::BOP::multiply'},
+ ' *' => {class => 'LimitedPolynomial::BOP::multiply'},
+ ' ' => {class => 'LimitedPolynomial::BOP::multiply'},
+ '/' => {class => 'LimitedPolynomial::BOP::divide'},
+ ' /' => {class => 'LimitedPolynomial::BOP::divide'},
+ '/ ' => {class => 'LimitedPolynomial::BOP::divide'},
+ '^' => {class => 'LimitedPolynomial::BOP::power'},
+ '**' => {class => 'LimitedPolynomial::BOP::power'},
+ 'u+' => {class => 'LimitedPolynomial::UOP::plus'},
+ 'u-' => {class => 'LimitedPolynomial::UOP::minus'},
+);
+#
+# Remove these operators and functions
+#
+$context{LimitedPolynomial}->lists->set(
+ AbsoluteValue => {class => 'LimitedPolynomial::List::AbsoluteValue'},
+);
+$context{LimitedPolynomial}->operators->undefine('_','!','U');
+$context{LimitedPolynomial}->functions->disable("Hyperbolic","atan2");
+#
+# Hook into the numeric and trig functions
+#
+foreach ('sin','cos','tan','sec','csc','cot',
+ 'asin','acos','atan','asec','acsc','acot') {
+ $context{LimitedPolynomial}->functions->set(
+ "$_"=>{class => 'LimitedPolynomial::Function::trig'}
+ );
+}
+foreach ('ln','log','log10','exp','sqrt','abs','int','sgn') {
+ $context{LimitedPolynomial}->functions->set(
+ "$_"=>{class => 'LimitedPolynomial::Function::numeric'}
+ );
+}
+
+Context("LimitedPolynomial");
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-15 22:23:26
|
Log Message:
-----------
Added separate file for rendering operation
Added Files:
-----------
webwork-modperl/lib/RQP:
Render.pm
Revision Data
-------------
--- /dev/null
+++ lib/RQP/Render.pm
@@ -0,0 +1,150 @@
+#!/usr/local/bin/perl -w
+
+package RQP::Render;
+@ISA = qw( RQP );
+use WebworkWebservice;
+use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
+
+our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY;
+our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY;
+our $COURSENAME = $WebworkWebservice::COURSENAME;
+our $HOST_NAME = $WebworkWebservice::HOST_NAME;
+our $HOSTURL ="http://$HOST_NAME:8002"; #FIXME
+our $ce =$WebworkWebservice::SeedCE;
+# create a local course environment for some course
+ $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
+#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
+our $db = WeBWorK::DB->new($ce->{dbLayout});
+
+sub RQP_Render {
+ my $class = shift;
+ my $soap_som = pop;
+ my $rh_params= $soap_som->method;
+
+ local(*DEBUGLOG);
+ open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file";
+ print DEBUGLOG "--RQP_Render\n";
+ #my $output = WebworkWebservice::pretty_print_rh(\%parameters);
+ my $source = $rh_params->{source};
+ $source =~s/</</g;
+ $source =~s/>/>/g;
+ my $output = "the first element is ". $self. " and the last ". ref($envelope)."\n\n";
+ $output .= WebworkWebservice::pretty_print_rh($rh_params);
+
+ my %templatevars = @{$rh_params->{templatevars}};
+ my $templatevars =\%templatevars;
+ print DEBUGLOG "templateVars (", join("|", @{$rh_params->{templateVars}}),")\n";
+
+ #############
+ # Default environment
+ #############
+ my $userName = "foobar";
+ my $user = $db->getUser($userName);
+ my $key = "asdfasdfasdf";
+
+ my $problemNumber = (defined($templatevars->{envir}->{probNum}) ) ? $templatevars->{envir}->{probNum} : 1 ;
+ my $problemSeed = (defined($templatevars->{envir}->{problemSeed})) ? $templatevars->{envir}->{problemSeed} : 1 ;
+ my $psvn = (defined($templatevars->{envir}->{psvn}) ) ? $templatevars->{envir}->{psvn} : 1234 ;
+ my $problemStatus = $templatevars->{problem_state}->{recorded_score}|| 0 ;
+ my $problemValue = (defined($templatevars->{envir}->{problemValue})) ? $templatevars->{envir}->{problemValue} : 1 ;
+ my $num_correct = $templatevars->{problem_state}->{num_correct} || 0 ;
+ my $num_incorrect = $templatevars->{problem_state}->{num_incorrect} || 0 ;
+ my $problemAttempted = ($num_correct && $num_incorrect);
+ my $lastAnswer = '';
+ ########
+ # set
+ ########
+ my $setRecord = initializeDefaultSet($db);
+
+ ########
+ # problem
+ ########
+ my $problemRecord = initializeDefaultProblem($db);
+
+
+
+ my $formFields = {};
+ my $translationOptions = {};
+ my $rh_envir = WeBWorK::PG::defineProblemEnvir(
+ $class,
+ $ce,
+ $user,
+ $key,
+ $setRecord,
+ $problemRecord,
+ $setRecord->psvn,
+ $formFields,
+ $translationOptions,
+ );
+
+ $templatevars->{envir} = $rh_envir;
+ #hack -- root is a restricted term
+ $templatevars->{envir}->{__files__} = '';
+ $templatevars->{envir}->{problemSeed}++;
+
+ ##############
+ my @templatevars = %$templatevars;
+ my $rh_out = {
+ templateVars => packRQParray($templatevars),
+ index => 'index',
+ advanceState => 0,
+ embedPrefix => 'AnSwErAnSwEr',
+ appletBase => 'unknown',
+ mediaBase => 'unknown url',
+ renderFormat => 'HTML',
+ modalFormat => 'dvipng',
+ persistentData => 'this is a string',
+ outcomeVars => [{identifier=>'id',values=>345}],
+ output => packRQParray($output),
+ source => $source,
+ input => '<hr>'.WebworkWebservice::pretty_print_rh($rh_params).'<hr>',
+
+ };
+ print DEBUGLOG $output;
+ close(DEBUGLOG);
+ return $rh_out;
+
+}
+sub packRQParray {
+ my $rh_hash=shift;
+ my @array = ();
+ foreach $key (keys %{$rh_hash}) {
+ push @array, {identifier => $key, values => $rh_hash->{$key}};
+ }
+ \@array;
+}
+sub initializeDefaultSet {
+ my $db = shift;
+
+ my $setName = 'set0';
+ my $setRecord = fake_set($db);
+ $setRecord->set_id($setName);
+ $setRecord->set_header("");
+ $setRecord->hardcopy_header("");
+ $setRecord->open_date(time()-60*60*24*7); # one week ago
+ $setRecord->due_date(time()+60*60*24*7*2); # in two weeks
+ $setRecord->answer_date(time()+60*60*24*7*3); # in three weeks
+ $setRecord->psvn(0);
+ $setRecord;
+}
+
+sub initializeDefaultProblem {
+ my $db = shift;
+ my $userName = 'foobar';
+ my $problemNumber = 0;
+ my $setName = 'set0';
+ my $problemRecord = fake_problem($db);
+ $problemRecord->user_id($userName);
+ $problemRecord->problem_id(0);
+ $problemRecord->set_id($setName);
+ $problemRecord->problem_seed(0);
+ $problemRecord->status(0);
+ $problemRecord->value(1);
+ $problemRecord->attempted(0);
+ $problemRecord->last_answer('');
+ $problemRecord->num_correct(0);
+ $problemRecord->num_incorrect(0);
+ $problemRecord;
+
+}
+1;
\ No newline at end of file
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-15 22:22:42
|
Update of /webwork/cvs/system/webwork-modperl/lib/RQP In directory devel.webwork.rochester.edu:/home/gage/webwork/webwork-modperl/lib/RQP Log Message: Directory /webwork/cvs/system/webwork-modperl/lib/RQP added to the repository |
|
From: Mike G. v. a. <we...@ma...> - 2005-06-15 22:20:26
|
Log Message:
-----------
Cosmetic change to pretty_print_rh
Modified Files:
--------------
webwork-modperl/lib:
MySOAP.pm
RQP.pm
WebworkWebservice.pm
webwork-modperl/lib/WeBWorK:
Constants.pm
webwork-modperl/lib/WebworkWebservice:
RenderProblem.pm
Revision Data
-------------
Index: MySOAP.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/MySOAP.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/MySOAP.pm -Llib/MySOAP.pm -u -r1.1 -r1.2
--- lib/MySOAP.pm
+++ lib/MySOAP.pm
@@ -33,9 +33,6 @@
################
my %args_hash = $r->args;
if (exists $args_hash{wsdl}) {
- my $wsdl = `cat /home/gage/rqp.wsdl`;
- $r->content_type('application/wsdl+xml');
- $r->send_http_header;
$r->print( $wsdl);
print DEBUGLOG "----------start-------------\n";
print DEBUGLOG "handle wsdl request\n";
Index: RQP.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/RQP.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/RQP.pm -Llib/RQP.pm -u -r1.1 -r1.2
--- lib/RQP.pm
+++ lib/RQP.pm
@@ -13,6 +13,20 @@
@ISA = (SOAP::Server::Parameters);
local(*MYLOG);
+use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
+use RQP::Render;
+
+our $WW_DIRECTORY = $WebworkWebservice::WW_DIRECTORY;
+our $PG_DIRECTORY = $WebworkWebservice::PG_DIRECTORY;
+our $COURSENAME = $WebworkWebservice::COURSENAME;
+our $HOST_NAME = $WebworkWebservice::HOST_NAME;
+our $HOSTURL ="http://$HOST_NAME:8002"; #FIXME
+our $ce =$WebworkWebservice::SeedCE;
+# create a local course environment for some course
+ $ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
+#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
+our $db = WeBWorK::DB->new($ce->{dbLayout});
+
#print MYLOG "restarting server\n\n";
sub test {
open MYLOG, ">>/home/gage/debug_info.txt" ;
@@ -93,10 +107,12 @@
local(*DEBUGLOG);
open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file";
print DEBUGLOG "--RQP_SessionInformation\n";
- my $templateVars = [];
+ my $templatevars = $rh_params->{templatevars};
+ $templatevars->{seed}=4321;
my $correctResponses = [];
$rh_out = {
- 'templateVars' => $templateVars,
+ 'outcomevars' => {id=>45},
+ 'templatevars' => $templatevars,
'correctResponses' => $correctResponses,
input => '<hr>'.WebworkWebservice::pretty_print_rh($rh_params).'<hr>',
};
@@ -106,29 +122,7 @@
sub RQP_Render {
- my $class = shift;
- my $soap_som = pop;
- my $rh_params= $soap_som->method;
- local(*DEBUGLOG);
- open DEBUGLOG, ">>/home/gage/debug_info.txt" || die "can't open debug file";
- print DEBUGLOG "--RQP_Render\n";
- #my $output = WebworkWebservice::pretty_print_rh(\%parameters);
- my $source = $rh_params->{source};
- $source =~s/</</g;
- $source =~s/>/>/g;
- my $output = "the first element is ". $self. " and the last ". ref($envelope)."\n\n";
- $output .= WebworkWebservice::pretty_print_rh($rh_params);
- my $rh_out = {
- templateVars => [],
- persistentData => '',
- outcomeVars => [],
- output => $output,
- source => $source,
- input => '<hr>'.WebworkWebservice::pretty_print_rh($rh_params).'<hr>',
-
- };
- close(DEBUGLOG);
- return $rh_out;
+ RQP::Render::RQP_Render(@_);
}
Index: WebworkWebservice.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WebworkWebservice.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/WebworkWebservice.pm -Llib/WebworkWebservice.pm -u -r1.3 -r1.4
--- lib/WebworkWebservice.pm
+++ lib/WebworkWebservice.pm
@@ -63,7 +63,7 @@
if (defined($type) and $type) {
$out .= " type = $type; ";
} elsif ($rh == undef) {
- $out .= " type = UNDEFINED; ";
+ $out .= " type = scalar; ";
}
if ( ref($rh) =~/HASH/ or "$rh" =~/HASH/ ) {
$out .= "{\n";
@@ -240,14 +240,6 @@
package Filter;
-
-
-
-
-
-
-
-
sub is_hash_ref {
my $in =shift;
my $save_SIG_die_trap = $SIG{__DIE__};
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Constants.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.24 -r1.25
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -54,7 +54,7 @@
# If non-empty, timing data will be sent to the file named rather than STDERR.
#
-$WeBWorK::Timing::Logfile = "";
+$WeBWorK::Timing::Logfile = "/home/gage/webwork2/logs/timing.log";
################################################################################
# WeBWorK::ContentGenerator::Hardcopy
@@ -75,7 +75,7 @@
# For dvipng >= 1.0
# $WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
#
-$WeBWorK::PG::ImageGenerator::DvipngArgs = "-x4000.5 -bgTransparent -Q6 -mode toshiba -D180";
+$WeBWorK::PG::ImageGenerator::DvipngArgs = "-bgTransparent -D120 -q -depth";
# If true, don't delete temporary files
#
Index: RenderProblem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WebworkWebservice/RenderProblem.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WebworkWebservice/RenderProblem.pm -Llib/WebworkWebservice/RenderProblem.pm -u -r1.4 -r1.5
--- lib/WebworkWebservice/RenderProblem.pm
+++ lib/WebworkWebservice/RenderProblem.pm
@@ -8,6 +8,8 @@
use WebworkWebservice;
use base qw(WebworkWebservice);
+my $debugXmlCode=1; # turns on the filter for debugging XMLRPC and SOAP code
+local(*DEBUGCODE);
BEGIN {
$main::VERSION = "2.1";
@@ -48,7 +50,7 @@
$ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
#print "\$ce = \n", WeBWorK::Utils::pretty_print_rh($ce);
-print "webwork is really ready\n\n";
+
#other services
# File variables
#our $WARNINGS='';
@@ -100,6 +102,7 @@
my $rh = shift;
+
###########################################
# Grab the course name, if this request is going to depend on
# some course other than the default course
@@ -121,7 +124,8 @@
# Create database object for this course
$db = WeBWorK::DB->new($ce->{dbLayout});
};
- $ce->{pg}->{options}->{catchWarnings};
+ # $ce->{pg}->{options}->{catchWarnings}=1; #FIXME warnings aren't automatically caught
+ # when using xmlrpc -- turn this on in the daemon2_course.
#^FIXME need better way of determining whether the course actually exists.
if ($@) {
$ce = WeBWorK::CourseEnvironment->new($WW_DIRECTORY, "", "", $COURSENAME);
@@ -361,27 +365,68 @@
};
- # Hack to filter out CODE references
- foreach my $ans (keys %{$out2->{answers}}) {
- foreach my $item (keys %{$out2->{answers}->{$ans}}) {
- my $contents = $out2->{answers}->{$ans}->{$item};
- if (ref($contents) =~ /CODE/ ) {
- #warn "removing code at $ans $item ";
- $out2->{answers}->{$ans}->{$item} = undef;
- }
- }
-
+ # Filter out bad reference types
+ ###################
+ # DEBUGGING CODE
+ ###################
+ if ($debugXmlCode) {
+ my $logDirectory =$ce->{courseDirs}->{logs};
+ my $xmlDebugLog = "$logDirectory/xml_debug.txt";
+ warn "Opening debug log $xmlDebugLog\n" ;
+ open (DEBUGCODE, ">>$xmlDebugLog") || die "Can't open $xmlDebugLog";
+ print DEBUGCODE "\n\nStart xml encoding\n";
}
+ xml_filter($out2->{answers});
+
+ ##################
+ close(DEBUGCODE) if $debugXmlCode;
+ ###################
+
$out2->{PG_flag}->{PROBLEM_GRADER_TO_USE} = undef;
my $endTime = new Benchmark;
$out2->{compute_time} = logTimingInfo($beginTime, $endTime);
# warn "flags are" , WebworkWebservice::pretty_print_rh($pg->{flags});
+
$out2;
}
-
+sub xml_filter {
+ my $input = shift;
+ my $level = shift || 0;
+ my $space=" ";
+ # Hack to filter out CODE references
+ my $type = ref($input);
+ if (!defined($type) or !$type ) {
+ print DEBUGCODE $space x $level." : scalar -- not converted\n" if $debugXmlCode;
+ } elsif( $type =~/HASH/i or "$input"=~/HASH/i) {
+ print DEBUGCODE "HASH reference with ".%{$input}." elements will be investigated\n" if $debugXmlCode;
+ $level++;
+ foreach my $item (keys %{$input}) {
+ print DEBUGCODE " "x$level."$item is " if $debugXmlCode;
+ $input->{$item} = xml_filter($input->{$item},$level);
+ }
+ $level--;
+ print DEBUGCODE " "x$level."HASH reference completed \n" if $debugXmlCode;
+ } elsif( $type=~/ARRAY/i or "$input"=~/ARRAY/i) {
+ print DEBUGCODE " "x$level."ARRAY reference with ".@{$input}." elements will be investigated\n" if $debugXmlCode;
+ $level++;
+ foreach my $item (@{$input}) {
+ $item = xml_filter($item,$level);
+ }
+ $level--;
+ print DEBUGCODE " "x$level."ARRAY reference completed \n" if $debugXmlCode;
+ } elsif($type =~ /CODE/i or "$input" =~/CODE/i) {
+ $input = "CODE reference";
+ print DEBUGCODE " "x$level."CODE reference, converted $input\n" if $debugXmlCode;
+ } else {
+ print DEBUGCODE " "x$level." $type and was converted to string\n" if $debugXmlCode;
+ $input = "$type reference";
+ }
+ $input;
+
+}
sub logTimingInfo{
|
|
From: jj v. a. <we...@ma...> - 2005-06-15 22:02:50
|
Log Message:
-----------
Changed whitespace removal of TeX strings to safer version.
Modified Files:
--------------
pg/lib/WeBWorK:
EquationCache.pm
Revision Data
-------------
Index: EquationCache.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/WeBWorK/EquationCache.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/WeBWorK/EquationCache.pm -Llib/WeBWorK/EquationCache.pm -u -r1.2 -r1.3
--- lib/WeBWorK/EquationCache.pm
+++ lib/WeBWorK/EquationCache.pm
@@ -75,7 +75,17 @@
sub lookup {
my ($self, $tex) = @_;
- $tex =~ s/\s+//g;
+ # There are several ways to normalize TeX strings. Use only
+ # one of them.
+
+ # Option 1 (default): remove leading and trailing whitespace, and
+ # compress all other whitespace to single spaces.
+ $tex =~ s/^\s+//g;
+ $tex =~ s/\s+$//g;
+ $tex =~ s/\s+/ /g;
+ # Option 2 (the old default): remove all whitespace
+ # $tex =~ s/\s+//g;
+
my $md5 = md5_hex($tex);
my $db = $self->{cacheDB};
|
|
From: jj v. a. <we...@ma...> - 2005-06-15 21:48:37
|
Log Message:
-----------
This change affects course creation using mysql. Field types are now
determined by DB/Record/*.pm in the function SQL_TYPES. Key fields
which are text are set to binary types (blobs) so that indexing on those
fields is case sensitive. The net result should be fast database access
while still having it be case-sensitive in the searching.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/Utils/CourseManagement:
sql.pm
sql_single.pm
Revision Data
-------------
Index: sql_single.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/CourseManagement/sql_single.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -Llib/WeBWorK/Utils/CourseManagement/sql_single.pm -u -r1.4 -r1.5
--- lib/WeBWorK/Utils/CourseManagement/sql_single.pm
+++ lib/WeBWorK/Utils/CourseManagement/sql_single.pm
@@ -74,6 +74,8 @@
debug("$table: WeBWorK field names: @fields\n");
my @keyfields = $recordClass->KEYFIELDS;
debug("$table: WeBWorK keyfield names: @keyfields\n");
+ my @fieldtypes = $recordClass->SQL_TYPES;
+ debug("$table: WeBWorK field types: @fieldtypes\n");
if (exists $params{fieldOverride}) {
my %fieldOverride = %{ $params{fieldOverride} };
@@ -83,20 +85,23 @@
debug("$table: SQL field names: @fields\n");
}
+ my %fieldtypehash =();
+ for my $cnt (0..(scalar(@fields)-1)) {
+ $fieldtypehash{$fields[$cnt]} = $fieldtypes[$cnt];
+ }
# generate table creation statement
my @fieldList;
+ # special handling of psvn's is now taken care of by
+ # its entry in %fieldtypehash, which comes from SQL_TYPES
foreach my $field (@fields) {
- # a stupid hack to make PSVNs numeric and auto-increment
- if ($field eq "psvn") {
- push @fieldList, "`$field` INT NOT NULL PRIMARY KEY AUTO_INCREMENT";
- } else {
- push @fieldList, "`$field` TEXT";
- }
+ push @fieldList, "`$field` $fieldtypehash{$field}";
}
foreach my $start (0 .. $#keyfields) {
my $line = "INDEX ( ";
- $line .= join(", ", map { "`$_`(16)" } @keyfields[$start .. $#keyfields]);
+ # we only need to limit the length of the value for
+ # types text and blob, but can't do it for int.
+ $line .= join(", ", map { "`$_`". (($fieldtypehash{$_} =~ /int/i) ? "" : "(16)") } @keyfields[$start .. $#keyfields]);
$line .= " )";
push @fieldList, $line;
}
Index: sql.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/CourseManagement/sql.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/WeBWorK/Utils/CourseManagement/sql.pm -Llib/WeBWorK/Utils/CourseManagement/sql.pm -u -r1.2 -r1.3
--- lib/WeBWorK/Utils/CourseManagement/sql.pm
+++ lib/WeBWorK/Utils/CourseManagement/sql.pm
@@ -71,6 +71,8 @@
debug("$table: WeBWorK field names: @fields\n");
my @keyfields = $recordClass->KEYFIELDS;
debug("$table: WeBWorK keyfield names: @keyfields\n");
+ my @fieldtypes = $recordClass->SQL_TYPES;
+ debug("$table: WeBWorK field types: @fieldtypes\n");
if (exists $params{fieldOverride}) {
my %fieldOverride = %{ $params{fieldOverride} };
@@ -80,20 +82,19 @@
debug("$table: SQL field names: @fields\n");
}
+ my %fieldtypehash =();
+ for my $cnt (0..(scalar(@fields)-1)) {
+ $fieldtypehash{$fields[$cnt]} = $fieldtypes[$cnt];
+ }
# generate table creation statement
my @fieldList;
foreach my $field (@fields) {
- # a stupid hack to make PSVNs numeric and auto-increment
- if ($field eq "psvn") {
- push @fieldList, "`$field` INT NOT NULL PRIMARY KEY AUTO_INCREMENT";
- } else {
- push @fieldList, "`$field` TEXT";
- }
+ push @fieldList, "`$field` $fieldtypehash{$field}";
}
foreach my $start (0 .. $#keyfields) {
my $line = "INDEX ( ";
- $line .= join(", ", map { "`$_`(16)" } @keyfields[$start .. $#keyfields]);
+ $line .= join(", ", map { "`$_`". (($fieldtypehash{$_} = /int/i) ? "" : "(16)") } @keyfields[$start .. $#keyfields]);
$line .= " )";
push @fieldList, $line;
}
|
2 messages has been excluded from this view by a project administrator.
