Annotation of loncom/homework/default_homework.lcpm, revision 1.25

1.25    ! albertel    1: # file name (temp): default_homework
1.1       harris41    2: # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
1.20      harris41    3: #
                      4: # Guy Albertelli
                      5: #
                      6: # 05/25/2001 H. K. Ng
1.24      ng          7: # 05/31/2001 H. K. Ng
1.20      harris41    8: #
1.25    ! albertel    9: #init some globals
1.3       albertel   10: $RANDOMINIT=0;
1.22      ng         11: $pi=atan2(1,1)*4;
                     12: $rad2deg=180.0/$pi;
                     13: $deg2rad=$pi/180.0;
1.3       albertel   14: 
1.7       albertel   15: sub caparesponse_check {
1.10      albertel   16:   my $answer='';  #done
                     17:   my $type='';    #done
                     18:   my $tol_type=''; # gets it's value from whether tol has a % or not done
                     19:   my $tol='';     #done
1.19      albertel   20:   my $sig='';     #done lowerbnd,upperbnd
                     21:   my $sig_lbound=''; #done
                     22:   my $sig_ubound=''; #done
1.7       albertel   23:   my $ans_fmt='';
1.19      albertel   24:   my $units='';     #done
1.7       albertel   25:   my $calc='';
                     26:   my ($response,$expr)=@_;
                     27:   
1.12      albertel   28:   ($answer,$type,$tol,$sig,$ans_fmt,
                     29:    $units,$calc) = eval $expr.';return $answer,$type,$tol,$sig,$ans_fmt,$units,$calc';
1.8       albertel   30:   #type's definitons come from capaParser.h
                     31:   if ($type eq '' ) {
                     32:     if ( $answer eq ($answer *1.0)) { $type = 2;
                     33:     } else { $type = 3; }
                     34:   } else {
                     35:          if ($type eq 'cs')    { $type = 4;
                     36:     } elsif ($type eq 'ci')    { $type = 3;
                     37:     } elsif ($type eq 'mc')    { $type = 5;
                     38:     } elsif ($type eq 'fml')   { $type = 8;
1.9       albertel   39:     } elsif ($type eq 'subj')  { $type = 7;
                     40:     } else { return "ERROR: Unknown type of answer: $type" }
1.8       albertel   41:   }
                     42: 
1.10      albertel   43:   if ($tol eq '') {
                     44:     $tol=0.0;
                     45:     $tol_type=1; #TOL_ABSOLUTE
                     46:   } else {
                     47:     if ($tol =~ /%$/) {
1.12      albertel   48:       chop $tol;
1.10      albertel   49:       $tol_type=2; #TOL_PERCENTAGE
                     50:     } else {
                     51:       $tol_type=1; #TOL_ABSOLUTE
                     52:     }
                     53:   }
1.12      albertel   54: 
                     55:   if ($sig eq '') {
                     56:     $sig_lbound = 0; #SIG_LB_DEFAULT
                     57:     $sig_ubound =15; #SIG_UB_DEFAULT
                     58:   } else {
                     59:     ($sig_lbound,$sig_ubound) = split /,/,$sig;
                     60:   }
1.7       albertel   61:   my $result = &caparesponse_capa_check_answer($response,$answer,$type,
1.10      albertel   62: 					       $tol_type,$tol,
1.7       albertel   63: 					       $sig_lbound,$sig_ubound,
1.12      albertel   64: 					       $ans_fmt,$units,$calc);
1.9       albertel   65: 
                     66:   if    ($result == '1') { $result='EXACT_ANS'; } 
                     67:   elsif ($result == '2') { $result='APPROX_ANS'; }
                     68:   elsif ($result == '3') { $result='SIG_FAIL'; }
                     69:   elsif ($result == '4') { $result='UNIT_FAIL'; }
                     70:   elsif ($result == '5') { $result='NO_UNIT'; }
                     71:   elsif ($result == '6') { $result='UNIT_OK'; }
                     72:   elsif ($result == '7') { $result='INCORRECT'; }
                     73:   elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
                     74:   elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
                     75:   elsif ($result =='10') { $result='SUB_RECORDED'; }
                     76:   elsif ($result =='11') { $result='BAD_FORMULA'; }
                     77:   elsif ($result =='12') { $result='WANTED_NUMERIC'; }
1.13      albertel   78:   else  {$result = "ERROR: Unknown Result:$result:$@:";}
1.9       albertel   79: 
1.17      albertel   80:   return "$result:<br />Error $error:<br />Answer $answer:<br />Response $response:<br />$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$units<br />";
1.14      albertel   81: }
                     82: 
                     83: sub caparesponse_check_list {
                     84:   my ($response,$expr)=@_;
                     85:   my $result='';
1.15      albertel   86:   my $aresult='';
1.14      albertel   87:   my $current_answer;
                     88:   my $answer = eval $expr.';return $answer';
                     89:   my (@list) = eval $answer;
                     90:   my (@responselist)=split /,/,$response;
1.15      albertel   91:   my $unit='';
1.17      albertel   92:   $result.="Final response :$responselist['-1']:<br />";
1.15      albertel   93:   if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
                     94:     $responselist['-1']=$1;
                     95:     $unit=$2;
                     96:   }
1.17      albertel   97:   $result.="Final response :$responselist['-1']:<br />";
1.14      albertel   98:   $unit=~s/\s//;
                     99:   my $i=0;
                    100:   my $awards='';
                    101:   for ($i=0; $i<@list;$i++) {
1.19      albertel  102:     if ($unit eq '') {
                    103:       $aresult=&caparesponse_check($responselist[$i],
                    104: 			     $expr.';my $answer='.$list[$i].';');
                    105:     } else {
                    106:       $aresult=&caparesponse_check($responselist[$i]." $unit",
                    107: 				   $expr.';my $answer='.$list[$i].';');
                    108:     }
1.15      albertel  109:     my ($temp)=split /:/, $aresult;
1.14      albertel  110:     $awards.="$temp,";
1.15      albertel  111:     $result.=$aresult;
1.14      albertel  112:   }
                    113:   chop $awards;
1.17      albertel  114:   return "$awards:<br />$result";
1.7       albertel  115: }
                    116: 
1.4       albertel  117: sub tex {
                    118:   if ( $external::target eq "tex" ) {
                    119:     return @_[0];
                    120:   } else {
                    121:     return @_[1];
                    122:   }
                    123: }
                    124: 
1.24      ng        125: sub var_in_tex {
                    126:   if ( $external::target eq "tex" ) {
                    127:     return @_[0];
                    128:   } else {
                    129:     return "";
                    130:   }
                    131: }
                    132: 
1.4       albertel  133: sub web {
                    134:   if ( $external::target eq "tex" ) {
                    135:     return @_[1];
                    136:   } else {
                    137:     if ( $external::target eq "web") {
                    138:       return @_[0];
                    139:     } else {
                    140:       return @_[2];
                    141:     }
                    142:   }
                    143: }
                    144: 
1.24      ng        145: sub html {
                    146:   if ( $external::target eq "web" ) {
                    147:     return @_[0];
                    148:   }
                    149: }
                    150: 
1.4       albertel  151: sub problem {
1.11      albertel  152:   return '1';
1.4       albertel  153: }
                    154: 
1.1       harris41  155: sub hinton {
                    156:   return 0;
                    157: }
                    158: 
                    159: sub random {
                    160:   my ($start,$end,$step)=@_;
1.3       albertel  161:   if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; }
1.1       harris41  162:   my $num=1+int(($end-$start)/$step);
                    163:   my $result=$start + int(rand() * $num)*$step;
                    164:   return $result;
                    165: }
                    166: 
1.23      ng        167: sub abs { abs(shift) }
                    168: sub sin { sin(shift) }
                    169: sub cos { cos(shift) }
                    170: sub exp { exp(shift) }
                    171: sub int { int(shift) }
                    172: sub log { log(shift) }
                    173: sub atan2 { atan2($_[0],$_[1]) }
                    174: sub sqrt { sqrt(shift) }
                    175: 
1.1       harris41  176: sub tan  { sin($_[0]) / cos($_[0]) }
1.21      harris41  177: #sub atan { atan2($_[0], 1); }
                    178: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
                    179: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }
1.22      ng        180: 
1.18      albertel  181: sub log10 { log($_[0])/log(10); }
1.22      ng        182: 
1.20      harris41  183: sub factorial {
                    184:     my $input = int(shift);
                    185:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
                    186:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
                    187:     return 1 if $input == 0;
                    188:     my $result = 1; 
                    189:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
                    190:     return $result;
                    191: }
                    192: 
                    193: sub sgn {
                    194:     return -1 if $_[0] < 0;
                    195:     return 0 if $_[0] == 0;
                    196:     return 1 if $_[0] > 0;
                    197: }
                    198: 
                    199: sub min {
                    200:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    201:     return shift @sorted;
                    202: }
                    203: 
                    204: sub max {
                    205:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    206:     return pop @sorted;
                    207: }
1.1       harris41  208: 
1.20      harris41  209: sub roundto {
                    210:     my ($input,$n) = @_;
                    211:     return sprintf('%.'.$n.'f',$input);
                    212: }
                    213: 
                    214: sub to_string {
                    215:     my ($input,$n) = @_;
                    216:     return sprintf('%'.$n,$input) if $n ne "";
                    217:     return sprintf($input) if $n eq "";
                    218: }
                    219: 
                    220: sub sub_string {
                    221:     my ($str,$start,$len) = @_;
                    222:     return substr($str,$start-1,$len);
                    223: }
