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

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") {
1.26    ! ng        138:       return @_[2];
        !           139:     } else {
1.4       albertel  140:       return @_[0];
                    141:     }
                    142:   }
                    143: }
                    144: 
1.24      ng        145: sub html {
                    146:   if ( $external::target eq "web" ) {
1.26    ! ng        147:     return shift;
1.24      ng        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.26    ! ng        167: sub random_normal {
        !           168:   my ($item_cnt,$seed,$av,$std_dev) = @_;
        !           169:   my @retArray;
        !           170:   &random_set_seed_from_phrase($seed);
        !           171:   @retArray=&math_random_normal($item_cnt,$av,$std_dev);
        !           172:   return @retArray;
        !           173: }
        !           174: 
        !           175: sub random_beta {
        !           176:   my ($item_cnt,$seed,$aa,$bb) = @_;
        !           177:   my @retArray;
        !           178:   &random_set_seed_from_phrase($seed);
        !           179:   @retArray=&math_random_beta($item_cnt,$aa,$bb);
        !           180:   return @retArray;
        !           181: }
        !           182: 
        !           183: sub random_gamma {
        !           184:   my ($item_cnt,$seed,$a,$r) = @_;
        !           185:   my @retArray;
        !           186:   &random_set_seed_from_phrase($seed);
        !           187:   @retArray=&math_random_gamma($item_cnt,$a,$r);
        !           188:   return @retArray;
        !           189: }
        !           190: 
        !           191: sub random_exponential {
        !           192:   my ($item_cnt,$seed,$av) = @_;
        !           193:   my @retArray;
        !           194:   &random_set_seed_from_phrase($seed);
        !           195:   @retArray=&math_random_exponential($item_cnt,$av);
        !           196:   return @retArray;
        !           197: }
        !           198: 
        !           199: sub random_poisson {
        !           200:   my ($item_cnt,$seed,$mu) = @_;
        !           201:   my @retArray;
        !           202:   &random_set_seed_from_phrase($seed);
        !           203:   @retArray=&math_random_poisson($item_cnt,$mu);
        !           204:   return @retArray;
        !           205: }
        !           206: 
        !           207: sub random_chi {
        !           208:   my ($item_cnt,$seed,$df) = @_;
        !           209:   my @retArray;
        !           210:   &random_set_seed_from_phrase($seed);
        !           211:   @retArray=&math_random_chi_square($item_cnt,$df);
        !           212:   return @retArray;
        !           213: }
        !           214: 
        !           215: sub random_noncentral_chi {
        !           216:   my ($item_cnt,$seed,$df,$nonc) = @_;
        !           217:   my @retArray;
        !           218:   &random_set_seed_from_phrase($seed);
        !           219:   @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
        !           220:   return @retArray;
        !           221: }
        !           222: 
        !           223: sub random_f {
        !           224:   my ($item_cnt,$seed,$dfn,$dfd) = @_;
        !           225:   my @retArray;
        !           226:   &random_set_seed_from_phrase($seed);
        !           227:   @retArray=&math_random_f($item_cnt,$dfn,$dfd);
        !           228:   return @retArray;
        !           229: }
        !           230: 
        !           231: sub random_noncentral_f {
        !           232:   my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
        !           233:   my @retArray;
        !           234:   &random_set_seed_from_phrase($seed);
        !           235:   @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
        !           236:   return @retArray;
        !           237: }
        !           238: 
        !           239: sub random_multivariate_normal {
        !           240:   my ($item_cnt,$seed,@mean) = @_;
        !           241:   return "Number of deviates must be greater than 0" if $item_cnt <= 0;
        !           242:   my (@covar,@retArray);
        !           243:   my $ind = 0;
        !           244:   while ($ind<$item_cnt) {
        !           245:      push @covar, pop (@mean);
        !           246:      $ind++;
        !           247:   }
        !           248:   &random_set_seed_from_phrase($seed);
        !           249:   @retArray=&math_random_multivariate_normal($item_cnt,@mean,@covar);
        !           250:   return @retArray;
        !           251: }
        !           252: 
        !           253: sub random_multinomial {
        !           254:   my ($item_cnt,$seed,@p) = @_;
        !           255:   my @retArray;
        !           256:   &random_set_seed_from_phrase($seed);
        !           257:   @retArray=&math_random_multinomial($item_cnt,@p);
        !           258:   return @retArray;
        !           259: }
        !           260: 
        !           261: sub random_permutation {
        !           262:   my ($seed,@inArray) = @_;
        !           263:   my @retArray;
        !           264:   &random_set_seed_from_phrase($seed);
        !           265:   @retArray=&math_random_permutation(@inArray);
        !           266:   return @retArray;
        !           267: }
        !           268: 
        !           269: sub random_uniform {
        !           270:   my ($item_cnt,$seed,$low,$high) = @_;
        !           271:   my @retArray;
        !           272:   &random_set_seed_from_phrase($seed);
        !           273:   @retArray=&math_random_uniform($item_cnt,$low,$high);
        !           274:   return @retArray;
        !           275: }
        !           276: 
        !           277: sub random_uniform_integer {
        !           278:   my ($item_cnt,$seed,$low,$high) = @_;
        !           279:   my @retArray;
        !           280:   &random_set_seed_from_phrase($seed);
        !           281:   @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
        !           282:   return @retArray;
        !           283: }
        !           284: 
        !           285: sub random_binomial {
        !           286:   my ($item_cnt,$seed,$nt,$p) = @_;
        !           287:   my @retArray;
        !           288:   &random_set_seed_from_phrase($seed);
        !           289:   @retArray=&math_random_binomial($item_cnt,$nt,$p);
        !           290:   return @retArray;
        !           291: }
        !           292: 
        !           293: sub random_negative_binomial {
        !           294:   my ($item_cnt,$seed,$ne,$p) = @_;
        !           295:   my @retArray;
        !           296:   &random_set_seed_from_phrase($seed);
        !           297:   @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
        !           298:   return @retArray;
        !           299: }
        !           300: 
1.23      ng        301: sub abs { abs(shift) }
                    302: sub sin { sin(shift) }
                    303: sub cos { cos(shift) }
                    304: sub exp { exp(shift) }
                    305: sub int { int(shift) }
                    306: sub log { log(shift) }
                    307: sub atan2 { atan2($_[0],$_[1]) }
                    308: sub sqrt { sqrt(shift) }
                    309: 
1.1       harris41  310: sub tan  { sin($_[0]) / cos($_[0]) }
1.21      harris41  311: #sub atan { atan2($_[0], 1); }
                    312: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
                    313: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }
1.22      ng        314: 
1.18      albertel  315: sub log10 { log($_[0])/log(10); }
1.22      ng        316: 
1.20      harris41  317: sub factorial {
                    318:     my $input = int(shift);
                    319:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
                    320:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
                    321:     return 1 if $input == 0;
                    322:     my $result = 1; 
                    323:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
                    324:     return $result;
                    325: }
                    326: 
                    327: sub sgn {
                    328:     return -1 if $_[0] < 0;
                    329:     return 0 if $_[0] == 0;
                    330:     return 1 if $_[0] > 0;
                    331: }
                    332: 
                    333: sub min {
                    334:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    335:     return shift @sorted;
                    336: }
                    337: 
                    338: sub max {
                    339:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
                    340:     return pop @sorted;
                    341: }
1.1       harris41  342: 
1.20      harris41  343: sub roundto {
                    344:     my ($input,$n) = @_;
                    345:     return sprintf('%.'.$n.'f',$input);
                    346: }
                    347: 
                    348: sub to_string {
                    349:     my ($input,$n) = @_;
1.26    ! ng        350:     return sprintf($input) if $n eq "";
        !           351:     $n = '.'.$n if $n !~ /^\./;
1.20      harris41  352:     return sprintf('%'.$n,$input) if $n ne "";
                    353: }
                    354: 
                    355: sub sub_string {
                    356:     my ($str,$start,$len) = @_;
                    357:     return substr($str,$start-1,$len);
                    358: }
1.1       harris41  359: 
                    360: sub pow   {return $_[0] ** $_[1]; }
                    361: sub ceil  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (int($_[0])+ 1); }
                    362: sub floor {return int($_[0]);  }
                    363: 
