loncom/homework/caparesponse/caparesponse.pm - view

File: [LON-CAPA] / loncom / homework / caparesponse / caparesponse.pm
Revision 1.241: download - view: text, annotated - select for diffs
Thu Oct 14 19:55:04 2010 UTC (13 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Bug 5531.
  - Detect where student resubmits previous answer for case sensitive
    stringreponse item and award changes to EXACT_ANS.
    Detect for case insensitive stringresponse when previous award changes
    to EXACT_ANS for submissions whch only differ by case.
    - logs to lonnet.log and sends e-mail to recipients of "errormail" for
      course domain.
  - For cs and ci types if award is INCORRECT use perl to compare
    response with answer, and log if disagreement with result from
    strcasecmp() or strcmp() to capa_check_answer() in capaCommon.

1: # The LearningOnline Network with CAPA 2: # caparesponse definition 3: # 4: # $Id: caparesponse.pm,v 1.241 2010/10/14 19:55:04 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::caparesponse; 30: use strict; 31: use capa; 32: use Safe::Hole; 33: use Apache::lonmaxima(); 34: use Apache::lonlocal; 35: use Apache::lonnet; 36: use Apache::lonmsg(); 37: use Apache::response(); 38: use Storable qw(dclone); 39: 40: BEGIN { 41: &Apache::lonxml::register('Apache::caparesponse',('numericalresponse','stringresponse','formularesponse')); 42: } 43: 44: my %answer; 45: my @answers; 46: sub get_answer { return %answer; }; 47: sub push_answer{ push(@answers,dclone(\%answer)); undef(%answer) } 48: sub pop_answer { %answer = %{pop(@answers)}; }; 49: 50: my $cur_name; 51: my $tag_internal_answer_name = 'INTERNAL'; 52: 53: sub start_answer { 54: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 55: my $result; 56: $cur_name = &Apache::lonxml::get_param('name',$parstack,$safeeval); 57: if ($cur_name =~ /^\s*$/) { $cur_name = $Apache::lonxml::curdepth; } 58: my $type = &Apache::lonxml::get_param('type',$parstack,$safeeval); 59: if (!defined($type) && $tagstack->[-2] eq 'answergroup') { 60: $type = &Apache::lonxml::get_param('type',$parstack,$safeeval,-2); 61: } 62: if (!defined($type)) { $type = 'ordered' }; 63: $answer{$cur_name}= { 'type' => $type, 64: 'answers' => [] }; 65: if ($target eq 'edit') { 66: $result.=&Apache::edit::tag_start($target,$token); 67: $result.=&Apache::edit::text_arg('Name:','name',$token); 68: $result.=&Apache::edit::select_arg('Type:','type', 69: [['ordered', 'Ordered' ], 70: ['unordered','Unordered'],], 71: $token); 72: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 73: } elsif ($target eq 'modified') { 74: my $constructtag = &Apache::edit::get_new_args($token,$parstack, 75: $safeeval,'name', 76: 'type'); 77: if ($constructtag) { 78: $result = &Apache::edit::rebuild_tag($token); 79: $result.= &Apache::edit::handle_insert(); 80: } 81: } 82: return $result; 83: } 84: 85: sub end_answer { 86: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 87: my $result; 88: if ($target eq 'edit') { 89: $result .= &Apache::edit::tag_end(); 90: } 91: 92: undef($cur_name); 93: return $result; 94: } 95: 96: sub insert_answer { 97: return ' 98: <answer> 99: <value></value> 100: </answer>'; 101: } 102: 103: sub start_answergroup { 104: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 105: my $result; 106: if ($target eq 'edit') { 107: $result.=&Apache::edit::tag_start($target,$token); 108: $result.=&Apache::edit::select_arg('Type:','type', 109: [['ordered', 'Ordered' ], 110: ['unordered','Unordered'],], 111: $token); 112: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 113: } elsif ($target eq 'modified') { 114: my $constructtag = &Apache::edit::get_new_args($token,$parstack, 115: $safeeval,'name', 116: 'type'); 117: if ($constructtag) { 118: $result = &Apache::edit::rebuild_tag($token); 119: $result.= &Apache::edit::handle_insert(); 120: } 121: } 122: return $result; 123: } 124: 125: sub end_answergroup { 126: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 127: my $result; 128: if ($target eq 'web') { 129: if ( &Apache::response::show_answer() ) { 130: my $partid = $Apache::inputtags::part; 131: my $id = $Apache::inputtags::response[-1]; 132: &set_answertext($Apache::lonhomework::history{"resource.$partid.$id.answername"}, 133: $target,$token,$tagstack,$parstack,$parser, 134: $safeeval,-2); 135: } 136: } elsif ($target eq 'edit') { 137: $result .= &Apache::edit::tag_end(); 138: } 139: return $result; 140: } 141: 142: sub insert_answergroup { 143: return ' 144: <answergroup> 145: <answer> 146: <value></value> 147: </answer> 148: </answergroup>'; 149: } 150: 151: sub start_value { 152: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 153: my $result; 154: if ( $target eq 'web' || $target eq 'tex' || 155: $target eq 'grade' || $target eq 'webgrade' || 156: $target eq 'answer' || $target eq 'analyze' ) { 157: my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style); 158: $bodytext = &Apache::run::evaluate($bodytext,$safeeval, 159: $$parstack[-1]); 160: 161: push(@{ $answer{$cur_name}{'answers'} },[$bodytext]); 162: 163: } elsif ($target eq 'edit') { 164: $result.=&Apache::edit::tag_start($target,$token); 165: my $bodytext = &Apache::lonxml::get_all_text("/value",$parser,$style); 166: $result.=&Apache::edit::editline($token->[1],$bodytext,undef,40). 167: &Apache::edit::end_row(); 168: } elsif ($target eq 'modified') { 169: $result=$token->[4].&Apache::edit::modifiedfield('/value',$parser); 170: } 171: return $result; 172: } 173: 174: sub end_value { 175: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 176: my $result; 177: if ($target eq 'edit') { 178: $result = &Apache::edit::end_table(); 179: } 180: return $result; 181: } 182: 183: sub insert_value { 184: return ' 185: <value></value>'; 186: } 187: 188: sub start_vector { 189: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 190: my $result; 191: if ( $target eq 'web' || $target eq 'tex' || 192: $target eq 'grade' || $target eq 'webgrade' || 193: $target eq 'answer' || $target eq 'analyze' ) { 194: my $bodytext = &Apache::lonxml::get_all_text("/vector",$parser,$style); 195: my @values = &Apache::run::run($bodytext,$safeeval,$$parstack[-1]); 196: if (@values == 1) { 197: @values = split(',',$values[0]); 198: } 199: push(@{ $answer{$cur_name}{'answers'} },\@values); 200: } elsif ($target eq 'edit') { 201: $result.=&Apache::edit::tag_start($target,$token); 202: my $bodytext = &Apache::lonxml::get_all_text("/vector",$parser,$style); 203: $result.=&Apache::edit::editline($token->[1],$bodytext,undef,40). 204: &Apache::edit::end_row(); 205: } elsif ($target eq 'modified') { 206: $result=$token->[4].&Apache::edit::modifiedfield('/vector',$parser); 207: } 208: return $result; 209: } 210: 211: sub end_vector { 212: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 213: my $result; 214: if ($target eq 'edit') { 215: $result = &Apache::edit::end_table(); 216: } 217: return $result; 218: } 219: 220: sub insert_vector { 221: return ' 222: <value></value>'; 223: } 224: 225: sub start_array { 226: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 227: my $result; 228: if ( $target eq 'web' || $target eq 'tex' || 229: $target eq 'grade' || $target eq 'webgrade' || 230: $target eq 'answer' || $target eq 'analyze' ) { 231: my $bodytext = &Apache::lonxml::get_all_text("/array",$parser,$style); 232: my @values = &Apache::run::evaluate($bodytext,$safeeval, 233: $$parstack[-1]); 234: push(@{ $answer{$cur_name}{'answers'} },@values); 235: } 236: return $result; 237: } 238: 239: sub end_array { 240: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 241: my $result; 242: return $result; 243: } 244: 245: sub start_unit { 246: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 247: my $result; 248: return $result; 249: } 250: 251: sub end_unit { 252: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 253: my $result; 254: return $result; 255: } 256: 257: sub start_numericalresponse { 258: my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_; 259: &Apache::lonxml::register('Apache::caparesponse', 260: ('answer','answergroup','value','array','unit', 261: 'vector')); 262: push(@Apache::lonxml::namespace,'caparesponse'); 263: my $id = &Apache::response::start_response($parstack,$safeeval); 264: my $result; 265: undef(%answer); 266: undef(%{$safeeval->varglob('LONCAPA::CAPAresponse_args')}); 267: if ($target eq 'edit') { 268: $result.=&Apache::edit::tag_start($target,$token); 269: $result.=&Apache::edit::text_arg('Answer:','answer',$token); 270: if ($token->[1] eq 'numericalresponse') { 271: $result.=&Apache::edit::text_arg('Incorrect Answers:','incorrect', 272: $token). 273: &Apache::loncommon::help_open_topic('numerical_wrong_answers'); 274: $result.=&Apache::edit::text_arg('Unit:','unit',$token,5). 275: &Apache::loncommon::help_open_topic('Physical_Units'); 276: $result.=&Apache::edit::text_arg('Format:','format',$token,4). 277: &Apache::loncommon::help_open_topic('Numerical_Response_Format'); 278: } elsif ($token->[1] eq 'formularesponse') { 279: $result.=&Apache::edit::text_arg('Sample Points:','samples', 280: $token,40). 281: &Apache::loncommon::help_open_topic('Formula_Response_Sampling'); 282: } 283: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 284: } elsif ($target eq 'modified') { 285: my $constructtag; 286: if ($token->[1] eq 'numericalresponse') { 287: $constructtag=&Apache::edit::get_new_args($token,$parstack, 288: $safeeval,'answer', 289: 'incorrect','unit', 290: 'format'); 291: } elsif ($token->[1] eq 'formularesponse') { 292: $constructtag=&Apache::edit::get_new_args($token,$parstack, 293: $safeeval,'answer', 294: 'samples'); 295: } 296: if ($constructtag) { 297: $result = &Apache::edit::rebuild_tag($token); 298: $result.=&Apache::edit::handle_insert(); 299: } 300: } elsif ($target eq 'meta') { 301: $result=&Apache::response::meta_package_write('numericalresponse'); 302: } elsif ($target eq 'answer' || $target eq 'grade') { 303: &Apache::response::reset_params(); 304: } elsif ($target eq 'web') { 305: my $partid = $Apache::inputtags::part; 306: my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit'); 307: &Apache::lonxml::debug("Got unit $hideunit for $partid $id"); 308: #no way to enter units, with radio buttons 309: if ((lc($hideunit) eq "yes") && ($Apache::lonhomework::type ne 'exam')) { 310: my $unit=&Apache::lonxml::get_param_var('unit',$parstack, 311: $safeeval); 312: if ($unit =~ /\S/) { $result.=" (in $unit) "; } 313: } 314: if ( &Apache::response::show_answer() ) { 315: &set_answertext($tag_internal_answer_name,$target,$token,$tagstack, 316: $parstack,$parser,$safeeval,-1); 317: } 318: } 319: return $result; 320: } 321: 322: sub set_answertext { 323: my ($name,$target,$token,$tagstack,$parstack,$parser,$safeeval, 324: $response_level) = @_; 325: &add_in_tag_answer($parstack,$safeeval,$response_level); 326: 327: if ($name eq '' || !ref($answer{$name})) { 328: if (ref($answer{$tag_internal_answer_name})) { 329: $name = $tag_internal_answer_name; 330: } else { 331: $name = (sort(keys(%answer)))[0]; 332: } 333: } 334: return if ($name eq '' || !ref($answer{$name})); 335: 336: my (@formats)=&Apache::lonxml::get_param_var('format',$parstack, 337: $safeeval,$response_level); 338: my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval, 339: $response_level); 340: 341: &Apache::lonxml::debug("answer looks to be $name"); 342: my @answertxt; 343: for (my $i=0; $i < scalar(@{$answer{$name}{'answers'}}); $i++) { 344: my $answertxt; 345: my $answer=$answer{$name}{'answers'}[$i]; 346: foreach my $element (@$answer) { 347: if ( scalar(@$tagstack) 348: && $tagstack->[$response_level] ne 'numericalresponse') { 349: $answertxt.=$element.','; 350: } else { 351: my $format; 352: if ($#formats > 0) { 353: $format=$formats[$i]; 354: } else { 355: $format=$formats[0]; 356: } 357: if ($unit=~/\$/) { $format="\$".$format; $unit=~s/\$//g; } 358: if ($unit=~/\,/) { $format="\,".$format; $unit=~s/\,//g; } 359: my $formatted=&format_number($element,$format,$target, 360: $safeeval); 361: $answertxt.=' '.$formatted.','; 362: } 363: 364: } 365: chop($answertxt); 366: if ($target eq 'web') { 367: $answertxt.=" $unit "; 368: } 369: 370: push(@answertxt,$answertxt) 371: } 372: 373: my $id = $Apache::inputtags::response[-1]; 374: $Apache::inputtags::answertxt{$id}=\@answertxt; 375: } 376: 377: sub setup_capa_args { 378: my ($safeeval,$parstack,$args,$response) = @_; 379: my $args_ref= \%{$safeeval->varglob('LONCAPA::CAPAresponse_args')}; 380: undef(%{ $args_ref }); 381: 382: foreach my $arg (@{$args}) { 383: $$args_ref{$arg}= 384: &Apache::lonxml::get_param($arg,$parstack,$safeeval); 385: } 386: foreach my $key (keys(%Apache::inputtags::params)) { 387: $$args_ref{$key}=$Apache::inputtags::params{$key}; 388: } 389: &setup_capa_response($args_ref,$response); 390: return $args_ref; 391: } 392: 393: sub setup_capa_response { 394: my ($args_ref,$response) = @_; 395: 396: if (ref($response)) { 397: $$args_ref{'response'}=dclone($response); 398: } else { 399: $$args_ref{'response'}=dclone([$response]); 400: } 401: } 402: 403: sub check_submission { 404: my ($response,$partid,$id,$tag,$parstack,$safeeval,$ignore_sig)=@_; 405: my @args = ('type','tol','sig','format','unit','calc','samples'); 406: my $args_ref = &setup_capa_args($safeeval,$parstack,\@args,$response); 407: 408: my $hideunit= 409: &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffunit'); 410: #no way to enter units, with radio buttons 411: if ($Apache::lonhomework::type eq 'exam' || 412: lc($hideunit) eq "yes") { 413: delete($$args_ref{'unit'}); 414: } 415: #sig fig don't make much sense either 416: if (($Apache::lonhomework::type eq 'exam' || 417: &Apache::response::submitted('scantron') || 418: $ignore_sig) && 419: $tag eq 'numericalresponse') { 420: delete($$args_ref{'sig'}); 421: } 422: 423: if ($tag eq 'formularesponse') { 424: if ($$args_ref{'samples'}) { 425: $$args_ref{'type'}='fml'; 426: } else { 427: $$args_ref{'type'}='math'; 428: } 429: } elsif ($tag eq 'numericalresponse') { 430: $$args_ref{'type'}='float'; 431: } elsif ($tag eq 'stringresponse') { 432: if ($$args_ref{'type'} eq '') { 433: $$args_ref{'type'} = 'ci'; 434: } 435: } 436: 437: &add_in_tag_answer($parstack,$safeeval); 438: 439: if (!%answer) { 440: &Apache::lonxml::error("No answers are defined"); 441: } 442: 443: my (@final_awards,@final_msgs,@names); 444: foreach my $name (keys(%answer)) { 445: &Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} })); 446: 447: ${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name}); 448: &setup_capa_response($args_ref,$response); 449: use Time::HiRes; 450: my $t0 = [Time::HiRes::gettimeofday()]; 451: my ($result,@msgs) = 452: &Apache::run::run("&caparesponse_check_list()",$safeeval); 453: &Apache::lonxml::debug("checking $name $result with $response took ".&Time::HiRes::tv_interval($t0)); 454: &Apache::lonxml::debug('msgs are '.join(':',@msgs)); 455: my ($awards)=split(/:/,$result); 456: my @awards= split(/,/,$awards); 457: my ($ad, $msg) = &Apache::inputtags::finalizeawards(\@awards,\@msgs); 458: push(@final_awards,$ad); 459: push(@final_msgs,$msg); 460: push(@names,$name); 461: } 462: my ($ad, $msg, $name) = &Apache::inputtags::finalizeawards(\@final_awards, 463: \@final_msgs, 464: \@names,1); 465: &Apache::lonxml::debug(" name of picked award is $name from ".join(', ',@names)); 466: return($ad,$msg, $name); 467: } 468: 469: sub stringresponse_gradechange { 470: my ($part,$id,$previous,$caller,$response,$ad,$type) = @_; 471: return unless (ref($previous) eq 'HASH'); 472: my ($prevarray,$prevaward); 473: my %typenames = ( 474: cs => 'Case sensitive', 475: ci => 'Case insensitive', 476: ); 477: if ($caller eq 'cs') { 478: return unless (ref($previous->{'version'}) eq 'ARRAY'); 479: $prevarray = $previous->{'version'}; 480: $prevaward = $previous->{'award'}; 481: } elsif ($caller eq 'ci') { 482: return unless (ref($previous->{'versionci'}) eq 'ARRAY'); 483: $prevarray = $previous->{'versionci'}; 484: $prevaward = $previous->{'awardci'}; 485: } else { 486: return; 487: } 488: my $count=0; 489: my %count_lookup; 490: foreach my $i (1..$Apache::lonhomework::history{'version'}) { 491: my $prefix = $i.":resource.$part"; 492: next if (!exists($Apache::lonhomework::history{"$prefix.award"})); 493: $count++; 494: $count_lookup{$i} = $count; 495: } 496: my ($symb,$courseid,$domain,$name) = &Apache::lonnet::whichuser(); 497: my %coursedesc = &Apache::lonnet::coursedescription($courseid); 498: my $cdom = $coursedesc{'domain'}; 499: my $versions = ' (submissions: '.join(', ',map {$count_lookup{$_} } @{$prevarray}).')'; 500: my $warning = "String Response ($typenames{$type}) grading discrepancy: award for response of $response changed from $prevaward".$versions." to $ad; user: $name:$domain in course: $courseid for part: $part response: $id for symb: $symb"; 501: &Apache::lonnet::logthis($warning); 502: my $origmail = $Apache::lonnet::perlvar{'lonAdmEMail'}; 503: my $recipients = &Apache::loncommon::build_recipient_list(undef,'errormail', 504: $cdom,$origmail); 505: if ($recipients ne '') { 506: &Apache::lonmsg::sendemail($recipients,'Stringresponse Grading Discrepancy',$warning); 507: } 508: return; 509: } 510: 511: sub add_in_tag_answer { 512: my ($parstack,$safeeval,$response_level) = @_; 513: my @answer=&Apache::lonxml::get_param_var('answer',$parstack,$safeeval, 514: $response_level); 515: &Apache::lonxml::debug('answer is'.join(':',@answer)); 516: if (@answer && $answer[0] =~ /\S/) { 517: $answer{$tag_internal_answer_name}= {'type' => 'ordered', 518: 'answers' => [\@answer] }; 519: } 520: } 521: 522: sub capa_formula_fix { 523: my ($expression)=@_; 524: return &Apache::response::implicit_multiplication($expression); 525: } 526: 527: sub end_numericalresponse { 528: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 529: 530: &Apache::lonxml::deregister('Apache::caparesponse', 531: ('answer','answergroup','value','array','unit', 532: 'vector')); 533: pop(@Apache::lonxml::namespace); 534: 535: my $increment=1; 536: my $result = ''; 537: if (!$Apache::lonxml::default_homework_loaded) { 538: &Apache::lonxml::default_homework_load($safeeval); 539: } 540: my $partid = $Apache::inputtags::part; 541: my $id = $Apache::inputtags::response[-1]; 542: my $tag; 543: my $safehole = new Safe::Hole; 544: $safeeval->share_from('capa',['&caparesponse_capa_check_answer']); 545: 546: if (scalar(@$tagstack)) { $tag=$$tagstack[-1]; } 547: if ( $target eq 'grade' && &Apache::response::submitted() ) { 548: &Apache::response::setup_params($tag,$safeeval); 549: if ($Apache::lonhomework::type eq 'exam' && 550: (($tag eq 'formularesponse') || ($tag eq 'mathresponse'))) { 551: $increment=&Apache::response::scored_response($partid,$id); 552: } else { 553: my $response = &Apache::response::getresponse(); 554: if ( $response =~ /[^\s]/) { 555: my %previous = &Apache::response::check_for_previous($response,$partid,$id); 556: &Apache::lonxml::debug("submitted a $response<br>\n"); 557: &Apache::lonxml::debug($$parstack[-1] . "\n<br>"); 558: 559: if ( &Apache::response::submitted('scantron')) { 560: &add_in_tag_answer($parstack,$safeeval); 561: my ($values,$display)=&make_numerical_bubbles($partid,$id, 562: $target,$parstack,$safeeval); 563: $response=$values->[$response]; 564: } 565: $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response; 566: my ($ad,$msg,$name)=&check_submission($response,$partid,$id, 567: $tag,$parstack, 568: $safeeval); 569: 570: &Apache::lonxml::debug('ad is'.$ad); 571: if ($ad eq 'SIG_FAIL') { 572: my ($sig_u,$sig_l)= 573: &get_sigrange($Apache::inputtags::params{'sig'}); 574: $msg=join(':',$msg,$sig_l,$sig_u); 575: &Apache::lonxml::debug("sigs bad $sig_u $sig_l ". 576: $Apache::inputtags::params{'sig'}); 577: } 578: &Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n"); 579: if (($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' || 580: $ad eq 'EXACT_ANS')) { 581: if ($Apache::lonhomework::type eq 'survey') { 582: $ad='SUBMITTED'; 583: } elsif ($Apache::lonhomework::type eq 'surveycred') { 584: $ad='SUBMITTED_CREDIT'; 585: } elsif ($Apache::lonhomework::type eq 'anonsurvey') { 586: $ad='ANONYMOUS'; 587: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 588: $ad='ANONYMOUS_CREDIT'; 589: } 590: } 591: &Apache::response::handle_previous(\%previous,$ad); 592: $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad; 593: $Apache::lonhomework::results{"resource.$partid.$id.awardmsg"}=$msg; 594: $Apache::lonhomework::results{"resource.$partid.$id.answername"}=$name; 595: $result=''; 596: } 597: } 598: } elsif ($target eq 'web' || $target eq 'tex') { 599: &check_for_answer_errors($parstack,$safeeval); 600: my $award = $Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"}; 601: my $status = $Apache::inputtags::status['-1']; 602: if ($Apache::lonhomework::type eq 'exam') { 603: # FIXME support multi dimensional numerical problems 604: # in exam bubbles 605: my ($bubble_values,$bubble_display)= 606: &make_numerical_bubbles($partid,$id,$target,$parstack, 607: $safeeval); 608: my $number_of_bubbles = scalar(@{ $bubble_values }); 609: my $unit=&Apache::lonxml::get_param_var('unit',$parstack, 610: $safeeval); 611: my @alphabet=('A'..'Z'); 612: if ($target eq 'web') { 613: if ($tag eq 'numericalresponse') { 614: if ($unit=~/\S/) {$result.=' (in '.$unit.')<br /><br />';} 615: $result.= '<table border="1"><tr>'; 616: my $previous=$Apache::lonhomework::history{"resource.$Apache::inputtags::part.$id.submission"}; 617: for (my $ind=0;$ind<$number_of_bubbles;$ind++) { 618: my $checked=''; 619: if ($previous eq $bubble_values->[$ind]) { 620: $checked=" checked='on' "; 621: } 622: $result.='<td><input type="radio" name="HWVAL_'.$id. 623: '" value="'.$bubble_values->[$ind].'" '.$checked 624: .' /><b>'.$alphabet[$ind].'</b>: '. 625: $bubble_display->[$ind].'</td>'; 626: } 627: $result.='</tr></table>'; 628: } 629: } elsif ($target eq 'tex') { 630: if ((defined $unit) and ($unit=~/\S/) and ($Apache::lonhomework::type eq 'exam')) { 631: $result.=' \textit{(in} \verb|'.$unit.'|\textit{)} '; 632: } 633: if ($tag eq 'numericalresponse') { 634: my ($celllength,$number_of_tables,@table_range)= 635: &get_table_sizes($number_of_bubbles,$bubble_display); 636: my $j=0; 637: my $cou=0; 638: $result.='\vskip 2mm \noindent '; 639: $result .= '\textbf{'.$Apache::lonxml::counter.'.} \vskip -3mm '; 640: 641: for (my $i=0;$i<$number_of_tables;$i++) { 642: if ($i == 0) { 643: $result .= '\vskip -1mm '; 644: } else { 645: $result .= '\vskip 1mm '; 646: } 647: $result.='\noindent \setlength{\tabcolsep}{2 mm}\hskip 2pc\begin{tabular}{'; 648: for (my $ind=0;$ind<$table_range[$j];$ind++) { 649: $result.='p{3 mm}p{'.$celllength.' mm}'; 650: } 651: $result.='}'; 652: for (my $ind=$cou;$ind<$cou+$table_range[$j];$ind++) { 653: $result.='\hskip -4 mm {\small \textbf{'.$alphabet[$ind].'}}$\bigcirc$ & \hskip -3 mm {\small '.$bubble_display->[$ind].'} '; 654: if ($ind != $cou+$table_range[$j]-1) {$result.=' & ';} 655: } 656: $cou += $table_range[$j]; 657: $j++; 658: $result.='\\\\\end{tabular}\vskip 0 mm '; 659: } 660: } else { 661: $increment = &Apache::response::repetition(); 662: } 663: } 664: } 665: if (($target eq 'web') && ($tag eq 'formularesponse') 666: && ($Apache::lonhomework::type ne 'exam') && ($Apache::inputtags::status['-1'] eq 'CAN_ANSWER') 667: && (&Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.turnoffeditor') ne 'yes')) { 668: $result.=&Apache::response::edit_mathresponse_button($id,"HWVAL_$id"); 669: } 670: 671: &Apache::response::setup_prior_tries_hash(\&format_prior_response_numerical); 672: } elsif ($target eq 'edit') { 673: $result.='</td></tr>'.&Apache::edit::end_table; 674: } elsif ($target eq 'answer' || $target eq 'analyze') { 675: my $part_id="$partid.$id"; 676: if ($target eq 'analyze') { 677: push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id); 678: $Apache::lonhomework::analyze{"$part_id.type"} = $tag; 679: my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack,$safeeval); 680: if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); } 681: push (@{ $Apache::lonhomework::analyze{"$part_id.incorrect"} }, @incorrect); 682: &Apache::response::check_if_computed($token,$parstack, 683: $safeeval,'answer'); 684: } 685: if (scalar(@$tagstack)) { 686: &Apache::response::setup_params($tag,$safeeval); 687: } 688: &add_in_tag_answer($parstack,$safeeval); 689: my (@formats)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval); 690: 691: my $unit=&Apache::lonxml::get_param_var('unit',$parstack,$safeeval); 692: 693: if ($target eq 'answer') { 694: $result.=&Apache::response::answer_header($tag,undef, 695: scalar(keys(%answer))); 696: if ($tag eq 'numericalresponse' 697: && $Apache::lonhomework::type eq 'exam') { 698: my ($bubble_values,undef,$correct) = &make_numerical_bubbles($partid, 699: $id,$target,$parstack,$safeeval); 700: $result.=&Apache::response::answer_part($tag,$correct); 701: } 702: } 703: foreach my $name (sort(keys(%answer))) { 704: my @answers = @{ $answer{$name}{'answers'} }; 705: if ($target eq 'analyze') { 706: foreach my $info ('answer','ans_high','ans_low','format') { 707: $Apache::lonhomework::analyze{"$part_id.$info"}{$name}=[]; 708: } 709: } 710: my ($sigline,$tolline); 711: if ($name ne $tag_internal_answer_name 712: || scalar(keys(%answer)) > 1) { 713: $result.=&Apache::response::answer_part($tag,$name); 714: } 715: for(my $i=0;$i<=$#answers;$i++) { 716: my $ans=$answers[$i]; 717: my $fmt=$formats[0]; 718: if (@formats && $#formats) {$fmt=$formats[$i];} 719: my ($sighigh,$siglow); 720: if ($Apache::inputtags::params{'sig'}) { 721: ($sighigh,$siglow)=&get_sigrange($Apache::inputtags::params{'sig'}); 722: } 723: my @vector; 724: if (ref($ans)) { 725: @vector = @{ $ans }; 726: } else { 727: @vector = ($ans); 728: } 729: my @all_answer_info; 730: foreach my $element (@vector) { 731: my ($high,$low); 732: if ($Apache::inputtags::params{'tol'}) { 733: ($high,$low)=&get_tolrange($element,$Apache::inputtags::params{'tol'}); 734: } 735: if ($target eq 'answer') { 736: if ($fmt && $tag eq 'numericalresponse') { 737: $fmt=~s/e/E/g; 738: if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; } 739: if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; } 740: $element = &format_number($element,$fmt,$target,$safeeval); 741: #if ($high) { 742: # $high=&format_number($high,$fmt,$target,$safeeval); 743: # $low =&format_number($low,$fmt,$target,$safeeval); 744: #} 745: } 746: if ($high && $tag eq 'numericalresponse') { 747: $element.='; ['.$low.'; '.$high.']'; 748: $tolline .= "[$low, $high]"; 749: } 750: if (defined($sighigh) && $tag eq 'numericalresponse') { 751: if ($env{'form.answer_output_mode'} eq 'tex') { 752: $element.= "; Sig $siglow - $sighigh"; 753: } else { 754: $element.= " Sig <i>$siglow - $sighigh</i>"; 755: $sigline .= "[$siglow, $sighigh]"; 756: } 757: } 758: push(@all_answer_info,$element); 759: 760: } elsif ($target eq 'analyze') { 761: push (@{ $Apache::lonhomework::analyze{"$part_id.answer"}{$name}[$i] }, $element); 762: if ($high) { 763: push (@{ $Apache::lonhomework::analyze{"$part_id.ans_high"}{$name}[$i] }, $high); 764: push (@{ $Apache::lonhomework::analyze{"$part_id.ans_low"}{$name}[$i] }, $low); 765: } 766: if ($fmt) { 767: push (@{ $Apache::lonhomework::analyze{"$part_id.format"}{$name}[$i] }, $fmt); 768: } 769: } 770: } 771: if ($target eq 'answer') { 772: $result.= &Apache::response::answer_part($tag,join('; ',@all_answer_info)); 773: } 774: } 775: 776: my @fmt_ans; 777: for(my $i=0;$i<=$#answers;$i++) { 778: my $ans=$answers[$i]; 779: my $fmt=$formats[0]; 780: if (@formats && $#formats) {$fmt=$formats[$i];} 781: foreach my $element (@$ans) { 782: if ($fmt && $tag eq 'numericalresponse') { 783: $fmt=~s/e/E/g; 784: if ($unit=~/\$/) { $fmt="\$".$fmt; $unit=~s/\$//g; } 785: if ($unit=~/\,/) { $fmt="\,".$fmt; $unit=~s/\,//g; } 786: $element = &format_number($element,$fmt,$target, 787: $safeeval); 788: if ($fmt=~/\$/ && $unit!~/\$/) { $element=~s/\$//; } 789: } 790: } 791: push(@fmt_ans,join(',',@$ans)); 792: } 793: my $response=\@fmt_ans; 794: 795: my $hideunit=&Apache::lonnet::EXT('resource.'.$partid.'_'. 796: $id.'.turnoffunit'); 797: if ($unit ne '' && 798: ! ($Apache::lonhomework::type eq 'exam' || 799: lc($hideunit) eq "yes") ) { 800: my $cleanunit=$unit; 801: $cleanunit=~s/\$\,//g; 802: foreach my $ans (@fmt_ans) { 803: $ans.=" $cleanunit"; 804: } 805: } 806: my ($ad,$msg)=&check_submission($response,$partid,$id,$tag, 807: $parstack,$safeeval); 808: if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') { 809: my $error; 810: if ($tag eq 'formularesponse') { 811: $error=&mt("Computer's answer is incorrect ([_1]).",'"'.join(', ',@$response).'"'); 812: } else { 813: # answer failed check if it is sig figs that is failing 814: my ($ad,$msg)=&check_submission($response,$partid,$id, 815: $tag,$parstack, 816: $safeeval,1); 817: $error=&mt("Computer's answer is incorrect ([_1]).",'"'.join(', ',@$response).'"').' '; 818: if ($sigline ne '') { 819: $error.=&mt('It is likely that the tolerance range [_1] or significant figures [_2] need to be adjusted.',$tolline,$sigline); 820: } else { 821: $error.=&mt('It is likely that the tolerance range [_1] needs to be adjusted.',$tolline); 822: } 823: } 824: if ($ad ne 'EXACT_ANS' && $ad ne 'APPROX_ANS') { 825: &Apache::lonxml::error($error); 826: } else { 827: &Apache::lonxml::warning($error); 828: } 829: } 830: 831: if (defined($unit) and ($unit ne '') and 832: $tag eq 'numericalresponse') { 833: if ($target eq 'answer') { 834: if ($env{'form.answer_output_mode'} eq 'tex') { 835: $result.=&Apache::response::answer_part($tag, 836: " Unit: $unit "); 837: } else { 838: $result.=&Apache::response::answer_part($tag, 839: "Unit: <b>$unit</b>"); 840: } 841: } elsif ($target eq 'analyze') { 842: push (@{ $Apache::lonhomework::analyze{"$part_id.unit"} }, $unit); 843: } 844: } 845: if ($tag eq 'formularesponse' && $target eq 'answer') { 846: my $samples=&Apache::lonxml::get_param('samples',$parstack,$safeeval); 847: $result.=&Apache::response::answer_part($tag,$samples); 848: } 849: $result.=&Apache::response::next_answer($tag,$name); 850: } 851: if ($target eq 'answer') { 852: $result.=&Apache::response::answer_footer($tag); 853: } 854: } 855: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 856: $target eq 'tex' || $target eq 'analyze') { 857: if (($tag eq 'formularesponse') && ($target eq 'analyze')) { 858: my $type = &Apache::lonnet::EXT('resource.'.$partid.'_'.$id.'.type'); 859: if ($type eq 'exam') { 860: $increment = &Apache::response::repetition(); 861: } 862: } 863: &Apache::lonxml::increment_counter($increment,"$partid.$id"); 864: if ($target eq 'analyze') { 865: &Apache::lonhomework::set_bubble_lines(); 866: } 867: } 868: &Apache::response::end_response(); 869: return $result; 870: } 871: 872: sub format_prior_response_numerical { 873: my ($mode,$answer) = @_; 874: if (ref($answer)) { 875: my $result = '<table class="LC_prior_numerical"><tr>'; 876: foreach my $element (@{ $answer }) { 877: $result.= '<td><span class="LC_prior_numerical">'. 878: &HTML::Entities::encode($element,'"<>&').'</span></td>'; 879: } 880: $result.='</tr></table>'; 881: return $result; 882: } 883: return '<span class="LC_prior_numerical">'. 884: &HTML::Entities::encode($answer,'"<>&').'</span>'; 885: 886: } 887: 888: sub check_for_answer_errors { 889: my ($parstack,$safeeval) = @_; 890: &add_in_tag_answer($parstack,$safeeval); 891: my %counts; 892: foreach my $name (keys(%answer)) { 893: push(@{$counts{scalar(@{$answer{$name}{'answers'}})}},$name); 894: } 895: if (scalar(keys(%counts)) > 1) { 896: my $counts = join(' ',map { 897: my $count = $_; 898: &mt("Answers [_1] had [_2] components.", 899: '<tt>'.join(', ',@{$counts{$count}}).'</tt>', 900: $count); 901: } (sort(keys(%counts)))); 902: &Apache::lonxml::error(&mt("All answers must have the same number of components. Varying numbers of answers were seen. ").$counts); 903: } 904: my $expected_number_of_inputs = (keys(%counts))[0]; 905: if ( $expected_number_of_inputs > 0 906: && $expected_number_of_inputs != scalar(@Apache::inputtags::inputlist)) { 907: &Apache::lonxml::error(&mt("Expected [_1] input fields, but there were only [_2] seen.", 908: $expected_number_of_inputs, 909: scalar(@Apache::inputtags::inputlist))); 910: } 911: } 912: 913: sub get_table_sizes { 914: my ($number_of_bubbles,$rbubble_values)=@_; 915: my $scale=2; #mm for one digit 916: my $cell_width=0; 917: foreach my $member (@$rbubble_values) { 918: my $cell_width_real=0; 919: if ($member=~/(\+|-)?(\d*)\.?(\d*)\s*\$?\\times\s*10\^{(\+|-)?(\d+)}\$?/) { 920: $cell_width_real=(length($2)+length($3)+length($5)+7)*$scale; 921: } elsif ($member=~/(\d*)\.?(\d*)(E|e)(\+|-)?(\d*)/) { 922: $cell_width_real=(length($1)+length($2)+length($5)+9)*$scale; 923: } elsif ($member=~/(\d*)\.(\d*)/) { 924: $cell_width_real=(length($1)+length($2)+3)*$scale; 925: } else { 926: $cell_width_real=(length($member)+1)*$scale*0.9; 927: } 928: if ($cell_width_real>$cell_width) {$cell_width=$cell_width_real;} 929: } 930: $cell_width+=8; 931: my $textwidth; 932: if ($env{'form.textwidth'} ne '') { 933: $env{'form.textwidth'}=~/(\d*)\.?(\d*)/; 934: $textwidth=$1.'.'.$2; 935: } else { 936: $env{'form.textwidth'}=~/(\d+)\.?(\d*)/; 937: $textwidth=$1.'.'.$2; 938: } 939: my $bubbles_per_line=int($textwidth/$cell_width); 940: if ($bubbles_per_line > $number_of_bubbles) { 941: $bubbles_per_line=$number_of_bubbles; 942: } elsif (($bubbles_per_line > $number_of_bubbles/2) 943: && ($number_of_bubbles % 2==0)) { 944: $bubbles_per_line=$number_of_bubbles/2; 945: } 946: if ($bubbles_per_line < 1) { 947: $bubbles_per_line=1; 948: } 949: my $number_of_tables = int($number_of_bubbles/$bubbles_per_line); 950: my @table_range = (); 951: for (my $i=0;$i<$number_of_tables;$i++) {push @table_range,$bubbles_per_line;} 952: if ($number_of_bubbles % $bubbles_per_line) { 953: $number_of_tables++; 954: push @table_range,($number_of_bubbles % $bubbles_per_line); 955: } 956: $cell_width-=8; 957: $cell_width=$cell_width*3/4; 958: return ($cell_width,$number_of_tables,@table_range); 959: } 960: 961: sub format_number { 962: my ($number,$format,$target,$safeeval)=@_; 963: my $ans; 964: if ($format eq '') { 965: #What is the number? (integer,decimal,floating point) 966: if ($number=~/^(\d*\.?\d*)(E|e)[+\-]?(\d*)$/) { 967: $format = '3e'; 968: } elsif ($number=~/^(\d*)\.(\d*)$/) { 969: $format = '4f'; 970: } elsif ($number=~/^(\d*)$/) { 971: $format = 'd'; 972: } 973: } 974: if (!$Apache::lonxml::default_homework_loaded) { 975: &Apache::lonxml::default_homework_load($safeeval); 976: } 977: $ans=&Apache::run::run("&prettyprint(q\0$number\0,q\0$format\0,q\0$target\0)",$safeeval); 978: return $ans; 979: } 980: 981: sub make_numerical_bubbles { 982: my ($part,$id,$target,$parstack,$safeeval) =@_; 983: 984: if (!%answer) { 985: &Apache::lonxml::error(&mt("No answers defined for response [_1] in part [_2] to make bubbles for.",$id,$part)); 986: return ([],[],undef); 987: } 988: 989: my $number_of_bubbles = 990: &Apache::response::get_response_param($part.'_'.$id,'numbubbles',8); 991: 992: my ($format)=&Apache::lonxml::get_param_var('format',$parstack,$safeeval); 993: my $name = (exists($answer{$tag_internal_answer_name}) 994: ? $tag_internal_answer_name 995: : (sort(keys(%answer)))[0]); 996: 997: if ( scalar(@{$answer{$name}{'answers'}}) > 1) { 998: &Apache::lonxml::error("Only answers with 1 component are supported in exam mode"); 999: } 1000: if (scalar(@{$answer{$name}{'answers'}[0]}) > 1) { 1001: &Apache::lonxml::error("Vector answers are unsupported in exam mode."); 1002: } 1003: 1004: my $answer = $answer{$name}{'answers'}[0][0]; 1005: my (@incorrect)=&Apache::lonxml::get_param_var('incorrect',$parstack, 1006: $safeeval); 1007: if ($#incorrect eq 0) { @incorrect=(split(/,/,$incorrect[0])); } 1008: 1009: my @bubble_values=(); 1010: my @alphabet=('A'..'Z'); 1011: 1012: &Apache::lonxml::debug("answer is $answer incorrect is @incorrect"); 1013: my @oldseed=&Math::Random::random_get_seed(); 1014: if (@incorrect) { 1015: &Apache::lonxml::debug("inside ".(scalar(@incorrect)+1 gt $number_of_bubbles)); 1016: if (defined($incorrect[0]) && 1017: scalar(@incorrect)+1 >= $number_of_bubbles) { 1018: &Apache::lonxml::debug("inside ".(scalar(@incorrect)+1).":$number_of_bubbles"); 1019: &Apache::response::setrandomnumber(); 1020: my @rand_inc=&Math::Random::random_permutation(@incorrect); 1021: @bubble_values=@rand_inc[0..($number_of_bubbles-2)]; 1022: @bubble_values=sort {$a <=> $b} (@bubble_values,$answer); 1023: &Apache::lonxml::debug("Answer was :$answer: returning :".$#bubble_values.": which are :".join(':',@bubble_values)); 1024: &Math::Random::random_set_seed(@oldseed); 1025: 1026: my $correct; 1027: for(my $i=0; $i<=$#bubble_values;$i++) { 1028: if ($bubble_values[$i] eq $answer) { 1029: $correct = $alphabet[$i]; 1030: last; 1031: } 1032: } 1033: 1034: if (defined($format) && $format ne '') { 1035: my @bubble_display; 1036: foreach my $value (@bubble_values) { 1037: push(@bubble_display, 1038: &format_number($value,$format,$target,$safeeval)); 1039: } 1040: return (\@bubble_values,\@bubble_display,$correct); 1041: } else { 1042: return (\@bubble_values,\@bubble_values,$correct); 1043: } 1044: } 1045: if (defined($incorrect[0]) && 1046: scalar(@incorrect)+1 < $number_of_bubbles) { 1047: &Apache::lonxml::warning("Not enough incorrect answers were specified in the incorrect array, ignoring the specified incorrect answers and instead generating them (".join(',',@incorrect).")."); 1048: } 1049: } 1050: my @factors = (1.13,1.17,1.25,1.33,1.45); #default values of factors 1051: my @powers = (1..$number_of_bubbles); 1052: &Apache::response::setrandomnumber(); 1053: my $ind=&Math::Random::random_uniform_integer(1,0,$#powers); 1054: my $power = $powers[$ind]; 1055: $ind=&Math::Random::random_uniform_integer(1,0,$#factors); 1056: my $factor = $factors[$ind]; 1057: my @bubble_display; 1058: my $answerfactor=$answer; 1059: if ($answer==0) { 1060: $answerfactor=&Math::Random::random_uniform_integer(1,1,100)/ 1061: &Math::Random::random_uniform_integer(1,1,10); 1062: } 1063: for ($ind=0;$ind<$number_of_bubbles;$ind++) { 1064: $bubble_values[$ind] = $answerfactor*($factor**($power-$powers[$#powers-$ind])); 1065: $bubble_display[$ind] = &format_number($bubble_values[$ind], 1066: $format,$target,$safeeval); 1067: } 1068: my $correct = $alphabet[$number_of_bubbles-$power]; 1069: if ($answer==0) { 1070: $correct='A'; 1071: $bubble_values[0]=0; 1072: $bubble_display[0] = &format_number($bubble_values[0], 1073: $format,$target,$safeeval); 1074: } 1075: &Math::Random::random_set_seed(@oldseed); 1076: return (\@bubble_values,\@bubble_display,$correct); 1077: } 1078: 1079: sub get_tolrange { 1080: my ($ans,$tol)=@_; 1081: my ($high,$low); 1082: if ($tol =~ /%$/) { 1083: chop($tol); 1084: my $change=$ans*($tol/100.0); 1085: $high=$ans+$change; 1086: $low=$ans-$change; 1087: } else { 1088: $high=$ans+$tol; 1089: $low=$ans-$tol; 1090: } 1091: return ($high,$low); 1092: } 1093: 1094: sub get_sigrange { 1095: my ($sig)=@_; 1096: #&Apache::lonxml::debug("Got a sig of :$sig:"); 1097: my $courseid=$env{'request.course.id'}; 1098: if ($env{'request.state'} ne 'construct' 1099: && lc($env{"course.$courseid.disablesigfigs"}) eq 'yes') { 1100: return (15,0); 1101: } 1102: my $sig_lbound; 1103: my $sig_ubound; 1104: if ($sig eq '') { 1105: $sig_lbound = 0; #SIG_LB_DEFAULT 1106: $sig_ubound =15; #SIG_UB_DEFAULT 1107: } else { 1108: ($sig_lbound,$sig_ubound) = split(/,/,$sig); 1109: if (!defined($sig_lbound)) { 1110: $sig_lbound = 0; #SIG_LB_DEFAULT 1111: $sig_ubound =15; #SIG_UB_DEFAULT 1112: } 1113: if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; } 1114: } 1115: if (($sig_ubound<$sig_lbound) || 1116: ($sig_lbound > 15) || 1117: ($sig =~/(\+|-)/ ) ) { 1118: my $errormsg=&mt("Invalid Significant figures detected")." ($sig)"; 1119: if ($env{'request.state'} eq 'construct') { 1120: $errormsg.= 1121: &Apache::loncommon::help_open_topic('Significant_Figures'); 1122: } 1123: &Apache::lonxml::error($errormsg); 1124: } 1125: return ($sig_ubound,$sig_lbound); 1126: } 1127: 1128: sub format_prior_response_string { 1129: my ($mode,$answer) =@_; 1130: return '<span class="LC_prior_string">'. 1131: &HTML::Entities::encode($answer,'"<>&').'</span>'; 1132: } 1133: 1134: sub start_stringresponse { 1135: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1136: my $result; 1137: my $id = &Apache::response::start_response($parstack,$safeeval); 1138: if ($target eq 'meta') { 1139: $result=&Apache::response::meta_package_write('stringresponse'); 1140: } elsif ($target eq 'edit') { 1141: $result.=&Apache::edit::tag_start($target,$token); 1142: $result.=&Apache::edit::text_arg('Answer:','answer',$token); 1143: $result.=&Apache::edit::select_arg('Type:','type', 1144: [['cs','Case Sensitive'],['ci','Case Insensitive'], 1145: ['mc','Case Insensitive, Any Order'], 1146: ['re','Regular Expression']],$token); 1147: $result.=&Apache::edit::text_arg('String to display for answer:', 1148: 'answerdisplay',$token); 1149: $result.=&Apache::edit::end_row().&Apache::edit::start_spanning_row(); 1150: } elsif ($target eq 'modified') { 1151: my $constructtag; 1152: $constructtag=&Apache::edit::get_new_args($token,$parstack, 1153: $safeeval,'answer', 1154: 'type','answerdisplay'); 1155: if ($constructtag) { 1156: $result = &Apache::edit::rebuild_tag($token); 1157: $result.=&Apache::edit::handle_insert(); 1158: } 1159: } elsif ($target eq 'web') { 1160: if ( &Apache::response::show_answer() ) { 1161: my $answer= 1162: &Apache::lonxml::get_param('answerdisplay',$parstack,$safeeval); 1163: if (!defined $answer || $answer eq '') { 1164: $answer= 1165: &Apache::lonxml::get_param('answer',$parstack,$safeeval); 1166: } 1167: $Apache::inputtags::answertxt{$id}=[$answer]; 1168: } 1169: } elsif ($target eq 'answer' || $target eq 'grade') { 1170: &Apache::response::reset_params(); 1171: } 1172: return $result; 1173: } 1174: 1175: sub end_stringresponse { 1176: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1177: 1178: my $result = ''; 1179: my $part=$Apache::inputtags::part; 1180: my $id=$Apache::inputtags::response[-1]; 1181: my $answer=&Apache::lonxml::get_param('answer',$parstack,$safeeval); 1182: my $type=&Apache::lonxml::get_param('type',$parstack,$safeeval); 1183: my $answerdisplay=&Apache::lonxml::get_param('answerdisplay',$parstack,$safeeval); 1184: &Apache::lonxml::debug("current $answer ".$token->[2]); 1185: if (!$Apache::lonxml::default_homework_loaded) { 1186: &Apache::lonxml::default_homework_load($safeeval); 1187: } 1188: if ( $target eq 'grade' && &Apache::response::submitted() ) { 1189: &Apache::response::setup_params('stringresponse',$safeeval); 1190: $safeeval->share_from('capa',['&caparesponse_capa_check_answer']); 1191: if ($Apache::lonhomework::type eq 'exam' || 1192: &Apache::response::submitted('scantron')) { 1193: &Apache::response::scored_response($part,$id); 1194: 1195: } else { 1196: my $response = &Apache::response::getresponse(); 1197: if ( $response =~ /[^\s]/) { 1198: my %previous = &Apache::response::check_for_previous($response, 1199: $part,$id, 1200: undef,$type); 1201: &Apache::lonxml::debug("submitted a $response<br>\n"); 1202: &Apache::lonxml::debug($$parstack[-1] . "\n<br>"); 1203: $Apache::lonhomework::results{"resource.$part.$id.submission"}= 1204: $response; 1205: my ($ad,$msg); 1206: if ($type eq 're' ) { 1207: # if the RE wasn't in a var it likely got munged, 1208: # thus grab it from the var directly 1209: # my $testans=$token->[2]->{'answer'}; 1210: # if ($testans !~ m/^\s*\$/) { 1211: # $answer=$token->[2]->{'answer'}; 1212: # } 1213: ${$safeeval->varglob('LONCAPA::response')}=$response; 1214: $result = &Apache::run::run('if ($LONCAPA::response=~m'.$answer.') { return 1; } else { return 0; }',$safeeval); 1215: &Apache::lonxml::debug("current $response"); 1216: &Apache::lonxml::debug("current $answer"); 1217: $ad = ($result) ? 'APPROX_ANS' : 'INCORRECT'; 1218: } else { 1219: my @args = ('type'); 1220: my $args_ref = &setup_capa_args($safeeval,$parstack, 1221: \@args,$response); 1222: if ($$args_ref{'type'} eq '') { 1223: $$args_ref{'type'} = 'ci'; 1224: } 1225: &add_in_tag_answer($parstack,$safeeval); 1226: my (@final_awards,@final_msgs,@names); 1227: foreach my $name (keys(%answer)) { 1228: &Apache::lonxml::debug(" doing $name with ".join(':',@{ $answer{$name}{'answers'} })); 1229: ${$safeeval->varglob('LONCAPA::CAPAresponse_answer')}=dclone($answer{$name}); 1230: my ($result, @msgs)=&Apache::run::run("&caparesponse_check_list()",$safeeval); 1231: if ($$args_ref{'type'} =~ /^c[si]$/) { 1232: my $error = pop(@msgs); 1233: if ($error ne '') { 1234: my ($symb,$courseid,$domain,$name) = 1235: &Apache::lonnet::whichuser(); 1236: &Apache::lonnet::logthis("Stringresponse grading error: $error for $name:$domain in $courseid for part: $part response: $id and symb: $symb"); 1237: } 1238: } 1239: &Apache::lonxml::debug('msgs are'.join(':',@msgs)); 1240: my ($awards)=split(/:/,$result); 1241: my (@awards) = split(/,/,$awards); 1242: ($ad,$msg) = 1243: &Apache::inputtags::finalizeawards(\@awards,\@msgs); 1244: push(@final_awards,$ad); 1245: push(@final_msgs,$msg); 1246: push(@names,$name); 1247: &Apache::lonxml::debug("\n<br>result:$result:$Apache::lonxml::curdepth<br>\n"); 1248: } 1249: ($ad, $msg, my $name) = 1250: &Apache::inputtags::finalizeawards(\@final_awards, 1251: \@final_msgs, 1252: \@names,1); 1253: } 1254: if (($ad eq 'INCORRECT' || $ad eq 'APPROX_ANS' || 1255: $ad eq 'EXACT_ANS')) { 1256: if ($Apache::lonhomework::type eq 'survey') { 1257: $ad='SUBMITTED'; 1258: } elsif ($Apache::lonhomework::type eq 'surveycred') { 1259: $ad='SUBMITTED_CREDIT'; 1260: } elsif ($Apache::lonhomework::type eq 'anonsurvey') { 1261: $ad='ANONYMOUS'; 1262: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 1263: $ad='ANONYMOUS_CREDIT'; 1264: } 1265: } 1266: unless ($env{'request.state'} eq 'construct') { 1267: if ($previous{'used'}) { 1268: if ($ad ne $previous{'award'} && $previous{'award'} ne '') { 1269: &stringresponse_gradechange($part,$id,\%previous, 1270: 'cs',$response,$ad,$type); 1271: } 1272: } elsif ($previous{'usedci'}) { 1273: if ($ad ne $previous{'awardci'} && $previous{'awardci'} ne '') { 1274: &stringresponse_gradechange($part,$id,\%previous, 1275: 'ci',$response,$ad,$type); 1276: } 1277: } 1278: } 1279: &Apache::response::handle_previous(\%previous,$ad); 1280: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$ad; 1281: $Apache::lonhomework::results{"resource.$part.$id.awardmsg"}=$msg; 1282: } 1283: } 1284: } elsif ($target eq 'answer' || $target eq 'analyze') { 1285: &add_in_tag_answer($parstack,$safeeval); 1286: if ($target eq 'analyze') { 1287: push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id"); 1288: $Apache::lonhomework::analyze{"$part.$id.type"} = 'stringresponse'; 1289: &Apache::response::check_if_computed($token,$parstack,$safeeval, 1290: 'answer'); 1291: } 1292: &Apache::response::setup_params('stringresponse',$safeeval); 1293: if ($target eq 'answer') { 1294: $result.=&Apache::response::answer_header('stringresponse'); 1295: } 1296: foreach my $name (keys(%answer)) { 1297: my @answers = @{ $answer{$name}{'answers'} }; 1298: for (my $i=0;$i<=$#answers;$i++) { 1299: my $answer_part = $answers[$i]; 1300: foreach my $element (@{$answer_part}) { 1301: if ($target eq 'answer') { 1302: $result.=&Apache::response::answer_part('stringresponse', 1303: $element); 1304: } elsif ($target eq 'analyze') { 1305: push (@{ $Apache::lonhomework::analyze{"$part.$id.answer"}{$name}[$i] }, 1306: $element); 1307: } 1308: } 1309: if ($target eq 'answer' && $type eq 're') { 1310: $result.=&Apache::response::answer_part('stringresponse', 1311: $answerdisplay); 1312: } 1313: } 1314: } 1315: my $string='Case Insensitive'; 1316: if ($type eq 'mc') { 1317: $string='Multiple Choice'; 1318: } elsif ($type eq 'cs') { 1319: $string='Case Sensitive'; 1320: } elsif ($type eq 'ci') { 1321: $string='Case Insensitive'; 1322: } elsif ($type eq 're') { 1323: $string='Regular Expression'; 1324: } 1325: if ($target eq 'answer') { 1326: if ($env{'form.answer_output_mode'} eq 'tex') { 1327: $result.=&Apache::response::answer_part('stringresponse', 1328: "$string"); 1329: } else { 1330: $result.=&Apache::response::answer_part('stringresponse', 1331: "<b>$string</b>"); 1332: } 1333: } elsif ($target eq 'analyze') { 1334: push (@{$Apache::lonhomework::analyze{"$part.$id.str_type"}}, 1335: $type); 1336: } 1337: if ($target eq 'answer') { 1338: $result.=&Apache::response::answer_footer('stringresponse'); 1339: } 1340: } elsif ($target eq 'edit') { 1341: $result.='</td></tr>'.&Apache::edit::end_table; 1342: } elsif ($target eq 'web' || $target eq 'tex') { 1343: &Apache::response::setup_prior_tries_hash(\&format_prior_response_string); 1344: } 1345: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 1346: $target eq 'tex' || $target eq 'analyze') { 1347: &Apache::lonxml::increment_counter(&Apache::response::repetition(), 1348: "$part.$id"); 1349: if ($target eq 'analyze') { 1350: &Apache::lonhomework::set_bubble_lines(); 1351: } 1352: } 1353: &Apache::response::end_response; 1354: return $result; 1355: } 1356: 1357: sub start_formularesponse { 1358: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 1359: my $result; 1360: if ($target eq 'meta') { 1361: &Apache::response::start_response($parstack,$safeeval); 1362: $result=&Apache::response::meta_package_write('formularesponse'); 1363: &Apache::response::end_response(); 1364: } else { 1365: $result.=&start_numericalresponse(@_); 1366: } 1367: return $result; 1368: } 1369: 1370: sub end_formularesponse { 1371: return end_numericalresponse(@_); 1372: } 1373: 1374: 1; 1375: __END__ 1376: