--- loncom/homework/response.pm 2006/12/15 22:11:43 1.156 +++ loncom/homework/response.pm 2008/03/06 16:28:20 1.188 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # various response type definitons response definition # -# $Id: response.pm,v 1.156 2006/12/15 22:11:43 www Exp $ +# $Id: response.pm,v 1.188 2008/03/06 16:28:20 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -265,11 +265,14 @@ sub meta_response_order { } sub check_for_previous { - my ($curresponse,$partid,$id) = @_; + my ($curresponse,$partid,$id,$last) = @_; my %previous; $previous{'used'} = 0; foreach my $key (sort(keys(%Apache::lonhomework::history))) { if ($key =~ /resource\.$partid\.$id\.submission$/) { + if ( $last && $key =~ /^(\d+):/ ) { + next if ($1 >= $last); + } &Apache::lonxml::debug("Trying $key"); my $pastresponse=$Apache::lonhomework::history{$key}; if ($pastresponse eq $curresponse) { @@ -368,7 +371,8 @@ sub start_customresponse { my $id = &Apache::response::start_response($parstack,$safeeval); push(@Apache::lonxml::namespace,'customresponse'); my $result; - undef($Apache::response::custom_answer); + @Apache::response::custom_answer=(); + @Apache::response::custom_answer_type=(); &Apache::lonxml::register('Apache::response',('answer')); if ($target eq 'web') { if ( &Apache::response::show_answer() ) { @@ -387,7 +391,6 @@ sub start_customresponse { $safeeval,'answerdisplay'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } elsif ($target eq 'answer' || $target eq 'grade') { &Apache::response::reset_params(); @@ -408,7 +411,7 @@ sub end_customresponse { &Apache::response::submitted('scantron')) { &Apache::response::scored_response($part,$id); } elsif ( $response =~ /[^\s]/ && - $Apache::response::custom_answer_type eq 'loncapa/perl') { + $Apache::response::custom_answer_type[-1] eq 'loncapa/perl') { if (!$Apache::lonxml::default_homework_loaded) { &Apache::lonxml::default_homework_load($safeeval); } @@ -420,7 +423,7 @@ sub end_customresponse { ${$safeeval->varglob('LONCAPA::customresponse_submission')}= $response; - my $award = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer.'}',$safeeval); + my $award = &Apache::run::run('{ my $submission=$LONCAPA::customresponse_submission;'.$Apache::response::custom_answer[-1].'}',$safeeval); if (!&Apache::inputtags::valid_award($award)) { $error = $award; $award = 'ERROR'; @@ -443,23 +446,39 @@ sub end_customresponse { $result .= &Apache::response::answer_part('customresponse',$answer); $result .= &Apache::response::answer_footer('customresponse'); } + if ($target eq 'web') { + &setup_prior_tries_hash(\&format_prior_response_math); + } if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || $target eq 'tex' || $target eq 'analyze') { - &Apache::lonxml::increment_counter(&Apache::response::repetition()); + &Apache::lonxml::increment_counter(&Apache::response::repetition(), + "$part.$id"); + if ($target eq 'analyze') { + $Apache::lonhomework::analyze{"$part.$id.type"} = 'customresponse'; + &Apache::lonhomework::set_bubble_lines(); + } } pop(@Apache::lonxml::namespace); + pop(@Apache::response::custom_answer); + pop(@Apache::response::custom_answer_type); &Apache::lonxml::deregister('Apache::response',('answer')); &Apache::response::end_response(); return $result; } +sub format_prior_response_custom { + my ($mode,$answer) =@_; + return ''. + &HTML::Entities::encode($answer,'"<>&').''; +} sub start_mathresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $id = &Apache::response::start_response($parstack,$safeeval); push(@Apache::lonxml::namespace,'mathresponse'); my $result; - undef($Apache::response::custom_answer); + @Apache::response::custom_answer=(); + @Apache::response::custom_answer_type=(); &Apache::lonxml::register('Apache::response',('answer')); if ($target eq 'web') { if ( &Apache::response::show_answer() ) { @@ -484,7 +503,6 @@ sub start_mathresponse { $safeeval,'answerdisplay','cas','args'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } elsif ($target eq 'answer' || $target eq 'grade') { &Apache::response::reset_params(); @@ -514,7 +532,7 @@ sub end_mathresponse { my $cas = &Apache::lonxml::get_param('cas',$parstack,$safeeval); if ($cas eq 'maxima') { my $args = [&Apache::lonxml::get_param_var('args',$parstack,$safeeval)]; - $award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer,$response,$args); + $award=&Apache::lonmaxima::maxima_run($Apache::response::custom_answer[-1],$response,$args); } if (!&Apache::inputtags::valid_award($award)) { $error = $award; @@ -529,12 +547,24 @@ sub end_mathresponse { } } } + if ($target eq 'web') { + &setup_prior_tries_hash(\&format_prior_response_math); + } + pop(@Apache::lonxml::namespace); + pop(@Apache::response::custom_answer); + pop(@Apache::response::custom_answer_type); &Apache::lonxml::deregister('Apache::response',('answer')); &Apache::response::end_response(); return $result; } +sub format_prior_response_math { + my ($mode,$answer) =@_; + return ''. + &HTML::Entities::encode($answer,'"<>&').''; +} + sub implicit_multiplication { my ($expression)=@_; # Escape scientific notation, so 3e8 does not become 3*e*8 @@ -544,15 +574,15 @@ sub implicit_multiplication { $expression=~s/(\d+)(?:x|\*)10(?:\^|\*\*)([\+\-]*\d+)/$1\&\($2\)/gsi; # Fill in multiplication signs # a b -> a*b;3 b -> 3*b;3 4 -> 3*4 - $expression=~s/(\w)\s+(\w)/$1\*$2/gs; + $expression=~s/([A-Za-z0-9])\s+(?=[A-Za-z0-9])/$1\*/gs; # )( -> )*(; ) ( -> )*( $expression=~s/\)\s*\(/\)\*\(/gs; # 3a -> 3*a; 3( -> 3*(; 3 ( -> 3*(; 3A -> 3*A $expression=~s/(\d)\s*([a-zA-Z\(])/$1\*$2/gs; # a ( -> a*( - $expression=~s/(\w)\s+\(/$1\*\(/gs; + $expression=~s/([A-Za-z0-9])\s+\(/$1\*\(/gs; # )a -> )*a; )3 -> )*3; ) 3 -> )*3 - $expression=~s/\)\s*(\w)/\)\*$1/gs; + $expression=~s/\)\s*([A-Za-z0-9])/\)\*$1/gs; # 3&8 -> 3e8; 3&-4 -> 3e-4 $expression=~s/(\d+)\&\(([\+\-]*\d+)\)/$1e$2/gs; return $expression; @@ -561,15 +591,15 @@ sub implicit_multiplication { sub start_answer { my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; my $result; - $Apache::response::custom_answer= - &Apache::lonxml::get_all_text_unbalanced("/answer",$parser); - $Apache::response::custom_answer_type= - lc(&Apache::lonxml::get_param('type',$parstack,$safeeval)); - $Apache::response::custom_answer_type =~ s/\s+//g; + push(@Apache::response::custom_answer, + &Apache::lonxml::get_all_text_unbalanced("/answer",$parser)); + push(@Apache::response::custom_answer_type, + lc(&Apache::lonxml::get_param('type',$parstack,$safeeval))); + $Apache::response::custom_answer_type[-1] =~ s/\s+//g; if ($target eq "edit" ) { $result=&Apache::edit::tag_start($target,$token,'Answer algorithm'); $result.=&Apache::edit::editfield($token->[1], - $Apache::response::custom_answer, + $Apache::response::custom_answer[-1], '',80,4); } elsif ( $target eq "modified" ) { $result=$token->[4].&Apache::edit::modifiedfield('/answer',$parser); @@ -646,11 +676,11 @@ sub start_responseparam { $Apache::lonnet::packagetab{"$tag&$name&display"}; $token->[2]->{'default'}= $Apache::lonnet::packagetab{"$tag&$name&default"}; + $token->[3] = ['name','type','description','default']; $constructtag=1; } if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } elsif ($target eq 'grade' || $target eq 'answer' || $target eq 'web' || $target eq 'tex' || $target eq 'analyze' ) { @@ -688,7 +718,7 @@ sub setup_params { if ($env{'request.state'} eq 'construct') { return; } my %paramlist=(); foreach my $key (keys(%Apache::lonnet::packagetab)) { - if ($key =~ /^$tag/) { + if ($key =~ /^\Q$tag\E/) { my ($package,$name) = split(/&/,$key); $paramlist{$name}=1; } @@ -760,6 +790,8 @@ sub next_answer { sub answer_part { my ($type,$answer,$args) = @_; + &Apache::lonxml::debug("In answerpart :$type:$answer:$args:"); + my $result; if ($env{'form.answer_output_mode'} eq 'tex') { if (!$args->{'no_verbatim'}) { @@ -771,9 +803,13 @@ sub answer_part { last; } } - if ($answer ne '') { - $answer = '\verb'.$to_use.$answer.$to_use; - } + my $answerelements=$answer; + $answer=''; + foreach my $element (split(/[\;\:]/,$answerelements)) { + if ($element ne '') { + $answer.= '\noindent\verb'.$to_use.$element.$to_use.'\newline'; + } + } } if ($answer ne '') { push(@answer_bits,$answer); @@ -783,7 +819,8 @@ sub answer_part { $result .= ''; $need_row_start = 0; } - $result .= ''.$answer.''; + $answer=~s/\; /\<\/nobr\>\
\/gs; + $result .= ''.$answer.''; } return $result; } @@ -792,12 +829,15 @@ sub answer_footer { my ($type) = @_; my $result; if ($env{'form.answer_output_mode'} eq 'tex') { - my $columns = scalar(@answer_bits); - $result = ' \vskip 0 mm \noindent \begin{tabular}{|'.'c|'x$columns.'}\hline '; + my $columns = scalar(@answer_bits)-1; + $result = ' \vskip 0 mm \noindent \begin{tabular}{|p{1.5cm}|'.'p{3cm}|'x$columns.'}\hline '; $result .= join(' & ',@answer_bits); $result .= ' \\\\ \\hline \end{tabular} \vskip 0 mm '; } else { - $result = ''; + if (!$need_row_start) { + $result .= ''; + } + $result .= ''; } return $result; } @@ -817,14 +857,44 @@ sub showallfoils { return 0; } +=pod + +=item &getresponse($offset,$resulttype); + +Retreives the current submitted response, helps out in the case of +scantron mode. + +Returns either the exact text of the submission, or a bubbled response +converted to something usable. + +Optional Arguments: + $offset - (defaults to 1) if a problem has more than one bubble + response, pass in the number of the bubble wanted, (the + first bubble associated with a problem has an offset of 1, + the second bubble is 2 + + $resulttype - undef -> a number between 0 and 25 + 'A is 1' -> a number between 1 and 26 + 'letter' -> a letter between 'A' and 'Z' + $lines - undef problem only needs a single line of bubbles. + nonzero Problem wants the first nonempty response in + $lines lines of bubbles. + $bubbles_per_line - Must be provided if lines is defined.. number of + bubbles on a line. + +=cut + sub getresponse { - my ($temp,$resulttype)=@_; + my ($offset,$resulttype, $lines, $bubbles_per_line)=@_; my $formparm='form.HWVAL_'.$Apache::inputtags::response['-1']; my $response; - if (!defined($temp)) { - $temp=1; + if (!defined($offset)) { + $offset=1; } else { - $formparm.=":$temp"; + $formparm.=":$offset"; + } + if (!defined($lines)) { + $lines = 1; } my %let_to_num=('A'=>0,'B'=>1,'C'=>2,'D'=>3,'E'=>4,'F'=>5,'G'=>6,'H'=>7, 'I'=>8,'J'=>9,'K'=>10,'L'=>11,'M'=>12,'N'=>13,'O'=>14, @@ -833,8 +903,17 @@ sub getresponse { if ($env{'form.submitted'} eq 'scantron') { my $part = $Apache::inputtags::part; my $id = $Apache::inputtags::response[-1]; - $response = $env{'scantron.'.($Apache::lonxml::counter+$temp-1). - '.answer'}; + + my $line; + for ($line = 0; $line < $lines; $line++) { + my $theline = $Apache::lonxml::counter+$offset-1+$line; + $response = $env{"scantron.$theline.answer"}; + if ((defined($response)) && ($response ne "") && ($response ne " ")) { + last; + } + + } + # save bubbled letter for later $Apache::lonhomework::results{"resource.$part.$id.scantron"}.= $response; @@ -844,13 +923,35 @@ sub getresponse { } else { $response = $let_to_num{$response}; } + if ($response ne "") { + $response += $line * $bubbles_per_line; + } + } else { + if ($response ne "") { + $response = chr(ord($response) + $line * $bubbles_per_line); + } } + } else { $response = $env{$formparm}; } + # + # If we have a nonempty answer, correct the numeric value + # of the answer for the line on which it was found. + # + return $response; } +=pod + +=item &repetition(); + +Returns the number of lines that are required to encode the weight. +(Currently expects that there are 10 bubbles per line) + +=cut + sub repetition { my $id = $Apache::inputtags::part; my $weight = &Apache::lonnet::EXT("resource.$id.weight"); @@ -860,6 +961,30 @@ sub repetition { return $repetition; } +=pod + +=item &scored_response($part_id,$response_id); + +Sets the results hash elements + + resource.$part_id.$response_id.awarded - to the floating point + number between 0 and 1 that was awarded on the bubbled input + + resource.$part_id.$response_id.awarddetail - to 'ASSIGNED_SCORE' + +Returns + + the number of bubble sheet lines that were used (and likely need to + be passed to &Apache::lonxml::increment_counter() + +Arguments + + $part_id - id of the part to grade + $response_id - id of the response to grade + + +=cut + sub scored_response { my ($part,$id)=@_; my $repetition=&repetition(); @@ -934,7 +1059,7 @@ sub show_answer { my $award = $Apache::lonhomework::history{"resource.$part.solved"}; my $status = $Apache::inputtags::status[-1]; return ( ($award =~ /^correct/ - && lc($Apache::lonhomework::problemstatus) ne 'no') + && &Apache::lonhomework::show_problem_status()) || $status eq "SHOW_ANSWER"); } @@ -995,7 +1120,17 @@ sub pick_foil_for_concept { $Apache::response::conceptgroup{'names'}; } - +#------------------------------------------------------------ +# +# Get a parameter associated with a problem. +# Parameters: +# $id - the id of the paramater, either a part id, +# or a partid and responspe id joined by _ +# $name - Name of the parameter to fetch +# $default - Default value for the paramter. +# +# +# sub get_response_param { my ($id,$name,$default)=@_; my $parameter; @@ -1020,7 +1155,13 @@ sub submitted { if ($who eq 'scantron') { return 0; } # if the Submit Answer button for this particular part was pressed my $partid=$Apache::inputtags::part; - if (defined($env{'form.submit_'.$partid})) { return 1; } + if ($env{'form.submitted'} eq "part_$partid") { + return 1; + } + if ($env{'form.submitted'} eq "yes" + && defined($env{'form.submit_'.$partid})) { + return 1; + } # Submit All button on a .page was pressed if (defined($env{'form.all_submit'})) { return 1; } # otherwise no submission occured @@ -1080,6 +1221,48 @@ sub check_status { return 2; } +=pod + +=item setup_prior_tries_hash($func,$data) + + Foreach each past .submission $func is called with 3 arguments + - the mode to set things up for (currently always 'grade') + - the stored .submission string + - The expansion of $data + + $data is an array ref containing elements that are either + - scalars that are other elements of the history hash to pass to $func + - ref to data to be passed untouched to $func + +=cut + +sub setup_prior_tries_hash { + my ($func,$data) = @_; + my $part = $Apache::inputtags::part; + my $id = $Apache::inputtags::response[-1]; + foreach my $i (1..$Apache::lonhomework::history{'version'}) { + my $sub_key = "$i:resource.$part.$id.submission"; + next if (!exists($Apache::lonhomework::history{$sub_key})); + my @other_data; + foreach my $datum (@{ $data }) { + if (ref($datum)) { + push(@other_data,$datum); + } else { + my $info_key = "$i:resource.$part.$id.$datum"; + push(@other_data,$Apache::lonhomework::history{$info_key}); + } + } + + my $output = + &$func('grade', + $Apache::lonhomework::history{$sub_key}, + \@other_data); + if (defined($output)) { + $Apache::inputtags::submission_display{$sub_key} = $output; + } + } +} + 1; __END__