1.2       albertel  364: sub format {
                    365:   my ($value,$fmt)=@_;
1.11      albertel  366:   return sprintf('%.'.$fmt,$value);
1.2       albertel  367: }
1.5       albertel  368: 
                    369: sub map {
                    370:   my $num = $#_/2;
                    371:   my $i;
1.6       albertel  372:   my @used;
                    373:   my @permutation;
                    374:   for ($i=0; $i < $num;) {
                    375:     $rand = &random(1,$num,1);
                    376:     if ( $used[$rand] == '0' ) {
                    377:       $i++;
                    378:       $used[$rand]='1';
                    379:       $permutation[$i]=$rand;
                    380:     }
                    381:   }
1.5       albertel  382:   for ( $i=1 ; $i<$num+1 ; $i++ ) {
1.6       albertel  383:     ${$_[$permutation[$i]]}=$_[$i+$num]
1.5       albertel  384:   }
                    385: }
1.22      ng        386: 
1.23      ng        387: sub capa_id { return }
                    388: 
                    389: sub problem { return }
                    390: 
1.22      ng        391: sub name{
                    392:   my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
                    393:   $fullname = "" if $fullname eq ",  ";
1.26    ! ng        394:   $fullname =~ s/\%2d/-/g;
1.22      ng        395:   return $fullname;
                    396: }
                    397: 
                    398: sub student_number { 
                    399:   my $id = &EXT('environment.id');
                    400:   $id = '' if $id eq "";
                    401:   return $id;
                    402: }
                    403: 
                    404: sub class {
                    405:   my $course = &EXT('course.description');
                    406:   $course = '' if $course eq "";
                    407:   return $course;
                    408: }
                    409: 
                    410: sub sec { 
                    411:   my $sec = &EXT('request.course.sec');
1.23      ng        412:   $sec = '' if $sec eq "";
1.22      ng        413:   return $sec;
                    414: }
                    415: 
