File:  [LON-CAPA] / loncom / homework / default_homework.lcpm
Revision 1.37: download - view: text, annotated - select for diffs
Mon Oct 1 20:15:30 2001 UTC (23 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: HEAD
- aded helper function, probably should only be used internally

# file name (temp): default_homework
# used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
#
# Guy Albertelli
#
# 05/25/2001 H. K. Ng
# 05/31/2001 H. K. Ng
#
#init some globals
$RANDOMINIT=0;
$pi=atan2(1,1)*4;
$rad2deg=180.0/$pi;
$deg2rad=$pi/180.0;

sub caparesponse_check {
  #not properly used yet: calc
  #not to be used: $ans_fmt
  my ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc) = 
	eval $_[1].';return ($answer,$type,$tol,$sig,$ans_fmt,$unit,$calc);';

  my $tol_type=''; # gets it's value from whether tol has a % or not done
  my $sig_lbound=''; #done
  my $sig_ubound=''; #done
  my ($response,$expr)=@_;


  #type's definitons come from capaParser.h
  my $message='';
  #remove leading and trailing whitespace
  if ($response=~ /^\s|\s$/) {
    $response=~ s:^\s+|\s+$::g;
    $message .="Removed ws now :$response:<br />";
  } else {
    $message .="no ws in :$response:<br />";
  }

  if ($type eq '' ) {
    $message .= "Didn't find a type :$type:$expr: defaulting<br />";
    if ( $answer eq ($answer *1.0)) { $type = 2;
    } else { $type = 3; }
  } else {
         if ($type eq 'cs')    { $type = 4;
    } elsif ($type eq 'ci')    { $type = 3;
    } elsif ($type eq 'mc')    { $type = 5;
    } elsif ($type eq 'fml')   { $type = 8;
    } elsif ($type eq 'subj')  { $type = 7;
    } else { return "ERROR: Unknown type of answer: $type" }
  }

  if ($tol eq '') {
    $tol=0.0;
    $tol_type=1; #TOL_ABSOLUTE
  } else {
    if ($tol =~ /%$/) {
      chop $tol;
      $tol_type=2; #TOL_PERCENTAGE
    } else {
      $tol_type=1; #TOL_ABSOLUTE
    }
  }

  if ($sig eq '') {
    $sig_lbound = 0; #SIG_LB_DEFAULT
    $sig_ubound =15; #SIG_UB_DEFAULT
  } else {
    ($sig_lbound,$sig_ubound) = split /,/,$sig;
  }
  my $result = &caparesponse_capa_check_answer($response,$answer,$type,
					       $tol_type,$tol,
					       $sig_lbound,$sig_ubound,
					       $ans_fmt,$unit,$calc);

  if    ($result == '1') { $result='EXACT_ANS'; } 
  elsif ($result == '2') { $result='APPROX_ANS'; }
  elsif ($result == '3') { $result='SIG_FAIL'; }
  elsif ($result == '4') { $result='UNIT_FAIL'; }
  elsif ($result == '5') { $result='NO_UNIT'; }
  elsif ($result == '6') { $result='UNIT_OK'; }
  elsif ($result == '7') { $result='INCORRECT'; }
  elsif ($result == '8') { $result='UNIT_NOTNEEDED'; }
  elsif ($result == '9') { $result='ANS_CNT_NOT_MATCH'; }
  elsif ($result =='10') { $result='SUB_RECORDED'; }
  elsif ($result =='11') { $result='BAD_FORMULA'; }
  elsif ($result =='12') { $result='WANTED_NUMERIC'; }
  else  {$result = "ERROR: Unknown Result:$result:$@:";}

  return "$result:<br />Error $error:<br />Answer $answer:<br />Response $response:<br /> type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|<br />$message$expr";
}

sub get_array_args {
  my ($expr,$arg)=@_;
  # do these first, because who knows what varname the instructor might have used
  # but it probably isn't $CAPARESPONSE_CHECK_LIST_answer
  my $CAPARESPONSE_CHECK_LIST_answer = eval $expr.';return $'.$arg; #'
  my (@list) = eval $CAPARESPONSE_CHECK_LIST_answer;
  my $result='';
  $result.="error:$@:<br />";
  # if the eval fails just use what is in the answer exactly
  if (!defined(@list) || !defined($list[0])) {
    $result.="list zero is undefined<br />";
    $list[0]=$CAPARESPONSE_CHECK_LIST_answer;
  }
  return @list;
}

