diff --git a/lib/Value/AnswerChecker.pm b/lib/Value/AnswerChecker.pm index 3ed4f18535..46a3fa57ea 100644 --- a/lib/Value/AnswerChecker.pm +++ b/lib/Value/AnswerChecker.pm @@ -2050,48 +2050,44 @@ sub cmp_postprocess { $self->cmp_Error($ans, "The dimension of your result is incorrect"); } -# -# Diagnostics for Formulas -# +# Diagnostics for Formulas. sub cmp_diagnostics { - my $self = shift; - my $ans = shift; - my $isEvaluator = (ref($ans) =~ /Evaluator/) ? 1 : 0; - my $hash = $isEvaluator ? $ans->rh_ans : $ans; - my $diagnostics = $self->{context}->diagnostics->merge("formulas", $self, $hash); + my ($self, $ans) = @_; + my $isEvaluator = ref($ans) =~ /Evaluator/ ? 1 : 0; + my $hash = $isEvaluator ? $ans->rh_ans : $ans; + my $diagnostics = $self->{context}->diagnostics->merge('formulas', $self, $hash); my $formulas = $diagnostics->{formulas}; return unless $formulas->{show}; - my $output = ""; + my $output = ''; if ($isEvaluator) { - # - # The tests to be performed when the answer checker is created - # - $self->getPG('loadMacros("PGgraphmacros.pl")'); + # The tests to be performed when the answer checker is created. + $self->getPG('loadMacros("plots.pl")'); my ($inputs) = $self->getPG('$inputs_ref'); my $process = $inputs->{checkAnswers} || $inputs->{previewAnswers} || $inputs->{submitAnswers}; if ($formulas->{checkNumericStability} && !$process) { - ### still needs to be written + ### Still needs to be written. } } else { - # - # The checks to be performed when an answer is submitted - # + # The checks to be performed when an answer is submitted. my $student = $ans->{student_formula}; - # - # Get the test points - # - my @names = $self->{context}->variables->names; - my $vx = (keys(%{ $self->{variables} }))[0]; - my $vi = 0; - while ($names[$vi] ne $vx) { $vi++ } - my $points = [ map { $_->[$vi] } @{ $self->{test_points} } ]; - my @params = $self->{context}->variables->parameters; - @names = $self->{context}->variables->variables; - # - # The graphs of the functions and errors - # + # Get the test points. This requires first determining what variables are in use and ignore parameters. + my $points = []; + my @params = $self->{context}->variables->parameters; + my %pnames = map { $_ => 1 } @params; + my @names = $self->{context}->variables->variables; + my @variables = grep { !$pnames{$_} } keys %{ $self->{variables} }; + + # If a single variable is found, use its test points for the graph. + # Functions with more than one variable are not graphed so test points are not needed. + if (scalar(@variables) == 1) { + my $vi = 0; + while ($names[$vi] ne $variables[0]) { $vi++ } + $points = [ map { $_->[$vi] } @{ $self->{test_points} } ]; + } + + # The graphs of the functions and errors. if ($formulas->{showGraphs}) { my @G = (); if ($formulas->{combineGraphs}) { @@ -2099,7 +2095,7 @@ sub cmp_diagnostics { @G, $self->cmp_graph( $diagnostics, [ $student, $self ], - title => 'Student Answer (red)
Correct Answer (green)
', + title => 'Student Answer (red)
Correct Answer (green)', points => $points, showDomain => 1 ) @@ -2131,157 +2127,152 @@ sub cmp_diagnostics { ) ); } - $output .= - '' - . '' - . join('', @G) - . '
'; + $output .= join('', @G); } - # - # The adaptive parameters - # + # The adaptive parameters. if ($formulas->{showParameters} && scalar(@params) > 0) { - $output .= '
Adaptive Parameters:
'; - $output .= join("
", map { "  $params[$_]: " . $self->{parameters}[$_] } (0 .. $#params)); - $output .= '
'; + $output .= + '
Adaptive Parameters
' + . join("
", map { "  $params[$_]: " . $self->{parameters}[$_] } 0 .. $#params) + . '
'; } - # - # The test points and values - # - my @rows = (); - my $colsep = ''; + # The test points and values. + my @rows = (); my @P = (map { (scalar(@{$_}) == 1) ? $_->[0] : $self->Package("Point")->make(@{$_}) } @{ $self->{test_points} }); - my @i = sort { $P[$a] <=> $P[$b] } (0 .. $#P); - foreach $p (@P) { - if (Value::isValue($p) && $p->length > 2) { $p = $p->string; $p =~ s|,|,
|g } - } - my $zeroLevelTol = $self->{context}{flags}{zeroLevelTol}; - $self->{context}{flags}{zeroLevelTol} = 0; # always show full resolution in the tables below - my $names = join(',', @names); - $names = '(' . $names . ')' if scalar(@names) > 1; - - $student->createPointValues($self->{test_points}, 0, 1, 1) unless $student->{test_values}; - - my $cv = $self->{test_values}; - my $sv = $student->{test_values}; - my $av = $self->{test_adapt} || $cv; - - if ($formulas->{showTestPoints}) { - my @p = ("$names:", (map { $P[ $i[$_] ] } (0 .. $#P))); - push(@rows, '' . join($colsep, @p) . ''); - push(@rows, '' . join($colsep, ("
") x scalar(@p)) . ''); - push( - @rows, - '' - . join($colsep, - ($av == $cv) ? "Correct Answer:" : "Adapted Answer:", - map { Value::isNumber($av->[ $i[$_] ]) ? $av->[ $i[$_] ] : "undefined" } (0 .. $#P)) - . '' - ); - push( - @rows, - '' - . join($colsep, - "Student Answer:", - map { Value::isNumber($sv->[ $i[$_] ]) ? $sv->[ $i[$_] ] : "undefined" } (0 .. $#P)) - . '' - ); - } - # - # The absolute errors (colored by whether they are ok or too big) - # - if ($formulas->{showAbsoluteErrors}) { - my @p = ("Absolute Error:"); - my $tolerance = $self->getFlag('tolerance'); - my $tolType = $self->getFlag('tolType'); - my $error; - foreach my $j (0 .. $#P) { - if (Value::isNumber($sv->[ $i[$j] ])) { - $error = CORE::abs($av->[ $i[$j] ] - $sv->[ $i[$j] ]); - $error = - '' - . $error - . '' - if $tolType eq 'absolute'; - } else { - $error = "---"; + if (@P) { + my @i = sort { $P[$a] <=> $P[$b] } 0 .. $#P; + my @points = ([] x scalar(@names)); + for my $p (@P) { + my @pt = Value::isValue($p) ? $p->value : ($p); + for (0 .. $#pt) { + push(@{ $points[$_] }, $pt[$_]); } - push(@p, $error); } - push(@rows, '' . join($colsep, @p) . ''); - } - # - # The relative errors (colored by whether they are OK or too big) - # - if ($formulas->{showRelativeErrors}) { - my @p = ("Relative Error:"); - my $tolerance = $self->getFlag('tolerance'); - my $tol; - my $tolType = $self->getFlag('tolType'); - my $error; - my $zeroLevel = $self->getFlag('zeroLevel'); - foreach my $j (0 .. $#P) { - if (Value::isNumber($sv->[ $i[$j] ])) { - my $c = $av->[ $i[$j] ]; - my $s = $sv->[ $i[$j] ]; - if (CORE::abs($cv->[ $i[$j] ]->value) < $zeroLevel || CORE::abs($s->value) < $zeroLevel) { - $error = CORE::abs($c - $s); - $tol = $zeroLevelTol; + my $zeroLevelTol = $self->{context}{flags}{zeroLevelTol}; + $self->{context}{flags}{zeroLevelTol} = 0; # Always show full resolution in the tables below. + + $student->createPointValues($self->{test_points}, 0, 1, 1) unless $student->{test_values}; + + my $cv = $self->{test_values}; + my $sv = $student->{test_values}; + my $av = $self->{test_adapt} || $cv; + + if ($formulas->{showTestPoints}) { + for my $k (0 .. $#names) { + # Only show variables that are used in either answer or student formula. + push(@rows, [ $names[$k], map { $points[$k][ $i[$_] ] } 0 .. $#P ]) + if $self->{variables}{ $names[$k] } || $student->{variables}{ $names[$k] }; + } + push( + @rows, + [ + $av == $cv ? 'Correct Answer' : 'Adapted Answer', + map { Value::isNumber($av->[ $i[$_] ]) ? $av->[ $i[$_] ] : 'undefined' } 0 .. $#P + ] + ); + push( + @rows, + [ + 'Student Answer', + map { Value::isNumber($sv->[ $i[$_] ]) ? $sv->[ $i[$_] ] : 'undefined' } 0 .. $#P + ] + ); + } + + # The absolute errors (colored by whether they are OK or too big). + if ($formulas->{showAbsoluteErrors}) { + my @p = (); + my $tolerance = $self->getFlag('tolerance'); + my $tolType = $self->getFlag('tolType'); + my $error; + for my $j (0 .. $#P) { + if (Value::isNumber($sv->[ $i[$j] ])) { + $error = CORE::abs($av->[ $i[$j] ] - $sv->[ $i[$j] ]); + $error = + '' + . $error + . '' + if $tolType eq 'absolute'; } else { - $error = CORE::abs(($c - $s) / ($c || 1E-10)); - $tol = $tolerance; + $error = "---"; } - $error = '' . $error . '' - if $tolType eq 'relative'; - } else { - $error = "---"; + push(@p, "$error"); + } + push(@rows, [ 'Absolute Error', @p ]); + } + + # The relative errors (colored by whether they are OK or too big). + if ($formulas->{showRelativeErrors}) { + my @p = (); + my $tolerance = $self->getFlag('tolerance'); + my $tol; + my $tolType = $self->getFlag('tolType'); + my $error; + my $zeroLevel = $self->getFlag('zeroLevel'); + for my $j (0 .. $#P) { + if (Value::isNumber($sv->[ $i[$j] ])) { + my $c = $av->[ $i[$j] ]; + my $s = $sv->[ $i[$j] ]; + if (CORE::abs($cv->[ $i[$j] ]->value) < $zeroLevel || CORE::abs($s->value) < $zeroLevel) { + $error = CORE::abs($c - $s); + $tol = $zeroLevelTol; + } else { + $error = CORE::abs(($c - $s) / ($c || 1E-10)); + $tol = $tolerance; + } + $error = + '' . $error . '' + if $tolType eq 'relative'; + } else { + $error = "---"; + } + push(@p, "$error"); } - push(@p, $error); + push(@rows, [ 'Relative Error', @p ]); } - push(@rows, '' . join($colsep, @p) . ''); + $self->{context}{flags}{zeroLevelTol} = $zeroLevelTol; } - $self->{context}{flags}{zeroLevelTol} = $zeroLevelTol; - # - # Put the data into a table - # + + # Put the data into a table. if (scalar(@rows)) { - $output .= - '