1.1       harris41  224: 
                    225: sub pow   {return $_[0] ** $_[1]; }
                    226: sub ceil  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (int($_[0])+ 1); }
                    227: sub floor {return int($_[0]);  }
                    228: 
1.2       albertel  229: sub format {
                    230:   my ($value,$fmt)=@_;
1.11      albertel  231:   return sprintf('%.'.$fmt,$value);
1.2       albertel  232: }
1.5       albertel  233: 
                    234: sub map {
                    235:   my $num = $#_/2;
                    236:   my $i;
1.6       albertel  237:   my @used;
                    238:   my @permutation;
                    239:   for ($i=0; $i < $num;) {
                    240:     $rand = &random(1,$num,1);
                    241:     if ( $used[$rand] == '0' ) {
                    242:       $i++;
                    243:       $used[$rand]='1';
                    244:       $permutation[$i]=$rand;
                    245:     }
                    246:   }
1.5       albertel  247:   for ( $i=1 ; $i<$num+1 ; $i++ ) {
1.6       albertel  248:     ${$_[$permutation[$i]]}=$_[$i+$num]
1.5       albertel  249:   }
                    250: }
1.22      ng        251: 
1.23      ng        252: sub capa_id { return }
                    253: 
                    254: sub problem { return }
                    255: 
1.22      ng        256: sub name{
                    257:   my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
                    258:   $fullname = "" if $fullname eq ",  ";
1.23      ng        259:   $fullname =~ s/\%2d/-/;
1.22      ng        260:   return $fullname;
                    261: }
                    262: 
                    263: sub student_number { 
                    264:   my $id = &EXT('environment.id');
                    265:   $id = '' if $id eq "";
                    266:   return $id;
                    267: }
                    268: 
                    269: sub class {
                    270:   my $course = &EXT('course.description');
                    271:   $course = '' if $course eq "";
                    272:   return $course;
                    273: }
                    274: 
                    275: sub sec { 
                    276:   my $sec = &EXT('request.course.sec');
1.23      ng        277:   $sec = '' if $sec eq "";
1.22      ng        278:   return $sec;
                    279: }
                    280: 
1.23      ng        281: sub open_date { 
                    282:   my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
1.24      ng        283:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    284:   my @hm = split(/:/,$dc[3]);
                    285:   my $ampm = " am";
                    286:   if ($hm[0] > 12) {
                    287:     $hm[0]-=12;
                    288:     $ampm = " pm";
                    289:   }
                    290:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23      ng        291: }
                    292: 
                    293: sub due_date { 
                    294:   my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
1.24      ng        295:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    296:   my @hm = split(/:/,$dc[3]);
                    297:   my $ampm = " am";
                    298:   if ($hm[0] > 12) {
                    299:     $hm[0]-=12;
                    300:     $ampm = " pm";
                    301:   }
                    302:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    303: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
1.23      ng        304: }
                    305: 
                    306: sub answer_date { 
                    307:   my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
1.24      ng        308:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    309:   my @hm = split(/:/,$dc[3]);
                    310:   my $ampm = " am";
                    311:   if ($hm[0] > 12) {
                    312:     $hm[0]-=12;
                    313:     $ampm = " pm";
                    314:   }
                    315:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    316: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
                    317: }
                    318: 
                    319: sub array_moments {
                    320:   my @input=@_;
                    321:   my (@output,$N);
                    322:   $N=scalar (@input);
                    323:   $output[0]=$N;
                    324:   if ($N <= 1) {
                    325:     $output[1]=$input[0];
                    326:     $output[1] = "Input array not defined" if ($N == 0);
                    327:     $output[2]="variance undefined for N<=1";
                    328:     $output[3]="skewness undefined for N<=1";
                    329:     $output[4]="kurtosis undefined for N<=1";
                    330:     return @output;
                    331:   }
                    332:   my $sum=0;
                    333:   foreach my $line (@input) {
                    334:     $sum+=$line;
                    335:   }
                    336:   $output[1] = $sum/$N;
                    337:   my ($x,$sdev,$var,$skew,$kurt) = 0;
                    338:   foreach my $line (@input) {
                    339:     $x=$line-$output[1];
                    340:     $var+=$x**2;
                    341:     $skew+=$x**3;
                    342:     $kurt+=$x**4;
                    343:   }
                    344:   $output[2]=$var/($N-1);
                    345:   $sdev=sqrt($output[2]);
                    346:   if ($sdev == 0) {
                    347:      $output[3]="inf-variance=0";
                    348:      $output[4]="inf-variance=0";
                    349:      return @output;
                    350:   }
                    351:   $output[3]=$skew/($sdev**3*$N);
                    352:   $output[4]=$kurt/($sdev**4*$N)-3;
                    353:   return @output;
                    354: }
1.5       albertel  355: 
                    356: sub choose {
                    357:   my $num = $_[0];
                    358:   return $_[$num];
                    359: }
1.23      ng        360: 
                    361: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>