sub caparesponse_check_list {
  my ($response,$expr)=@_;
  my (@list) = &get_array_args($expr,'answer');
  my $aresult='';
  my $current_answer;
  $result.="Got response :$CAPARESPONSE_CHECK_LIST_answer:$list[0]:<br />";
  my @responselist;
  my $type =eval $expr.';return $answer;';
  if ($type ne '' && $#list > 0) {
    (@responselist)=split /,/,$response;
  } else {
    (@responselist)=($response);
  }
  my $unit='';
  $result.="Initial final response :$responselist['-1']:<br />";
  if ($type eq '') {
    #for numerical problems split off the unit
    if ( $responselist['-1']=~ /(.*[^\s])\s+([^\s]+)/ ) {
      $responselist['-1']=$1;
      $unit=$2;
    }
  }
  $result.="Final final response :$responselist['-1']:<br />";
  $result.=":$#list: answers<br />";
  $unit=~s/\s//;
  my $i=0;
  my $awards='';
  for ($i=0; $i<@list;$i++) {
    $result.="trying answer :$list[$i]:<br />";
    if ($unit eq '') {
      $aresult=&caparesponse_check($responselist[$i],
			     $expr.';my $answer=\''.$list[$i].'\';');
    } else {
      $aresult=&caparesponse_check($responselist[$i]." $unit",
				   $expr.';my $answer=\''.$list[$i].'\';');
    }
    my ($temp)=split /:/, $aresult;
    $awards.="$temp,";
    $result.=$aresult;
  }
  chop $awards;
  return "$awards:<br />$result";
}

sub tex {
  if ( $external::target eq "tex" ) {
    return @_[0];
  } else {
    return @_[1];
  }
}

sub var_in_tex {
  if ( $external::target eq "tex" ) {
    return @_[0];
  } else {
    return "";
  }
}

sub web {
  if ( $external::target eq "tex" ) {
    return @_[1];
  } else {
    if ( $external::target eq "web") {
      return @_[2];
    } else {
      return @_[0];
    }
  }
}

sub html {
  if ( $external::target eq "web" ) {
    return shift;
  }
}

sub problem {
  return '1';
}

sub hinton {
  return 0;
}

sub random {
  my ($start,$end,$step)=@_;
  if ( ! $RANDOMINIT ) { srand($external::randomseed); $RANDOMINIT=1; }
  my $num=1+int(($end-$start)/$step);
  my $result=$start + int(rand() * $num)*$step;
  return $result;
}

sub random_normal {
  my ($item_cnt,$seed,$av,$std_dev) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_normal($item_cnt,$av,$std_dev);
  return @retArray;
}

sub random_beta {
  my ($item_cnt,$seed,$aa,$bb) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_beta($item_cnt,$aa,$bb);
  return @retArray;
}

sub random_gamma {
  my ($item_cnt,$seed,$a,$r) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_gamma($item_cnt,$a,$r);
  return @retArray;
}

sub random_exponential {
  my ($item_cnt,$seed,$av) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_exponential($item_cnt,$av);
  return @retArray;
}

sub random_poisson {
  my ($item_cnt,$seed,$mu) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_poisson($item_cnt,$mu);
  return @retArray;
}

sub random_chi {
  my ($item_cnt,$seed,$df) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_chi_square($item_cnt,$df);
  return @retArray;
}

sub random_noncentral_chi {
  my ($item_cnt,$seed,$df,$nonc) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_noncentral_chi_square($item_cnt,$df,$nonc);
  return @retArray;
}

sub random_f {
  my ($item_cnt,$seed,$dfn,$dfd) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_f($item_cnt,$dfn,$dfd);
  return @retArray;
}

sub random_noncentral_f {
  my ($item_cnt,$seed,$dfn,$dfd,$nonc) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_noncentral_f($item_cnt,$dfn,$dfd,$nonc);
  return @retArray;
}

