loncom/homework/caparesponse/caparesponse.pm - view

File: [LON-CAPA] / loncom / homework / caparesponse / caparesponse.pm
Revision 1.252: download - view: text, annotated - select for diffs
Mon Mar 5 11:50:39 2012 UTC (12 years, 4 months ago) by foxr
Branches: MAIN
CVS tags: HEAD

BZ 6519 - Protect against invalid bubble counts:
   - Round bubble count to nearest integer.
   - Replace bubble counts <= 0 with the default value (8).

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