1.23      ng        416: sub open_date { 
                    417:   my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
1.24      ng        418:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    419:   my @hm = split(/:/,$dc[3]);
                    420:   my $ampm = " am";
                    421:   if ($hm[0] > 12) {
                    422:     $hm[0]-=12;
                    423:     $ampm = " pm";
                    424:   }
                    425:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
1.23      ng        426: }
                    427: 
                    428: sub due_date { 
                    429:   my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
1.24      ng        430:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    431:   my @hm = split(/:/,$dc[3]);
                    432:   my $ampm = " am";
                    433:   if ($hm[0] > 12) {
                    434:     $hm[0]-=12;
                    435:     $ampm = " pm";
                    436:   }
                    437:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    438: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
1.23      ng        439: }
                    440: 
                    441: sub answer_date { 
                    442:   my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
1.24      ng        443:   return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
                    444:   my @hm = split(/:/,$dc[3]);
                    445:   my $ampm = " am";
                    446:   if ($hm[0] > 12) {
                    447:     $hm[0]-=12;
                    448:     $ampm = " pm";
                    449:   }
                    450:   return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
                    451: #  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
                    452: }
                    453: 
                    454: sub array_moments {
                    455:   my @input=@_;
                    456:   my (@output,$N);
                    457:   $N=scalar (@input);
                    458:   $output[0]=$N;
                    459:   if ($N <= 1) {
                    460:     $output[1]=$input[0];
                    461:     $output[1] = "Input array not defined" if ($N == 0);
                    462:     $output[2]="variance undefined for N<=1";
                    463:     $output[3]="skewness undefined for N<=1";
                    464:     $output[4]="kurtosis undefined for N<=1";
                    465:     return @output;
                    466:   }
                    467:   my $sum=0;
                    468:   foreach my $line (@input) {
                    469:     $sum+=$line;
                    470:   }
                    471:   $output[1] = $sum/$N;
                    472:   my ($x,$sdev,$var,$skew,$kurt) = 0;
                    473:   foreach my $line (@input) {
                    474:     $x=$line-$output[1];
                    475:     $var+=$x**2;
                    476:     $skew+=$x**3;
                    477:     $kurt+=$x**4;
                    478:   }
                    479:   $output[2]=$var/($N-1);
                    480:   $sdev=sqrt($output[2]);
                    481:   if ($sdev == 0) {
                    482:      $output[3]="inf-variance=0";
                    483:      $output[4]="inf-variance=0";
                    484:      return @output;
                    485:   }
                    486:   $output[3]=$skew/($sdev**3*$N);
                    487:   $output[4]=$kurt/($sdev**4*$N)-3;
                    488:   return @output;
                    489: }
1.5       albertel  490: 
                    491: sub choose {
                    492:   my $num = $_[0];
                    493:   return $_[$num];
                    494: }
1.23      ng        495: 
                    496: 

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