File:  [LON-CAPA] / loncom / homework / default_homework.lcpm
Revision 1.74: download - view: text, annotated - select for diffs
Tue Mar 16 19:47:47 2004 UTC (20 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: HEAD
- Fixes Bug#2820 (internal vars were clashing with user vars)
- Cleans up the way data is put into safe space, less escaping, names scaping etc issues
- <stringhint> supports re mode now.

    1: # The LearningOnline Network with CAPA 
    2: # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
    3: #
    4: # $Id: default_homework.lcpm,v 1.74 2004/03/16 19:47:47 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: #
   29: # Guy Albertelli
   30: #
   31: # 05/25/2001 H. K. Ng
   32: # 05/31/2001 H. K. Ng
   33: # 12/21/2001 Matthew
   34: #
   35: #init some globals
   36: $hidden::RANDOMINIT=0;
   37: $pi=atan2(1,1)*4;
   38: $rad2deg=180.0/$pi;
   39: $deg2rad=$pi/180.0;
   40: $"=' ';
   41: 
   42: sub caparesponse_check {
   43:     my ($answer,$response)=@_;
   44:     #not properly used yet: calc
   45:     #not to be used: $ans_fmt
   46:     my $type=$LONCAPA::CAPAresponse_args{'type'};
   47:     my $tol=$LONCAPA::CAPAresponse_args{'tol'};
   48:     my $sig=$LONCAPA::CAPAresponse_args{'sig'};
   49:     my $ans_fmt=$LONCAPA::CAPAresponse_args{'ans_fmt'};
   50:     my $unit=$LONCAPA::CAPAresponse_args{'unit'};
   51:     my $calc=$LONCAPA::CAPAresponse_args{'calc'};
   52:     my $samples=$LONCAPA::CAPAresponse_args{'samples'};
   53:     
   54:     my $tol_type=''; # gets it's value from whether tol has a % or not done
   55:     my $sig_lbound=''; #done
   56:     my $sig_ubound=''; #done
   57: 
   58: 
   59:     #type's definitons come from capaParser.h
   60:     my $message='';
   61:     #remove leading and trailing whitespace
   62:     if (!defined($response)) {
   63: 	$response='';
   64:     }
   65:     if ($response=~ /^\s|\s$/) {
   66: 	$response=~ s:^\s+|\s+$::g;
   67: 	$message .="Removed ws now :$response:\n";
   68:     } else {
   69: 	$message .="no ws in :$response:\n";
   70:     }
   71: 
   72:     if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
   73: 
   74:     if ($type eq '' ) {
   75: 	$message .= "Didn't find a type :$type: defaulting\n";
   76: 	if ( $answer eq ($answer *1.0)) { $type = 2;
   77: 				      } else { $type = 3; }
   78:     } else {
   79: 	if ($type eq 'cs')    { $type = 4; }
   80: 	elsif ($type eq 'ci')    { $type = 3 }
   81: 	elsif ($type eq 'mc')    { $type = 5; }
   82: 	elsif ($type eq 'fml')   { $type = 8; }
   83: 	elsif ($type eq 'subj')  { $type = 7; }
   84: 	elsif ($type eq 'float') { $type = 2; }
   85: 	elsif ($type eq 'int')   { $type = 1; }
   86: 	else { return "ERROR: Unknown type of answer: $type" }
   87:     }
   88: 
   89:     my $points;
   90:     my $id_list;
   91:     #formula type setup the sample points
   92:     if ($type eq '8') {
   93: 	($id_list,$points)=split(/@/,$samples);
   94: 	$message.="Found :$id_list:$points: points in $samples\n";
   95:     }
   96:     if ($tol eq '') {
   97: 	$tol=0.0;
   98: 	$tol_type=1; #TOL_ABSOLUTE
   99:     } else {
  100: 	if ($tol =~ /%$/) {
  101: 	    chop $tol;
  102: 	    $tol_type=2; #TOL_PERCENTAGE
  103: 	} else {
  104: 	    $tol_type=1; #TOL_ABSOLUTE
  105: 	}
  106:     }
  107: 
  108:     if ($sig eq '') {
  109: 	$sig_lbound = 0; #SIG_LB_DEFAULT
  110: 	$sig_ubound =15; #SIG_UB_DEFAULT
  111:     } else {
  112: 	($sig_lbound,$sig_ubound) = split /,/,$sig;
  113: 	if (!defined($sig_lbound)) {
  114: 	    $sig_lbound = 0; #SIG_LB_DEFAULT
  115: 	    $sig_ubound =15; #SIG_UB_DEFAULT
  116: 	}
  117: 	if (!defined($sig_ubound)) { $sig_ubound=$sig_lbound; }
  118:     }
  119:     my $reterror="";
  120:     my $result = &caparesponse_capa_check_answer($response,$answer,$type,
  121: 						 $tol_type,$tol,
  122: 						 $sig_lbound,$sig_ubound,
  123: 						 $ans_fmt,$unit,$calc,$id_list,
  124: 						 $points,$external::randomseed,
  125: 						 \$reterror);
  126: 
  127:     if    ($result == '1') { $result='EXACT_ANS'; } 
  128:     elsif ($result == '2') { $result='APPROX_ANS'; }
  129:     elsif ($result == '3') { $result='SIG_FAIL'; }
  130:     elsif ($result == '4') { $result='UNIT_FAIL'; }
  131:     elsif ($result == '5') { $result='NO_UNIT'; }
  132:     elsif ($result == '6') { $result='UNIT_OK'; }
  133:     elsif ($result == '7') { $result='INCORRECT'; }
  134:     elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
  135:     elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
  136:     elsif ($result =='10') { $result='SUB_RECORDED'; }
  137:     elsif ($result =='11') { $result='BAD_FORMULA'; }
  138:     elsif ($result =='12') { $result='WANTED_NUMERIC'; }
  139:     else  {$result = "ERROR: Unknown Result:$result:$@:";}
  140: 
  141:     return ("$result:\nRetError $reterror:\nError $error:\nAnswer $answer:\nResponse $response:\n type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|\n$message",$reterror);
  142: }
  143: 
  144: 
  145: sub caparesponse_check_list {
  146:     my $response=$LONCAPA::CAPAresponse_args{'response'};
  147:     my ($result,@list);
  148:     @list=@LONCAPA::CAPAresponse_answer;
  149:     my $aresult='';
  150:     my $current_answer;
  151:     my $answers=join(':',@list);
  152:     $result.="Got response :$answers:\n";
  153:     &LONCAPA_INTERNAL_DEBUG("<blink>Yo!</blink> got ".join(':',%LONCAPA::CAPAresponse_args));
  154:     my @responselist;
  155:     my $type = $LONCAPA::CAPAresponse_args{'type'};
  156:     $result.="Got type :$type:\n";
  157:     if ($type ne '' && $#list > 0) {
  158: 	(@responselist)=split /,/,$response;
  159:     } else {
  160: 	(@responselist)=($response);
  161:     }
  162:     my $unit='';
  163:     $result.="Initial final response :$responselist['-1']:\n";
  164:     if ($type eq '' || $type eq 'float') {
  165: 	#for numerical problems split off the unit
  166: 	if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
  167: 	    $responselist['-1']=$1;
  168: 	    $unit=$2;
  169: 	}
  170:     }
  171:     $result.="Final final response :$responselist['-1']:\n";
  172:     $result.=":$#list: answers\n";
  173:     $unit=~s/\s//;
  174:     my $i=0;
  175:     my $awards='';
  176:     my @msgs;
  177:     for ($i=0; $i<@list;$i++) {
  178: 	my $msg;
  179: 	$result.="trying answer :$list[$i]:\n";
  180: 	my $thisanswer=$list[$i];
  181: 	$result.="trying answer :$thisanswer:\n";
  182: 	if ($unit eq '') {
  183: 	    ($aresult,$msg)=&caparesponse_check($thisanswer,$responselist[$i]);
  184: 	} else {
  185: 	    ($aresult,$msg)=&caparesponse_check($thisanswer,
  186: 						$responselist[$i]." $unit");
  187: 	}
  188: 	my ($temp)=split /:/, $aresult;
  189: 	$awards.="$temp,";
  190: 	$result.=$aresult;
  191: 	push(@msgs,$msg);
  192:     }
  193:     chop $awards;
  194:     return ("$awards:\n$result",@msgs);
  195: }
  196: 
  197: sub tex {
  198:     if ( $external::target eq "tex" ) {
  199: 	return $_[0];
  200:     } else {
  201: 	return $_[1];
  202:     }
  203: }
  204: 
  205: sub var_in_tex {
  206:     if ( $external::target eq "tex" ) {
  207: 	return $_[0];
  208:     } else {
  209: 	return "";
  210:     }
  211: }
  212: 
  213: sub web {
  214:     if ( $external::target eq "tex" ) {
  215: 	return $_[1];
  216:     } else {
  217: 	if ( $external::target eq "web" || $external::target eq "answer") {
  218: 	    return $_[2];
  219: 	} else {
  220: 	    return $_[0];
  221: 	}
  222:     }
  223: }
  224: 
  225: sub html {
  226:     if ( $external::target eq "web" ) {
  227: 	return shift;
  228:     }
  229: }
  230: 
  231: sub hinton {
  232:     return 0;
  233: }
  234: 
  235: sub random {
  236:     my ($start,$end,$step)=@_;
  237:     if ( ! $hidden::RANDOMINIT ) {
  238: 	if ($external::randomseed == 0) { $external::randomseed=1; }
  239: 	if ($external::randomseed =~/,/) {
  240: 	    my ($num1,$num2)=split(/,/,$seed);
  241: 	    &random_set_seed(abs($num1),abs($num2));
  242: 	} else {
  243: 	    &random_set_seed(1,int(abs($external::randomseed)));
  244: 	}
  245: 	&math_random_uniform();
  246: 	$hidden::RANDOMINIT=1;
  247:     }
  248:     if (!defined($step)) { $step=1; }
  249:     my $num=1+int(($end-$start)/$step);
  250:     my $result=$start + int(&math_random_uniform() * $num)*$step;
  251:     return $result;
  252: }
  253: 
  254: sub random_normal {
  255:     my ($item_cnt,$seed,$av,$std_dev) = @_;
  256:     my @oldseed=&random_get_seed();
  257:     my @retArray;
  258:     &random_set_seed_from_phrase($seed);
  259:     @retArray=&math_random_normal($item_cnt,$av,$std_dev);
  260:     &random_set_seed(@oldseed);
  261:     return @retArray;
  262: }
  263: 
  264: sub random_beta {
  265:     my ($item_cnt,$seed,$aa,$bb) = @_;
  266:     my @oldseed=&random_get_seed();
  267:     my @retArray;
  268:     &random_set_seed_from_phrase($seed);
  269:     @retArray=&math_random_beta($item_cnt,$aa,$bb);
  270:     &random_set_seed(@oldseed);
  271:     return @retArray;
  272: }
  273: 
  274: sub random_gamma {
  275:     my ($item_cnt,$seed,$a,$r) = @_;
  276:     my @oldseed=&random_get_seed();
  277:     my @retArray;
  278:     &random_set_seed_from_phrase($seed);
  279:     @retArray=&math_random_gamma($item_cnt,$a,$r);
  280:     &random_set_seed(@oldseed);
  281:     return @retArray;
  282: }
  283: 
  284: sub random_exponential {
  285:     my ($item_cnt,$seed,$av) = @_;
  286:     my @oldseed=&random_get_seed();
  287:     my @retArray;
  288:     &random_set_seed_from_phrase($seed);
  289:     @retArray=&math_random_exponential($item_cnt,$av);
  290:     &random_set_seed(@oldseed);
  291:     return @retArray;
  292: }
  293: 
  294: sub random_poisson {
  295:     my ($item_cnt,$seed,$mu) = @_;
  296:     my @oldseed=&random_get_seed();
  297:     my @retArray;
  298:     &random_set_seed_from_phrase($seed);
  299:     @retArray=&math_random_poisson($item_cnt,$mu);
  300:     &random_set_seed(@oldseed);
  301:     return @retArray;
  302: }
  303: 
  304: sub random_chi {
  305:     my ($item_cnt,$seed,$df) = @_;
  306:     my @oldseed=&random_get_seed();
  307:     my @retArray;
  308:     &random_set_seed_from_phrase($seed);
  309:     @retArray=&math_random_chi_square($item_cnt,$df);
  310:     &random_set_seed(@oldseed);
  311:     return @retArray;
  312: }
  313: 
  314: sub random_noncentral_chi {
  315:     my ($item_cnt,$seed,$df,$nonc) = @_;
  316:     my @oldseed=&random_get_seed();
  317:     my @retArray;
  318:     &random_set_seed_from_phrase($seed);
  319:     @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
  320:     &random_set_seed(@oldseed);
  321:     return @retArray;
  322: }
  323: 
  324: sub random_f {
  325:     my ($item_cnt,$seed,$dfn,$dfd) = @_;
  326:     my @oldseed=&random_get_seed();
  327:     my @retArray;
  328:     &random_set_seed_from_phrase($seed);
  329:     @retArray=&math_random_f($item_cnt,$dfn,$dfd);
  330:     &random_set_seed(@oldseed);
  331:     return @retArray;
  332: }
  333: 
  334: sub random_noncentral_f {
  335:     my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
  336:     my @oldseed=&random_get_seed();
  337:     my @retArray;
  338:     &random_set_seed_from_phrase($seed);
  339:     @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
  340:     &random_set_seed(@oldseed);
  341:     return @retArray;
  342: }
  343: 
  344: sub random_multivariate_normal {
  345:     my ($item_cnt,$seed,$mean,$covar) = @_;
  346:     my @oldseed=&random_get_seed();
  347:     &random_set_seed_from_phrase($seed);
  348:     @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
  349:     &random_set_seed(@oldseed);
  350:     return @retArray;
  351: }
  352: 
  353: sub random_multinomial {
  354:     my ($item_cnt,$seed,@p) = @_;
  355:     my @oldseed=&random_get_seed();
  356:     my @retArray;
  357:     &random_set_seed_from_phrase($seed);
  358:     @retArray=&math_random_multinomial($item_cnt,@p);
  359:     &random_set_seed(@oldseed);
  360:     return @retArray;
  361: }
  362: 
  363: sub random_permutation {
  364:     my ($seed,@inArray) = @_;
  365:     my @oldseed=&random_get_seed();
  366:     my @retArray;
  367:     &random_set_seed_from_phrase($seed);
  368:     @retArray=&math_random_permutation(@inArray);
  369:     &random_set_seed(@oldseed);
  370:     return @retArray;
  371: }
  372: 
  373: sub random_uniform {
  374:     my ($item_cnt,$seed,$low,$high) = @_;
  375:     my @oldseed=&random_get_seed();
  376:     my @retArray;
  377:     &random_set_seed_from_phrase($seed);
  378:     @retArray=&math_random_uniform($item_cnt,$low,$high);
  379:     &random_set_seed(@oldseed);
  380:     return @retArray;
  381: }
  382: 
  383: sub random_uniform_integer {
  384:     my ($item_cnt,$seed,$low,$high) = @_;
  385:     my @oldseed=&random_get_seed();
  386:     my @retArray;
  387:     &random_set_seed_from_phrase($seed);
  388:     @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
  389:     &random_set_seed(@oldseed);
  390:     return @retArray;
  391: }
  392: 
  393: sub random_binomial {
  394:     my ($item_cnt,$seed,$nt,$p) = @_;
  395:     my @oldseed=&random_get_seed();
  396:     my @retArray;
  397:     &random_set_seed_from_phrase($seed);
  398:     @retArray=&math_random_binomial($item_cnt,$nt,$p);
  399:     &random_set_seed(@oldseed);
  400:     return @retArray;
  401: }
  402: 
  403: sub random_negative_binomial {
  404:     my ($item_cnt,$seed,$ne,$p) = @_;
  405:     my @oldseed=&random_get_seed();
  406:     my @retArray;
  407:     &random_set_seed_from_phrase($seed);
  408:     @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
  409:     &random_set_seed(@oldseed);
  410:     return @retArray;
  411: }
  412: 
  413: sub abs { abs(shift) }
  414: sub sin { sin(shift) }
  415: sub cos { cos(shift) }
  416: sub exp { exp(shift) }
  417: sub int { int(shift) }
  418: sub log { log(shift) }
  419: sub atan2 { atan2($_[0],$_[1]) }
  420: sub sqrt { sqrt(shift) }
  421: 
  422: sub tan  { CORE::sin($_[0]) / CORE::cos($_[0]) }
  423: #sub atan { atan2($_[0], 1); }
  424: #sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
  425: #sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }
  426: 
  427: sub log10 { CORE::log($_[0])/CORE::log(10); }
  428: 
  429: sub factorial {
  430:     my $input = CORE::int(shift);
  431:     return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
  432:     return "Error - factorial result is greater than system limit ($input)" if $input > 170;
  433:     return 1 if $input == 0;
  434:     my $result = 1; 
  435:     for (my $i=2; $i<=$input; $i++) { $result *= $i }
  436:     return $result;
  437: }
  438: 
  439: sub sgn {
  440:     return -1 if $_[0] < 0;
  441:     return 0 if $_[0] == 0;
  442:     return 1 if $_[0] > 0;
  443: }
  444: 
  445: sub min {
  446:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
  447:     return shift @sorted;
  448: }
  449: 
  450: sub max {
  451:     my @sorted = sort { $a <=> $b || $a cmp $b } @_;
  452:     return pop @sorted;
  453: }
  454: 
  455: sub roundto {
  456:     my ($input,$n) = @_;
  457:     return sprintf('%.'.$n.'f',$input);
  458: }
  459: 
  460: sub to_string {
  461:     my ($input,$n) = @_;
  462:     return sprintf($input) if $n eq "";
  463:     $n = '.'.$n if $n !~ /^\./;
  464:     return sprintf('%'.$n,$input) if $n ne "";
  465: }
  466: 
  467: sub sub_string {
  468:     my ($str,$start,$len) = @_;
  469:     return substr($str,$start-1,$len);
  470: }
  471: 
  472: sub pow   {return $_[0] ** $_[1]; }
  473: sub ceil  {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (CORE::int($_[0])+ 1) : CORE::int($_[0])); }
  474: sub floor  {return (($_[0]-CORE::int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? CORE::int($_[0]) : (CORE::int($_[0])-1)); }
  475: #sub floor {return int($_[0]); }
  476: 
  477: sub format {
  478:     my ($value,$fmt)=@_;
  479:     my $dollarmode;
  480:     if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 
  481:     $fmt=~s/e/E/g;
  482:     my $result=sprintf('%.'.$fmt,$value);
  483:     $result=~s/(E[+-]*)0/$1/;
  484:     if ($dollarmode) {$result=&dollarmode($result);}
  485:     return $result;
  486: }
  487: 
  488: sub prettyprint {
  489:     my ($value,$fmt,$target)=@_;
  490:     my $result;
  491:     my $dollarmode;
  492:     if (!$target) { $target = $external::target; }
  493:     if ($fmt =~ /^\$(.*)/) { $fmt=$1; $dollarmode=1; } 
  494:     if ($fmt) { $value=sprintf('%.'.$fmt,$value); }
  495:     if ($value =~ /([0-9\.\-\+]+)E([0-9\-\+]+)/i ) {
  496: 	my $frac=$1;
  497: 	if ($dollarmode) { $frac=&dollarformat($frac); }
  498: 	my $exponent=$2;
  499: 	$exponent=~s/^\+0*//;
  500: 	$exponent=~s/^-0*/-/;
  501: 	$exponent=~s/^-0*/-/;
  502: 	if ($exponent eq '-') { undef($exponent); }
  503: 	if ($exponent) {
  504: 	    if ($target eq 'web') {
  505: 		$result=$frac.'&#215;10<sup>'.$exponent.'</sup>';
  506: 	    } elsif ($target eq 'tex') {
  507: 		$result='\ensuremath{'.$frac.'\times 10^{'.$exponent.'}}';
  508: 	    } else {
  509: 		$result=$value;
  510: 	    }
  511: 	} else {
  512: 	    $result=$frac;
  513: 	}
  514:     } else {
  515: 	$result=$value;
  516: 	if ($dollarmode) { $result=&dollarformat($result,$target); }
  517:     }
  518:     return $result;
  519: }
  520: 
  521: sub dollarformat {
  522:     my ($number,$target) = @_;
  523:     if (!$target) { $target = $external::target; }
  524:     if ($number =~ /\./) {
  525: 	while ($number =~ /([^\.,]+)([^\.,][^\.,][^\.,])([,0-9]*\.[0-9]*)$/) {
  526: 	    $number = $1.','.$2.$3;
  527: 	}
  528:     } else {
  529: 	while ($number =~ /([^,]+)([^,][^,][^,])([,0-9]*)$/) {
  530: 	    $number = $1.','.$2.$3;
  531: 	}
  532:     }
  533:     if ($target eq 'tex') {
  534: 	$number='\$'.$number; #' stupid emacs
  535:     } else {
  536: 	$number='$'.$number; #' stupid emacs
  537:     }
  538:     return $number; 
  539: }
  540: 
  541: sub map {
  542:     my ($phrase,$dest,$source)=@_;
  543:     my @oldseed=&random_get_seed();
  544:     my @seed = &random_seed_from_phrase($phrase);
  545:     &random_set_seed(@seed);
  546:     my $destct = scalar(@$dest);
  547:     if (!$source) {
  548: 	my @output;
  549: 	my @idx = &math_random_permuted_index($destct);
  550: 	my $ctr = 0;
  551: 	while ($ctr < $destct) {
  552: 	    $output[$ctr] = $$dest[$idx[$ctr]];
  553: 	    $ctr++;
  554: 	}
  555:         &random_set_seed(@oldseed);
  556: 	return @output;
  557:     } else {
  558: 	my $num = scalar(@$source);
  559: 	my @idx = &math_random_permuted_index($num);
  560: 	my $ctr = 0;
  561: 	my $tot = $num;
  562: 	$tot = $destct if $destct < $num;
  563: 	if (ref($$dest[0])) {
  564: 	    while ($ctr < $tot) {
  565: 		${$$dest[$ctr]} = $$source[$idx[$ctr]];
  566: 	        $ctr++;
  567:             }
  568:         } else {
  569: 	    while ($ctr < $tot) {
  570: 		$$dest[$ctr] = $$source[$idx[$ctr]];
  571: 		$ctr++;
  572: 	    }
  573: 	}
  574:     }
  575:     &random_set_seed(@oldseed);
  576:     return '';
  577: }
  578: 
  579: sub rmap {
  580:     my ($phrase,$dest,$source)=@_;
  581:     my @oldseed=&random_get_seed();
  582:     my @seed = &random_seed_from_phrase($phrase);
  583:     &random_set_seed(@seed);
  584:     my $destct = scalar(@$dest);
  585:     if (!$source) {
  586: 	my @idx = &math_random_permuted_index($destct);
  587: 	my $ctr = 0;
  588: 	my @r_idx;
  589: 	while ($ctr < $destct) {
  590: 	    $r_idx[$idx[$ctr]] = $ctr;
  591: 	    $ctr++;
  592: 	}
  593: 	my @output;
  594: 	$ctr = 0;
  595: 	while ($ctr < $destct) {
  596: 	    $output[$ctr] = $$dest[$r_idx[$ctr]];
  597: 	    $ctr++;
  598: 	}
  599:         &random_set_seed(@oldseed);
  600: 	return @output;
  601:     } else {
  602: 	my $num = scalar(@$source);
  603: 	my @idx = &math_random_permuted_index($num);
  604: 	my $ctr = 0;
  605: 	my $tot = $num;
  606: 	$tot = $destct if $destct < $num;
  607: 	my @r_idx;
  608: 	while ($ctr < $tot) {
  609: 	    $r_idx[$idx[$ctr]] = $ctr;
  610: 	    $ctr++;
  611: 	}
  612: 	$ctr = 0;
  613: 	if (ref($$dest[0])) {
  614: 	    while ($ctr < $tot) {
  615: 		${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
  616: 	        $ctr++;
  617:             }
  618:         } else {
  619: 	    while ($ctr < $tot) {
  620: 		$$dest[$ctr] = $$source[$r_idx[$ctr]];
  621: 		$ctr++;
  622: 	    }
  623: 	}
  624:     }
  625:     &random_set_seed(@oldseed);
  626:     return '';
  627: }
  628: 
  629: sub capa_id { return }
  630: 
  631: sub problem { return }
  632: 
  633: sub name{
  634:     my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
  635:     $fullname = "" if $fullname eq ",  ";
  636:     $fullname =~ s/\%2d/-/g;
  637:     return $fullname;
  638: }
  639: 
  640: sub student_number { 
  641:     my $id = &EXT('environment.id');
  642:     $id = '' if $id eq "";
  643:     return $id;
  644: }
  645: 
  646: sub class {
  647:     my $course = &EXT('course.description');
  648:     $course = '' if $course eq "";
  649:     return $course;
  650: }
  651: 
  652: sub sec { 
  653:     my $sec = &EXT('request.course.sec');
  654:     $sec = '' if $sec eq "";
  655:     return $sec;
  656: }
  657: 
  658: sub open_date { 
  659:     my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
  660:     return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  661:     my @hm = split(/:/,$dc[3]);
  662:     my $ampm = " am";
  663:     if ($hm[0] > 12) {
  664: 	$hm[0]-=12;
  665: 	$ampm = " pm";
  666:     }
  667:     return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
  668: }
  669: 
  670: sub due_date { 
  671:     my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
  672:     return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  673:     my @hm = split(/:/,$dc[3]);
  674:     my $ampm = " am";
  675:     if ($hm[0] > 12) {
  676: 	$hm[0]-=12;
  677: 	$ampm = " pm";
  678:     }
  679:     return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
  680: }
  681: 
  682: sub answer_date { 
  683:     my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
  684:     return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  685:     my @hm = split(/:/,$dc[3]);
  686:     my $ampm = " am";
  687:     if ($hm[0] > 12) {
  688: 	$hm[0]-=12;
  689: 	$ampm = " pm";
  690:     }
  691:     return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
  692: }
  693: 
  694: sub array_moments {
  695:     my @input=@_;
  696:     my (@output,$N);
  697:     $N=scalar (@input);
  698:     $output[0]=$N;
  699:     if ($N <= 1) {
  700: 	$output[1]=$input[0];
  701: 	$output[1]="Input array not defined" if ($N == 0);
  702: 	$output[2]="variance undefined for N<=1";
  703: 	$output[3]="skewness undefined for N<=1";
  704: 	$output[4]="kurtosis undefined for N<=1";
  705: 	return @output;
  706:     }
  707:     my $sum=0;
  708:     foreach my $line (@input) {
  709: 	$sum+=$line;
  710:     }
  711:     $output[1] = $sum/$N;
  712:     my ($x,$sdev,$var,$skew,$kurt) = 0;
  713:     foreach my $line (@input) {
  714: 	$x=$line-$output[1];
  715: 	$var+=$x**2;
  716: 	$skew+=$x**3;
  717: 	$kurt+=$x**4;
  718:     }
  719:     $output[2]=$var/($N-1);
  720:     $sdev=CORE::sqrt($output[2]);
  721:     if ($sdev == 0) {
  722: 	$output[3]="inf-variance=0";
  723: 	$output[4]="inf-variance=0";
  724: 	return @output;
  725:     }
  726:     $output[3]=$skew/($sdev**3*$N);
  727:     $output[4]=$kurt/($sdev**4*$N)-3;
  728:     return @output;
  729: }
  730: 
  731: sub choose {
  732:     my $num = $_[0];
  733:     return $_[$num];
  734: }
  735: 
  736: # expiremental idea
  737: sub proper_path {
  738:     my ($path)=@_;
  739:     if ( $external::target eq "tex" ) {
  740: 	return '/home/httpd/html'.$path;
  741:     } else {
  742: 	return $path;
  743:     }
  744: }
  745: 

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