[system] / trunk / pg / lib / Value / AnswerChecker.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/Value/AnswerChecker.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 4822 Revision 4823
1449 return unless $formulas->{show}; 1449 return unless $formulas->{show};
1450 1450
1451 my $output = ""; 1451 my $output = "";
1452 if ($isEvaluator) { 1452 if ($isEvaluator) {
1453 # 1453 #
1454 # The tests to be performed with the answer checker is created 1454 # The tests to be performed when the answer checker is created
1455 # 1455 #
1456 $self->getPG('loadMacros("PGgraphmacros.pl")'); 1456 $self->getPG('loadMacros("PGgraphmacros.pl")');
1457 my ($inputs) = $self->getPG('$inputs_ref'); 1457 my ($inputs) = $self->getPG('$inputs_ref');
1458 my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers}; 1458 my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers};
1459 if ($formulas->{checkNumericStability} && !$process) { 1459 if ($formulas->{checkNumericStability} && !$process) {
1469 # 1469 #
1470 my @names = $self->{context}->variables->names; 1470 my @names = $self->{context}->variables->names;
1471 my $vx = (keys(%{$self->{variables}}))[0]; 1471 my $vx = (keys(%{$self->{variables}}))[0];
1472 my $vi = 0; while ($names[$vi] ne $vx) {$vi++} 1472 my $vi = 0; while ($names[$vi] ne $vx) {$vi++}
1473 my $points = [map {$_->[$vi]} @{$self->{test_points}}]; 1473 my $points = [map {$_->[$vi]} @{$self->{test_points}}];
1474 my @params = $self->{context}->variables->parameters;
1475 @names = $self->{context}->variables->variables;
1474 1476
1475 # 1477 #
1476 # The graphs of the functions and errors 1478 # The graphs of the functions and errors
1477 # 1479 #
1478 if ($formulas->{showGraphs}) { 1480 if ($formulas->{showGraphs}) {
1497 title=>'Relative Error',points=>$points)); 1499 title=>'Relative Error',points=>$points));
1498 } 1500 }
1499 $output .= '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">' 1501 $output .= '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0">'
1500 . '<TR VALIGN="TOP">'.join('<TD WIDTH="20"></TD>',@G).'</TR></TABLE>'; 1502 . '<TR VALIGN="TOP">'.join('<TD WIDTH="20"></TD>',@G).'</TR></TABLE>';
1501 } 1503 }
1504
1502 1505 #
1506 # The adaptive parameters
1507 #
1508 if ($formulas->{showParameters}) {
1509 $output .= '<HR><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0"><TR><TD>Adaptive Parameters:<BR>';
1510 $output .= join("<BR>",map {"&nbsp;&nbsp;$params[$_]: ".$self->{parameters}[$_]} (0..$#params));
1511 $output .= '</TD></TR></TABLE>';
1512 }
1513
1503 # 1514 #
1504 # The test points and values 1515 # The test points and values
1505 # 1516 #
1506 my @rows = (); my $colsep = '</TD><TD WIDTH="20"></TD><TD ALIGN="RIGHT">'; 1517 my @rows = (); my $colsep = '</TD><TD WIDTH="20"></TD><TD ALIGN="RIGHT">';
1507 my @P = (map {(scalar(@{$_}) == 1)? $_->[0]: Value::Point->make(@{$_})} @{$self->{test_points}}); 1518 my @P = (map {(scalar(@{$_}) == 1)? $_->[0]: Value::Point->make(@{$_})} @{$self->{test_points}});
1508 my @i = sort {$P[$a] <=> $P[$b]} (0..$#P); 1519 my @i = sort {$P[$a] <=> $P[$b]} (0..$#P);
1509 foreach $p (@P) {if (Value::isValue($p) && $p->length > 2) {$p = $p->string; $p =~ s|,|,<br />|g}} 1520 foreach $p (@P) {if (Value::isValue($p) && $p->length > 2) {$p = $p->string; $p =~ s|,|,<br />|g}}
1510 my $zeroLevelTol = $self->getFlag('zeroLevelTol'); 1521 my $zeroLevelTol = $self->getFlag('zeroLevelTol');
1511 $self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below 1522 $self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below
1512 my $names = join(',',@names); $names = '('.$names.')' if scalar(@names) > 1; 1523 my $names = join(',',@names); $names = '('.$names.')' if scalar(@names) > 1;
1524
1525 $student->createPointValues($self->{test_points},0,1,1) unless $student->{test_values};
1526
1527 my $cv = $self->{test_values};
1528 my $sv = $student->{test_values};
1529 my $av = $self->{test_adapt} || $lv;
1530
1513 if ($formulas->{showTestPoints}) { 1531 if ($formulas->{showTestPoints}) {
1514 $student->createPointValues($self->{test_points},0,1,1) unless $student->{test_values};
1515 my @p = ("$names:", (map {$P[$i[$_]]} (0..$#P))); 1532 my @p = ("$names:", (map {$P[$i[$_]]} (0..$#P)));
1516 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>'); 1533 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,@p).'</TD></TR>');
1517 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,("<HR>")x scalar(@p)).'</TD></TR>'); 1534 push(@rows,'<TR><TD ALIGN="RIGHT">'.join($colsep,("<HR>")x scalar(@p)).'</TD></TR>');
1518 push(@rows,'<TR><TD ALIGN="RIGHT">' 1535 push(@rows,'<TR><TD ALIGN="RIGHT">'
1519 .join($colsep,"Correct Answer:", 1536 .join($colsep,($av == $cv)? "Correct Answer:" : "Adapted Answer:",
1520 map {Value::isNumber($self->{test_values}[$i[$_]])? $self->{test_values}[$i[$_]]: "undefined"} (0..$#P)) 1537 map {Value::isNumber($av->[$i[$_]])? $av->[$i[$_]]: "undefined"} (0..$#P))
1521 .'</TD></TR>'); 1538 .'</TD></TR>');
1522 my $test = $student->{test_values};
1523 push(@rows,'<TR><TD ALIGN="RIGHT">' 1539 push(@rows,'<TR><TD ALIGN="RIGHT">'
1524 .join($colsep,"Student Answer:", 1540 .join($colsep,"Student Answer:",
1525 map {Value::isNumber($test->[$i[$_]])? $test->[$i[$_]]: "undefined"} (0..$#P)) 1541 map {Value::isNumber($sv->[$i[$_]])? $sv->[$i[$_]]: "undefined"} (0..$#P))
1526 .'</TD></TR>'); 1542 .'</TD></TR>');
1527 } 1543 }
1528 # 1544 #
1529 # The absolute errors (colored by whether they are ok or too big) 1545 # The absolute errors (colored by whether they are ok or too big)
1530 # 1546 #
1531 if ($formulas->{showAbsoluteErrors}) { 1547 if ($formulas->{showAbsoluteErrors}) {
1532 my @p = ("Absolute Error:"); 1548 my @p = ("Absolute Error:");
1533 my $tolerance = $self->getFlag('tolerance'); 1549 my $tolerance = $self->getFlag('tolerance');
1534 my $tolType = $self->getFlag('tolType'); my $error; 1550 my $tolType = $self->getFlag('tolType'); my $error;
1535 foreach my $j (0..$#P) { 1551 foreach my $j (0..$#P) {
1536 if (Value::isNumber($student->{test_values}[$i[$j]])) { 1552 if (Value::isNumber($sv->[$i[$j]])) {
1537 $error = abs($self->{test_values}[$i[$j]]-$student->{test_values}[$i[$j]]); 1553 $error = abs($av->[$i[$j]] - $sv->[$i[$j]]);
1538 $error = '<SPAN STYLE="color:#'.($error->value<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>' 1554 $error = '<SPAN STYLE="color:#'.($error->value<$tolerance ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1539 if $tolType eq 'absolute'; 1555 if $tolType eq 'absolute';
1540 } else {$error = "---"} 1556 } else {$error = "---"}
1541 push(@p,$error); 1557 push(@p,$error);
1542 } 1558 }
1549 my @p = ("Relative Error:"); 1565 my @p = ("Relative Error:");
1550 my $tolerance = $self->getFlag('tolerance'); my $tol; 1566 my $tolerance = $self->getFlag('tolerance'); my $tol;
1551 my $tolType = $self->getFlag('tolType'); my $error; 1567 my $tolType = $self->getFlag('tolType'); my $error;
1552 my $zeroLevel = $self->getFlag('zeroLevel'); 1568 my $zeroLevel = $self->getFlag('zeroLevel');
1553 foreach my $j (0..$#P) { 1569 foreach my $j (0..$#P) {
1554 if (Value::isNumber($student->{test_values}[$i[$j]])) { 1570 if (Value::isNumber($sv->[$i[$j]])) {
1555 my $c = $self->{test_values}[$i[$j]]; my $s = $student->{test_values}[$i[$j]]; 1571 my $c = $av->[$i[$j]]; my $s = $sv->[$i[$j]];
1556 if (abs($c->value) < $zeroLevel || abs($s->value) < $zeroLevel) 1572 if (abs($cv->[$i[$j]]->value) < $zeroLevel || abs($s->value) < $zeroLevel)
1557 {$error = abs($c-$s); $tol = $zeroLevelTol} else 1573 {$error = abs($c-$s); $tol = $zeroLevelTol} else
1558 {$error = abs(($c-$s)/($c||1E-10)); $tol = $tolerance} 1574 {$error = abs(($c-$s)/($c||1E-10)); $tol = $tolerance}
1559 $error = '<SPAN STYLE="color:#'.($error < $tol ? '00AA00': 'AA0000').'">'.$error.'</SPAN>' 1575 $error = '<SPAN STYLE="color:#'.($error < $tol ? '00AA00': 'AA0000').'">'.$error.'</SPAN>'
1560 if $tolType eq 'relative'; 1576 if $tolType eq 'relative';
1561 } else {$error = "---"} 1577 } else {$error = "---"}
1601 my $steps = $graphs->{divisions}; 1617 my $steps = $graphs->{divisions};
1602 my $points = $options{points}; my $clip = $options{clip}; 1618 my $points = $options{points}; my $clip = $options{clip};
1603 my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits}; 1619 my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits};
1604 my $dx = ($Mx-$mx)/$steps; my $f; my $y; 1620 my $dx = ($Mx-$mx)/$steps; my $f; my $y;
1605 1621
1622 my @pnames = $self->{context}->variables->parameters;
1623 my @pvalues = ($self->{parameters} ? @{$self->{parameters}} : (0) x scalar(@pnames));
1624 my $x = "";
1625
1606 # 1626 #
1607 # Find the max and min values of the function 1627 # Find the max and min values of the function
1608 # 1628 #
1609 foreach $f ($F1,$F2) { 1629 foreach $f ($F1,$F2) {
1610 next unless defined($f); 1630 next unless defined($f);
1611 unless (scalar(keys(%{$f->{variables}})) < 2) { 1631 foreach my $v (keys(%{$f->{variables}})) {
1632 if ($v ne $x && !$f->{context}->variables->get($v)->{parameter}) {
1633 if ($x) {
1612 warn "Only formulas with one variable can be graphed"; 1634 warn "Only formulas with one variable can be graphed" unless $self->{graphWarning};
1635 $self->{graphWarning} = 1;
1636 return "";
1637 }
1638 $x = $v;
1639 }
1640 }
1641 unless ($f->typeRef->{length} == 1) {
1642 warn "Only real-valued functions can be graphed" unless $self->{graphWarning};
1643 $self->{graphWarning} = 1;
1613 return ""; 1644 return "";
1614 } 1645 }
1615 unless ($f->typeRef->{length} == 1) { 1646 unless ($f->typeRef->{length} == 1) {
1616 warn "Only real-valued functions can be graphed"; 1647 warn "Only real-valued functions can be graphed";
1617 return ""; 1648 return "";
1618 } 1649 }
1619 if ($f->isConstant) { 1650 if ($f->isConstant) {
1620 $y = $f->eval; 1651 $y = $f->eval;
1621 $my = $y if $y < $my; $My = $y if $y > $My; 1652 $my = $y if $y < $my; $My = $y if $y > $My;
1622 } else { 1653 } else {
1623 my $F = $f->perlFunction; 1654 my $F = $f->perlFunction(undef,[$x,@pnames]);
1624 foreach my $i (0..$steps-1) { 1655 foreach my $i (0..$steps-1) {
1625 $y = eval {&{$F}($mx+$i*$dx)}; next unless defined($y) && Value::isNumber($y); 1656 $y = eval {&{$F}($mx+$i*$dx,@pvalues)};
1657 next unless defined($y) && Value::isNumber($y);
1626 $my = $y if $y < $my; $My = $y if $y > $My; 1658 $my = $y if $y < $my; $My = $y if $y > $My;
1627 } 1659 }
1628 } 1660 }
1629 } 1661 }
1630 $My = 1 if abs($My - $my) < 1E-5; 1662 $My = 1 if abs($My - $my) < 1E-5;
1644 $mx,$my,$Mx,$My, 1676 $mx,$my,$Mx,$My,
1645 axes => $graphs->{axes}, 1677 axes => $graphs->{axes},
1646 grid => $graphs->{grid}, 1678 grid => $graphs->{grid},
1647 size => $size, 1679 size => $size,
1648 ]; 1680 ];
1681 $grf->{params} = {
1682 names => [$x,@pnames],
1683 values => {map {$pnames[$_] => $pvalues[$_]} (0..scalar(@pnames)-1)},
1684 };
1649 $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})'); 1685 $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})');
1650 $grf->{G}->imageName($grf->{G}->imageName.'-'.time()); # avoid browser cache 1686 $grf->{G}->imageName($grf->{G}->imageName.'-'.time()); # avoid browser cache
1651 $self->cmp_graph_function($grf,$F2,"green",$steps,$points) if defined($F2); 1687 $self->cmp_graph_function($grf,$F2,"green",$steps,$points) if defined($F2);
1652 $self->cmp_graph_function($grf,$F1,"red",$steps,$points); 1688 $self->cmp_graph_function($grf,$F1,"red",$steps,$points);
1653 my $image = $self->getPG('alias(insertGraph($_grf_->{G}))'); 1689 my $image = $self->getPG('alias(insertGraph($_grf_->{G}))');
1668 $grf->{n}++; my $Fn = "F".$grf->{n}; $grf->{$Fn} = $F; my $f; 1704 $grf->{n}++; my $Fn = "F".$grf->{n}; $grf->{$Fn} = $F; my $f;
1669 if ($F->isConstant) { 1705 if ($F->isConstant) {
1670 my $y = $F->eval; 1706 my $y = $F->eval;
1671 $f = $self->getPG('new Fun(sub {'.$y.'},$_grf_->{G})'); 1707 $f = $self->getPG('new Fun(sub {'.$y.'},$_grf_->{G})');
1672 } else { 1708 } else {
1673 my $X = (keys %{$F->{variables}})[0]; 1709 my $X = $grf->{params}{names}[0];
1674 $f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{'.$Fn.'},'.$X.'=>shift)},$_grf_->{G})'); 1710 $f = $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{'.$Fn.'},'
1711 .$X.'=>shift,%{$_grf_->{params}{values}})},$_grf_->{G})');
1675 foreach my $x (@{$points}) { 1712 foreach my $x (@{$points}) {
1676 my $y = Parser::Evaluate($F,($X)=>$x); next unless defined($y) && Value::isNumber($y); 1713 my $y = Parser::Evaluate($F,($X)=>$x,%{$grf->{params}{values}});
1714 next unless defined($y) && Value::isNumber($y);
1677 $grf->{x} = $x; $grf->{y} = $y; 1715 $grf->{x} = $x; $grf->{y} = $y;
1678 my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"'.$color.'","'.$color.'")'); 1716 my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"'.$color.'","'.$color.'")');
1679 $grf->{G}->stamps($C); 1717 $grf->{G}->stamps($C);
1680 } 1718 }
1681 } 1719 }

Legend:
Removed from v.4822  
changed lines
  Added in v.4823

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9