' - . join('', @rows) - . '
'; + my $tdstyle = 'style="padding:5px"'; + my $trstyle = 'style="border:1px solid black"'; + $output .= ''; + for my $row (@rows) { + my $header = shift(@$row); + $output .= + "'; + } + $output .= '
$header" + . join("", @$row) + . '
'; } } - # - # Put all the diagnostic output into a frame - # + + # Put all the diagnostic output into a frame. return unless $output; $output = - '' - . '
Diagnostics for ' - . $self->string . ':' - . '

' + '
' + . '

Diagnostics for ' + . $self->string + . '

' . $output - . '

'; + . ''; $self->getPG('$PG')->debug_message($output); } -# -# Draw a graph from a given Formula object -# +# Draw a graph from a given Formula object. sub cmp_graph { - my $self = shift; - my $diagnostics = shift; - my $F1 = shift; + my ($self, $diagnostics, $F1, @opts) = @_; my $F2; - ($F1, $F2) = @{$F1} if (ref($F1) eq 'ARRAY'); - # - # Get the various options - # - my %options = (title => '', points => [], @_); + ($F1, $F2) = @{$F1} if ref($F1) eq 'ARRAY'; + + # Get the various options. + my %options = (title => '', points => [], @opts); my $graphs = $diagnostics->{graphs}; my $limits = $graphs->{limits}; my $size = $graphs->{size}; @@ -2291,49 +2282,50 @@ sub cmp_graph { my $clip = $options{clip}; my ($my, $My) = (0, 0); my ($mx, $Mx); - my $dx; - my $f; - my $y; my @pnames = $self->{context}->variables->parameters; my @pvalues = ($self->{parameters} ? @{ $self->{parameters} } : (0) x scalar(@pnames)); - my $x = ""; + my $x = ''; - # - # Find the max and min values of the function - # - foreach $f ($F1, $F2) { + # Find the max and min values of the function. + for my $f ($F1, $F2) { next unless defined($f); - foreach my $v (keys(%{ $f->{variables} })) { + for my $v (keys(%{ $f->{variables} })) { if ($v ne $x && !$f->{context}->variables->get($v)->{parameter}) { if ($x) { - warn "Only formulas with one variable can be graphed" unless $self->{graphWarning}; + my $warn = $self->{graphWarning}; $self->{graphWarning} = 1; - return ""; + return $warn + ? '' + : '

