--- loncom/homework/default_homework.lcpm 2008/11/26 18:11:52 1.142 +++ loncom/homework/default_homework.lcpm 2011/06/08 01:39:28 1.157 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run() # -# $Id: default_homework.lcpm,v 1.142 2008/11/26 18:11:52 raeburn Exp $ +# $Id: default_homework.lcpm,v 1.157 2011/06/08 01:39:28 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -220,7 +220,7 @@ sub caparesponse_check { if (($type eq '9') || ($type eq '8')) { if ($response=~/\=/) { return ('BAD_FORMULA','Please submit just an expression, not an equation.'); - } elsif ($response =~ /\,/) { + } elsif ($response =~ /\,/ and $response !~ /^\s*\{.*\}\s*$/) { return ('BAD_FORMULA'); } } @@ -270,7 +270,10 @@ sub caparesponse_check_list { my $type = $LONCAPA::CAPAresponse_args{'type'}; my $answerunit=$LONCAPA::CAPAresponse_args{'unit'}; &LONCAPA_INTERNAL_DEBUG("Got type :$type: answer unit :$answerunit:\n"); - + + my $preprocess=$LONCAPA::CAPAresponse_args{'preprocess'}; + $preprocess=~s/^\&//; + my $num_input_lines = scalar(@{$LONCAPA::CAPAresponse_answer->{'answers'}}); @@ -309,31 +312,63 @@ sub caparesponse_check_list { &LONCAPA_INTERNAL_DEBUG("Initial final response :$responses->[0][-1]:"); my $unit; + my ($allowalgebra)=(¶meter_setting('allowalgebra',¤tpart())=~/^(yes|1|on)$/i); if ($type eq 'float' || $type eq '') { #for numerical problems split off the unit -# if ( $responses->[0][-1]=~ /(.*[^\s])\s+([^\s]+)/ ) { - if ( $responses->[0][-1]=~ /^([\d\.\,\s\$]*(?:(?:[xX\*]10[\^\*]*|[eE]*)[\+\-]*\d*)*(?:^|\S)\d+)([\$\s\w\^\*\/\(\)\+\-]*[^\d\.\s\,][\$\s\w\^\*\/\(\)\+\-]*)$/ ) { - $responses->[0][-1]=$1; - $unit=&capa_formula_fix($2); + my $part1; + my $part2; + if ($allowalgebra) { + ($part1,$part2)=($responses->[0][-1]=~ /^(.*[^\s])\s+([^\s]+)$/); + } else { + ($part1,$part2)=($responses->[0][-1]=~ /^([\d\.\,\s\$]*(?:(?:[xX\*]10[\^\*]*|[eE]*)[\+\-]*\d*)*(?:^|\S)\d+)([\$\s\w\^\*\/\(\)\+\-]*[^\d\.\s\,][\$\s\w\^\*\/\(\)\+\-]*)$/); + } + if (defined($part1) && defined($part2)) { + $responses->[0][-1]=$part1; + $unit=&capa_formula_fix($part2); &LONCAPA_INTERNAL_DEBUG("Found unit :$unit:"); } } &LONCAPA_INTERNAL_DEBUG("Final final response :$responses->[0][-1]:$unit:"); $unit=~s/\s//; + my $error; foreach my $response (@$responses) { - foreach my $element (@$response) { + foreach my $element (@$response) { + # See if we have preprocessor + if ($preprocess=~/\S/) { + if (defined(&$preprocess)) { + no strict 'refs'; + $element=&$preprocess($element); + use strict 'refs'; + } + } if (($type eq 'float') || (($type eq '') && ($unit ne ''))) { $element =~ s/\s//g; } my $appendunit=$unit; - if (($unit=~/\%/) && ($answerunit ne '%')) { - $element=$element/100; - $appendunit=~s/\%//; - } +# Deal with percentages +# unit is unit entered by student, answerunit is unit by author +# Deprecated: divide answer by 100 if student entered percent, +# but author did not. Too much confusion +# if (($unit=~/\%/) && ($answerunit ne '%')) { +# $element=$element/100; +# $appendunit=~s/\%//; +# } +# Author entered percent, student did not + if (($unit!~/\%/) && ($answerunit=~/\%/)) { + $element=$element*100; + $appendunit='%'.$appendunit; + } +# Zero does not need a dimension if (($element==0) && ($unit!~/\w/) && ($answerunit=~/\w/)) { $appendunit=$answerunit; } - $element .= " $appendunit"; +# Do the math for the student if allowed + if ($allowalgebra) { + $element=&cas('maxima',$element); + } + if ($appendunit ne '') { + $element .= " $appendunit"; + } &LONCAPA_INTERNAL_DEBUG("Made response element :$element:"); } } @@ -344,6 +379,23 @@ sub caparesponse_check_list { } } + my $allow_control_char = 0; + my $control_chars_removed = 0; + my $ansstring; + if ($type eq 'cs' || $type eq 'ci') { + if (ref($LONCAPA::CAPAresponse_answer->{'answers'}) eq 'ARRAY') { + foreach my $strans (@{$LONCAPA::CAPAresponse_answer->{'answers'}}) { + if (ref($strans) eq 'ARRAY') { + $ansstring = join("\0",@{$strans}); + foreach my $item (@{$strans}) { + if ($item =~ /[\000-\037]/) { + $allow_control_char = 1; + } + } + } + } + } + } # &LONCAPA_INTERNAL_DEBUG(&LONCAPA_INTERNAL_Dumper($responses)); my %memoized; @@ -353,9 +405,21 @@ sub caparesponse_check_list { my $response = $responses->[$i]; my $key = "$answer\0$response"; my (@awards,@msgs); - for (my $j=0; $j[$j] =~ /[\000-\037]/) { + $response->[$j] =~ s/[\000-\037]//g; + $control_chars_removed = 1; + } + } + } my ($award,$msg) = &caparesponse_check($answer->[$j], $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$j]); + } push(@awards,$award); push(@msgs, $msg); } @@ -380,8 +444,20 @@ sub caparesponse_check_list { } else { my (@awards,@msgs); for (my $j=0; $j[$j] =~ /[\000-\037]/) { + $response->[$j] =~ s/[\000-\037]//g; + $control_chars_removed = 1; + } + } + } my ($award,$msg) = &caparesponse_check($answer->[$j], $response->[$j]); + if ($type eq 'cs' || $type eq 'ci') { + $error = &verify_stringresponse($type,$award,$response->[$j], + $answer->[$j]); + } push(@awards,$award); push(@msgs, $msg); } @@ -428,20 +504,75 @@ sub caparesponse_check_list { &LONCAPA_INTERNAL_DEBUG(" all final_awards ".join(':',@final_awards)); my ($final_award,$final_msg) = &LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1); - return ($final_award,$final_msg); + return ($final_award,$final_msg,$error,$control_chars_removed,$ansstring); +} + +sub verify_stringresponse { + my ($type,$award,$resp,$ans) = @_; + return if ($award eq 'EXACT_ANS'); + my $error; + if ($resp =~ /^\s|\s$/) { + $resp =~ s{^\s+|\s+$}{}g; + } + if ($ans =~ /^\s|\s$/) { + $ans =~ s{^\s+|\s+$}{}g; + } + if ($type eq 'ci') { + $resp = lc($resp); + $ans = lc($ans); + } + if ($resp eq $ans) { + if ($award eq 'INCORRECT') { + $error = 'MISGRADED'; + } + } + return $error; } sub cas { my ($system,$input,$library)=@_; my $output; + my $dump; if ($system eq 'maxima') { $output=&maxima_eval($input,$library); + } elsif ($system eq 'R') { + ($output,$dump)=&r_eval($input,$library,0); } else { $output='Error: unrecognized CAS'; } return $output; } +sub cas_hashref { + my ($system,$input,$library)=@_; + if ($system eq 'maxima') { + return 'Error: unsupported CAS'; + } elsif ($system eq 'R') { + return &r_eval($input,$library,1); + } else { + return 'Error: unrecognized CAS'; + } +} + +# +# cas_hashref_entry takes a list of indices and gets the entry in a hash generated by Rreturn. +# Call: cas_hashref_entry(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn. +# Rentry will return the first scalar value it encounters (ignoring excess indices). +# If an invalid key is given, it returns undef. +# +sub cas_hashref_entry { + return &Rentry(@_); +} + +# +# cas_hashref_array takes a list of indices and gets a column array from a hash generated by Rreturn. +# Call: cas_hashref_array(Rvalue, index1, index2, ...) where Rvalue is a hash returned by Rreturn. +# If an invalid key is given, it returns undef. +# +sub cas_hashref_array { + return &Rarray(@_); +} + sub tex { if ( $external::target eq "tex" ) { return $_[0]; @@ -1016,11 +1147,24 @@ sub class { return $course; } +sub classid { + my $courseid = &EXT('request.course.id'); + $courseid = '' if $courseid eq ""; + return $courseid; +} + sub firstname { my $firstname = &EXT('environment.firstname'); $firstname = '' if $firstname eq ""; return $firstname; } + +sub middlename { + my $middlename = &EXT('environment.middlename'); + $middlename = '' if $middlename eq ""; + return $middlename; +} + sub lastname { my $lastname = &EXT('environment.lastname'); @@ -1087,6 +1231,40 @@ sub answer_date_epoch { return &EXT('resource.'.$partid.'.answerdate'); } +sub parameter_setting { + my ($which,$partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('resource.'.$partid.'.'.$which); +} + +sub stored_data { + my ($which,$partid)=@_; + unless ($partid) { $partid=0; } + return &EXT('user.resource.resource.'.$partid.'.'.$which); +} + +sub wrong_bubbles { + my ($correct,$lower,$upper,$step,@given)=@_; + my @array=(); + my %hash=(); + foreach my $new (@given) { + $hash{$new}=1; + } + my $num=int(¶meter_setting('numbubbles',¤tpart())); + unless ($num) { $num=8; } + if ($num>1) { + for (my $i=0;$i<=500;$i++) { + my $new=&random($lower,$upper,$step); + if ($hash{$new}) { next; } + if (abs($new-$correct)<$step) { next; } + $hash{$new}=1; + @array=keys(%hash); + if ($#array+2>=$num) { last; } + } + } + return @array; +} + sub array_moments { my @input=@_; my (@output,$N);