sub random_multivariate_normal {
  my ($item_cnt,$seed,$mean,$covar) = @_;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_multivariate_normal($item_cnt,@$mean,@$covar);
  return @retArray;
}

sub random_multinomial {
  my ($item_cnt,$seed,@p) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_multinomial($item_cnt,@p);
  return @retArray;
}

sub random_permutation {
  my ($seed,@inArray) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_permutation(@inArray);
  return @retArray;
}

sub random_uniform {
  my ($item_cnt,$seed,$low,$high) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_uniform($item_cnt,$low,$high);
  return @retArray;
}

sub random_uniform_integer {
  my ($item_cnt,$seed,$low,$high) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_uniform_integer($item_cnt,$low,$high);
  return @retArray;
}

sub random_binomial {
  my ($item_cnt,$seed,$nt,$p) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_binomial($item_cnt,$nt,$p);
  return @retArray;
}

sub random_negative_binomial {
  my ($item_cnt,$seed,$ne,$p) = @_;
  my @retArray;
  &random_set_seed_from_phrase($seed);
  @retArray=&math_random_negative_binomial($item_cnt,$ne,$p);
  return @retArray;
}

sub abs { abs(shift) }
sub sin { sin(shift) }
sub cos { cos(shift) }
sub exp { exp(shift) }
sub int { int(shift) }
sub log { log(shift) }
sub atan2 { atan2($_[0],$_[1]) }
sub sqrt { sqrt(shift) }

sub tan  { sin($_[0]) / cos($_[0]) }
#sub atan { atan2($_[0], 1); }
#sub acos { atan2(sqrt(1 - $_[0] * $_[0]), $_[0] ); }
#sub asin { atan2($_[0], sqrt(1- $_[0] * $_[0]) );  }

sub log10 { log($_[0])/log(10); }

sub factorial {
    my $input = int(shift);
    return "Error - unable to take factorial of an negative number ($input)" if $input < 0;
    return "Error - factorial result is greater than system limit ($input)" if $input > 170;
    return 1 if $input == 0;
    my $result = 1; 
    for (my $i=2; $i<=$input; $i++) { $result *= $i }
    return $result;
}

sub sgn {
    return -1 if $_[0] < 0;
    return 0 if $_[0] == 0;
    return 1 if $_[0] > 0;
}

sub min {
    my @sorted = sort { $a <=> $b || $a cmp $b } @_;
    return shift @sorted;
}

sub max {
    my @sorted = sort { $a <=> $b || $a cmp $b } @_;
    return pop @sorted;
}

sub roundto {
    my ($input,$n) = @_;
    return sprintf('%.'.$n.'f',$input);
}

sub to_string {
    my ($input,$n) = @_;
    return sprintf($input) if $n eq "";
    $n = '.'.$n if $n !~ /^\./;
    return sprintf('%'.$n,$input) if $n ne "";
}

sub sub_string {
    my ($str,$start,$len) = @_;
    return substr($str,$start-1,$len);
}

sub pow   {return $_[0] ** $_[1]; }
sub ceil  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? (int($_[0])+ 1) : int($_[0])); }
sub floor  {return (($_[0]-int($_[0]))== 0.0) ? $_[0] : (($_[0] > 0) ? int($_[0]) : (int($_[0])-1)); }
#sub floor {return int($_[0]); }

sub format {
  my ($value,$fmt)=@_;
  return sprintf('%.'.$fmt,$value);
}

sub map {
    my ($phrase,$dest,$source)=@_;
    my @seed = &random_seed_from_phrase($phrase);
    &random_set_seed(@seed);
    my $destct = scalar(@$dest);
    if (!$source) {
	my @output;
	my @idx = &math_random_permuted_index($destct);
	my $ctr = 0;
	while ($ctr < $destct) {
	    $output[$ctr] = $$dest[$idx[$ctr]];
	    $ctr++;
	}
	return @output;
    } else {
	my $num = scalar(@$source);
	my @idx = &math_random_permuted_index($num);
	my $ctr = 0;
	my $tot = $num;
	$tot = $destct if $destct < $num;
	if (ref($$dest[0])) {
	    while ($ctr < $tot) {
		${$$dest[$ctr]} = $$source[$idx[$ctr]];
	        $ctr++;
            }
        } else {
	    while ($ctr < $tot) {
		$$dest[$ctr] = $$source[$idx[$ctr]];
		$ctr++;
	    }
	}
    }
}