' + . 'Only formulas with one variable can be graphed.
'; } $x = $v; } } unless ($f->typeRef->{length} == 1) { - warn "Only real-valued functions can be graphed" unless $self->{graphWarning}; + my $warn = $self->{graphWarning}; $self->{graphWarning} = 1; - return ""; + return $warn + ? '' + : '
' + . 'Only formulas with one variable can be graphed.
'; } $x = ($f->{context}->variables->names)[0] unless $x; $limits = [ $self->getVariableLimits($x) ] unless $limits; $limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY'; ($mx, $Mx) = @{$limits}; - $dx = ($Mx - $mx) / $steps; + my $dx = ($Mx - $mx) / $steps; if ($f->isConstant) { - $y = $f->eval; + my $y = $f->eval; $my = $y if $y < $my; $My = $y if $y > $My; } else { my $F = $f->perlFunction(undef, [ $x, @pnames ]); - foreach my $i (0 .. $steps - 1) { - $y = eval { &{$F}($mx + $i * $dx, @pvalues) }; + for my $i (0 .. $steps - 1) { + my $y = eval { &{$F}($mx + $i * $dx, @pvalues) }; next unless defined($y) && Value::isNumber($y); $my = $y if $y < $my; $My = $y if $y > $My; @@ -2349,80 +2341,58 @@ sub cmp_graph { } $my = -$My / 10 if $my > -$My / 10; $My = -$my / 10 if $My < -$my / 10; - my $a = $self->Package("Real")->new(($My - $my) / ($Mx - $mx)); + my $a = $self->Package('Real')->new(($My - $my) / ($Mx - $mx)); - # - # Create the graph itself, with suitable title - # + # Create the graph itself, with suitable title. my $grf = $self->getPG('$_grf_ = {n => 0}'); $grf->{Goptions} = [ - $mx, $my, $Mx, $My, - axes => $graphs->{axes}, - grid => $graphs->{grid}, - size => $size, + xmin => $mx, + xmax => $Mx, + xtick_delta => ($Mx - $mx) / $graphs->{grid}->[0], + xminor => 0, + xlabel => "\\($x\\)", + ymin => $my, + ymax => $My, + ytick_delta => ($My - $my) / $graphs->{grid}->[1], + yminor => 0, + ytick_label_format => abs($My) < 0.01 ? 'scinot' : 'decimal', + ylabel => '\(f\)' ]; - $grf->{params} = { - names => [ $x, @pnames ], - values => { map { $pnames[$_] => $pvalues[$_] } (0 .. scalar(@pnames) - 1) }, - }; - $grf->{G} = $self->getPG('init_graph(@{$_grf_->{Goptions}})'); - $grf->{G}->imageName($grf->{G}->imageName . '-' . time()); # avoid browser cache - $self->cmp_graph_function($grf, $F2, "green", $steps, $points) if defined($F2); - $self->cmp_graph_function($grf, $F1, "red", $steps, $points); - my $image = $self->getPG('alias(insertGraph($_grf_->{G}))'); - $image = - ''; + $grf->{variable_name} = $x; + $grf->{params} = { map { $pnames[$_] => $pvalues[$_] } 0 .. $#pnames }; + $grf->{G} = $self->getPG('Plot(@{$_grf_->{Goptions}})'); + $self->cmp_graph_function($grf, $F2, $mx, $Mx, 'green', $points) if defined($F2); + $self->cmp_graph_function($grf, $F1, $mx, $Mx, 'red', $points); + my $image = '
' . $self->getPG('image($_grf_->{G})') . '
'; my $title = $options{title}; - $title .= '
' if $title; - $title .= "Domain: [$mx,$Mx]
" if $options{showDomain}; - $title .= "Range: [$my,$My]
Aspect ratio: $a:1"; - return '' . $image . '
' . $title . ''; + $title = "
$title
" if $title; + return + '
' + . $title + . ($options{showDomain} ? "Domain: [$mx,$Mx]
" : '') + . "Range: [$my,$My]
Aspect ratio: $a:1" + . $image + . '
'; } -# -# Add a function to a graph object, and plot the points -# that are used to test the function -# +# Add a function to a Plots::Plot object, and plot the points +# that are used to test the function. sub cmp_graph_function { - my $self = shift; - my $grf = shift; - my $F = shift; - my $color = shift; - my $steps = shift; - my $points = shift; - $grf->{n}++; - my $Fn = "F" . $grf->{n}; - $grf->{$Fn} = $F; - my $f; + my ($self, $grf, $F, $min, $max, $color, $points) = @_; if ($F->isConstant) { my $y = $F->eval; - $f = $self->getPG('new Fun(sub {' . $y . '},$_grf_->{G})'); + $grf->{G}->add_dataset([ $min, $y ], [ $max, $y ], color => $color); } else { - my $X = $grf->{params}{names}[0]; - $f = - $self->getPG('new Fun(sub {Parser::Evaluate($_grf_->{' - . $Fn . '},' - . $X - . '=>shift,%{$_grf_->{params}{values}})},$_grf_->{G})'); - foreach my $x (@{$points}) { - my $y = Parser::Evaluate($F, ($X) => $x, %{ $grf->{params}{values} }); + my $X = $grf->{variable_name}; + $F = $F->substitute(%{ $grf->{params} }) if %{ $grf->{params} }; + $grf->{G}->add_function($F, $X, $min, $max, color => $color); + for my $x (@{$points}) { + my $y = Parser::Evaluate($F, ($X) => $x); next unless defined($y) && Value::isNumber($y); - $grf->{x} = $x; - $grf->{'y'} = $y; - my $C = $self->getPG('new Circle($_grf_->{x},$_grf_->{y},4,"' . $color . '","' . $color . '")'); - $grf->{G}->stamps($C); + $grf->{G}->add_point($x, $y, color => $color); } } - $f->color($color); - $f->weight(2); - $f->steps($steps); } # diff --git a/lib/Value/Context/Diagnostics.pm b/lib/Value/Context/Diagnostics.pm index e095de3daa..f5e66d9a65 100644 --- a/lib/Value/Context/Diagnostics.pm +++ b/lib/Value/Context/Diagnostics.pm @@ -31,7 +31,6 @@ sub new { limits => undef, size => 250, grid => [ 10, 10 ], - axes => [ 0, 0 ], }, @_, );