--- loncom/homework/default_homework.lcpm 2010/10/18 19:47:31 1.150 +++ loncom/homework/default_homework.lcpm 2019/04/03 22:46:30 1.172.2.1 @@ -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.150 2010/10/18 19:47:31 raeburn Exp $ +# $Id: default_homework.lcpm,v 1.172.2.1 2019/04/03 22:46:30 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -143,7 +143,6 @@ sub caparesponse_check { my $sig_lbound=''; #done my $sig_ubound=''; #done - #type's definitons come from capaParser.h #remove leading and trailing whitespace @@ -152,10 +151,8 @@ sub caparesponse_check { } if ($response=~ /^\s|\s$/) { $response=~ s:^\s+|\s+$::g; - &LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:"); } - #&LONCAPA_INTERNAL_DEBUG(" type is $type "); if ($type eq 'cs' || $type eq 'ci') { #for string answers make sure all places spaces occur, there is #really only 1 space, in both the answer and the response @@ -179,7 +176,6 @@ sub caparesponse_check { if (length($response) > 500) { return ('TOO_LONG',undef); } if ($type eq '' ) { - &LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting"); if ( $answer eq ($answer *1.0)) { $type = 2; } else { $type = 3; } } else { @@ -199,7 +195,6 @@ sub caparesponse_check { #formula type setup the sample points if ($type eq '8') { ($id_list,$points)=split(/@/,$samples); - &LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples"); } if ($tol eq '') { $tol=0.0; @@ -258,8 +253,6 @@ sub caparesponse_check { elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; } else {$result = "ERROR: Unknown Result:$result:$@:";} - &LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response: type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|"); - &LONCAPA_INTERNAL_DEBUG(" $answer $response $result "); return ($result,$reterror); } @@ -270,7 +263,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'}}); @@ -307,22 +303,44 @@ sub caparesponse_check_list { } } - &LONCAPA_INTERNAL_DEBUG("Initial final response :$responses->[0][-1]:"); my $unit; + my ($allowalgebra)=($LONCAPA::CAPAresponse_args{'allowalgebra'}=~/^(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); - &LONCAPA_INTERNAL_DEBUG("Found unit :$unit:"); + 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); + my $customunits=$LONCAPA::CAPAresponse_args{'customunits'}; + if ($customunits =~ /\S/) { + foreach my $replacement (split(/\s*\,\s*/,$customunits)) { + my ($which,$what)=split(/\s*\=\s*/,$replacement); + if ((defined($which)) && (defined($what))) { + $what=&capa_formula_fix($what); + $unit=~s/$which/\($what\)/g; + } + } + } } } - &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,$unit); + use strict 'refs'; + } + } if (($type eq 'float') || (($type eq '') && ($unit ne ''))) { $element =~ s/\s//g; } @@ -341,9 +359,13 @@ sub caparesponse_check_list { $appendunit='%'.$appendunit; } # Zero does not need a dimension - if (($element==0) && ($unit!~/\w/) && ($answerunit=~/\w/)) { + if (($element =~ /^[0\.]+$/) && ($unit!~/\w/) && ($answerunit=~/\w/)) { $appendunit=$answerunit; } +# Do the math for the student if allowed + if ($allowalgebra) { + $element=&cas('maxima',$element); + } if ($appendunit ne '') { $element .= " $appendunit"; } @@ -359,11 +381,17 @@ 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 ($strans =~ /[\000-\037]/) { - $allow_control_char = 1; + if (ref($strans) eq 'ARRAY') { + $ansstring = join("\0",@{$strans}); + foreach my $item (@{$strans}) { + if ($item =~ /[\000-\037]/) { + $allow_control_char = 1; + } + } } } } @@ -386,6 +414,15 @@ sub caparesponse_check_list { } } } + # See if we have preprocessor for string responses + if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci')) { + if (defined(&$preprocess)) { + no strict 'refs'; + $response->[$j]=&$preprocess($response->[$j]); + use strict 'refs'; + } + } + my ($award,$msg) = &caparesponse_check($answer->[$j], $response->[$j]); if ($type eq 'cs' || $type eq 'ci') { @@ -424,6 +461,15 @@ sub caparesponse_check_list { } } } + # See if we have preprocessor + if (($preprocess=~/\S/) && ($type eq 'cs' || $type eq 'ci')) { + if (defined(&$preprocess)) { + no strict 'refs'; + $response->[$j]=&$preprocess($response->[$j]); + use strict 'refs'; + } + } + my ($award,$msg) = &caparesponse_check($answer->[$j], $response->[$j]); if ($type eq 'cs' || $type eq 'ci') { @@ -476,7 +522,7 @@ 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,$error,$control_chars_removed); + return ($final_award,$final_msg,$error,$control_chars_removed,$ansstring); } sub verify_stringresponse { @@ -586,16 +632,29 @@ sub hinton { sub random { my ($start,$end,$step)=@_; if ( ! $hidden::RANDOMINIT ) { - if ($external::randomseed == 0) { $external::randomseed=1; } - if ($external::randomseed =~/,/) { - my ($num1,$num2)=split(/,/,$external::randomseed); - &random_set_seed(1,abs($num1)); - } elsif ($external::randomseed =~/:/) { - my ($num1,$num2)=split(/:/,$external::randomseed); - &random_set_seed(abs($num1),abs($num2)); - } else { - &random_set_seed(1,int(abs($external::randomseed))); - } + if ($external::randomseed == 0) { $external::randomseed=1; } + if ($external::randomseed =~/,/) { + my ($num1,$num2) = map { abs($_); } split(/,/,$external::randomseed); + if ((!$num1) || ($num1 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed(1,$num1); + } + } elsif ($external::randomseed =~/:/) { + my ($num1,$num2) = map { abs($_); } split(/:/,$external::randomseed); + if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed($num1,$num2); + } + } else { + my $num1 = int(abs($external::randomseed)); + if ((!$num1) || ($num1 > 2147483398)) { + &random_set_seed_from_phrase($external::randomseed); + } else { + &random_set_seed(1,$num1); + } + } &math_random_uniform(); $hidden::RANDOMINIT=1; } @@ -770,6 +829,7 @@ sub cos { CORE::cos(shift) } sub exp { CORE::exp(shift) } sub int { CORE::int(shift) } sub log { CORE::log(shift) } +sub ln { CORE::log(shift) } sub atan2 { CORE::atan2($_[0],$_[1]) } sub sqrt { CORE::sqrt(shift) } @@ -855,11 +915,19 @@ sub chemparse { my $formula = ''; foreach my $token (@tokens) { if ($token eq '->' ) { - $formula .= '\ensuremath{\rightarrow} '; + if ($external::target eq 'web') { + $formula .= '→ '; + } else { + $formula .= '\ensuremath{\rightarrow} '; + } next; } if ($token eq '<-' ) { - $formula .= '\ensuremath{\leftarrow} '; + if ($external::target eq 'web') { + $formula .= '← '; + } else { + $formula .= '\ensuremath{\leftarrow} '; + } next; } if ($token eq '<=>') { @@ -996,16 +1064,47 @@ sub format_significant_figures { my ($zeros) = ($xint =~ /(0+)$/); # return number to original magnitude my $numSig = $xint*10**($x10-$sig+$power); - # insert trailing zero's if have decimal point - $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/; - # put a decimal pt for number ending with 0 and length = # of sig fig - $numSig.='.' if (length($numSig) == $sig && $numSig =~ /0$/); - if (length($numSig) < $sig) { - $numSig.='.'.substr($zeros,0,($sig-length($numSig))); + if ($numSig =~ /^(\d+)\.(\d+)/) { + # insert trailing zero's if have decimal point + my @digarray = split('',$1.$2); + my $sigcount; + while (@digarray > 0) { + my $item = shift(@digarray); + if ($item) { + $sigcount = 1 + @digarray; + last; + } + } + if (($sigcount) && ($sig >= $sigcount)) { + $zeros = substr($zeros,0,($sig - $sigcount)); + } + $numSig =~ s/^(\d+)\.(\d+)(\e?(.*)?)$/$1\.$2$zeros$3/; + } else { + if ($numSig =~ /^(\d+)e([\+\-]\d+)$/i) { + my $pre_exp = $1; + my $exponent = $2; + $numSig = $pre_exp.'.'.$zeros.'E'.$exponent; + } elsif ($numSig =~ /0$/) { + # add decimal pt for number ending with 0 and length == # of sig figs + if (length($numSig) == $sig) { + $numSig.='.'; + } elsif (length($numSig) > $sig) { + # exponential form for number ending with 0 and length > # of sig figs + my $fmtsig = $sig-1; + if ($fmtsig) { + $numSig = sprintf('%.'.$fmtsig.'E',$numSig); + } + } elsif (length($numSig) < $sig) { + $numSig.='.'.substr($zeros,0,($sig-length($numSig))); + } + } else { + if (length($numSig) < $sig) { + $numSig.='.'.substr($zeros,0,($sig-length($numSig))); + } + } } # return number with sign return $sign.$numSig; - } sub map { @@ -1119,12 +1218,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'); $lastname = '' if $lastname eq ""; @@ -1138,10 +1249,78 @@ sub sec { } sub submission { - my ($partid,$responseid,$subnumber)=@_; + my ($partid,$responseid,$subnumber,$encode,$cleanupnum,$mapalias)=@_; my $sub=''; if ($subnumber) { $sub=$subnumber.':'; } - return &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission'); + my $output = + &EXT('user.resource.'.$sub.'resource.'.$partid.'.'.$responseid.'.submission',$mapalias); + if (ref($output) eq 'ARRAY') { + my @items = @{$output}; + if ($encode) { + @items = map { &encode_response($_); } @items; + } + if (ref($cleanupnum) eq 'HASH') { + @items = map { &cleanup_numerical_response($cleanupnum,$_); } @items; + } + return \@items; + } else { + if ($encode) { + $output = &encode_response($output); + } + if (ref($cleanupnum) eq 'HASH') { + $output = &cleanup_numerical_response($cleanupnum,$output); + } + return $output; + } +} + +sub encode_response { + my ($value) = @_; + $value =~ s/&/&/g; + $value =~ s//>/g; + $value =~ s/"/"/g; + return $value; +} + +sub cleanup_numerical_response { + my ($cleanupnum,$value) = @_; + if (ref($cleanupnum) eq 'HASH') { + if ($cleanupnum->{exponent}) { + if ($value =~ m{^(.*)[\*xX]\s*10\s*\^\s*(\+|\-)?\s*(\d+)(.*)$}) { + my $pre_exp = $1; + my $sign = $2; + my $exponent = $3; + my $post_exp = $4; + if ($pre_exp !~ /\./) { + $pre_exp .= '.'; + } + if ($sign eq '') { + $sign = '+'; + } + $value = $pre_exp.'E'.$sign.$exponent.$post_exp; + } + } + if ($cleanupnum->{comma}) { + $value =~ s{(\d+),(\d+)}{$1$2}; + } + if ($cleanupnum->{letterforzero}) { + $value =~ s/^\s*o(\.\d+)/0$1/i; + } + if ($cleanupnum->{spaces}) { + $value =~ s{^\s+|\s+$}{}g; + if ($value =~ m{^(.*)\.\s+(\d+)(.*)$}) { + my $pre_pt = $1; + my $decimal = $2; + my $post_dec = $3; + $value = $pre_pt.'.'.$decimal.$post_dec; + } + } + if ($cleanupnum->{format} =~ /^\d+s$/i) { + $value = &format_significant_figures($value,$cleanupnum->{format}); + } + } + return $value; } sub currentpart { @@ -1190,6 +1369,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); @@ -1266,3 +1479,8 @@ sub proper_path { } } +sub input_id { + my ($part_id, $response_id, $textline_id) = @_; + return 'HWVAL_'.$part_id.'_'.$response_id.'_'.$textline_id; +} +