sub rmap {
    my ($phrase,$dest,$source)=@_;
    my @seed = &random_seed_from_phrase($phrase);
    &random_set_seed(@seed);
    my $destct = scalar(@$dest);
    if (!$source) {
	my @idx = &math_random_permuted_index($destct);
	my $ctr = 0;
	my @r_idx;
	while ($ctr < $destct) {
	    $r_idx[$idx[$ctr]] = $ctr;
	    $ctr++;
	}
	my @output;
	$ctr = 0;
	while ($ctr < $destct) {
	    $output[$ctr] = $$dest[$r_idx[$ctr]];
	    $ctr++;
	}
	return @output;
    } else {
	my $num = scalar(@$source);
	my @idx = &math_random_permuted_index($num);
	my $ctr = 0;
	my $tot = $num;
	$tot = $destct if $destct < $num;
	my @r_idx;
	while ($ctr < $tot) {
	    $r_idx[$idx[$ctr]] = $ctr;
	    $ctr++;
	}
	$ctr = 0;
	if (ref($$dest[0])) {
	    while ($ctr < $tot) {
		${$$dest[$ctr]} = $$source[$r_idx[$ctr]];
	        $ctr++;
            }
        } else {
	    while ($ctr < $tot) {
		$$dest[$ctr] = $$source[$r_idx[$ctr]];
		$ctr++;
	    }
	}
    }
}

sub capa_id { return }

sub problem { return }

sub name{
  my $fullname = &EXT('environment.lastname').', '.&EXT('environment.firstname').' '.&EXT('environment.middlename');
  $fullname = "" if $fullname eq ",  ";
  $fullname =~ s/\%2d/-/g;
  return $fullname;
}

sub student_number { 
  my $id = &EXT('environment.id');
  $id = '' if $id eq "";
  return $id;
}

sub class {
  my $course = &EXT('course.description');
  $course = '' if $course eq "";
  return $course;
}

sub sec { 
  my $sec = &EXT('request.course.sec');
  $sec = '' if $sec eq "";
  return $sec;
}

sub open_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.opendate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
}

sub due_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.duedate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
#  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
}

sub answer_date { 
  my @dc = split(/\s+/,localtime(&EXT('resource.0.answerdate')));
  return '' if ($dc[0] eq "Wed" and $dc[2] == 31 and $dc[4] == 1969);
  my @hm = split(/:/,$dc[3]);
  my $ampm = " am";
  if ($hm[0] > 12) {
    $hm[0]-=12;
    $ampm = " pm";
  }
  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$hm[0].':'.$hm[1].$ampm;
#  return $dc[0].', '.$dc[1].' '.$dc[2].', '.$dc[4].' at '.$dc[3];
}

sub array_moments {
  my @input=@_;
  my (@output,$N);
  $N=scalar (@input);
  $output[0]=$N;
  if ($N <= 1) {
    $output[1]=$input[0];
    $output[1]="Input array not defined" if ($N == 0);
    $output[2]="variance undefined for N<=1";
    $output[3]="skewness undefined for N<=1";
    $output[4]="kurtosis undefined for N<=1";
    return @output;
  }
  my $sum=0;
  foreach my $line (@input) {
    $sum+=$line;
  }
  $output[1] = $sum/$N;
  my ($x,$sdev,$var,$skew,$kurt) = 0;
  foreach my $line (@input) {
    $x=$line-$output[1];
    $var+=$x**2;
    $skew+=$x**3;
    $kurt+=$x**4;
  }
  $output[2]=$var/($N-1);
  $sdev=sqrt($output[2]);
  if ($sdev == 0) {
     $output[3]="inf-variance=0";
     $output[4]="inf-variance=0";
     return @output;
  }
  $output[3]=$skew/($sdev**3*$N);
  $output[4]=$kurt/($sdev**4*$N)-3;
  return @output;
}

sub choose {
  my $num = $_[0];
  return $_[$num];
}



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