[WWcvs] pg: BACKPORT: add recent changes up to version 1.19 (better protection from errors in student formulas, ability to get

[dpvc v. a. <we...@ma...>]

Log Message:
-----------
BACKPORT: add recent changes up to version 1.19 (better protection
from errors in student formulas, ability to get diagnostics for
FormulaUpToConstant objects, properly handle test_points and test_at,
etc.)

Tags:
----
rel-2-4-patches

Modified Files:
--------------
    pg/macros:
        parserFormulaUpToConstant.pl

Revision Data
-------------
Index: parserFormulaUpToConstant.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserFormulaUpToConstant.pl,v
retrieving revision 1.11.2.1.2.2
retrieving revision 1.11.2.1.2.3
diff -Lmacros/parserFormulaUpToConstant.pl -Lmacros/parserFormulaUpToConstant.pl -u -r1.11.2.1.2.2 -r1.11.2.1.2.3
--- macros/parserFormulaUpToConstant.pl
+++ macros/parserFormulaUpToConstant.pl
@@ -176,9 +176,9 @@
   #
   #  Compare with adaptive parameters to see if $l + n0 C = $r for some n0.
   #
-  $main::{_cmp_} = sub {return ($l->{adapt}->inherit($l)) == $r};  # a closure to access local variables
-  my $equal = main::PG_restricted_eval('&{$main::{_cmp_}}');       # prevents errors with large adaptive parameters
-  delete $main::{_cmp_};                                           # remove temprary function
+  my $adapt = $l->adapt;
+  my $equal = $adapt->cmp_compare($r,{});
+  $self->{adapt} = $self->{adapt}->inherit($adapt);            # save the adapted value's flags
   return -1 unless $equal;
   #
   #  Check that n0 is non-zero (i.e., there is a multiple of C in the student answer)
@@ -187,6 +187,62 @@
   return abs($context->variables->get("n00")->{value}) < $context->flag("zeroLevelTol");
 }
 
+#
+#  Return the {adapt} formula with test points adjusted
+#
+sub adapt {
+  my $self = shift;
+  my $adapt = $self->{adapt}->inherit($self); delete $adapt->{adapt};
+  return $self->adjustInherit($self->{adapt});
+}
+
+#
+#  Inherit from the main FormulaUpToConstant, but
+#  adjust the test points to include the constants
+#
+sub adjustInherit {
+  my $self = shift;
+  my $f = shift->inherit($self);
+  delete $f->{adapt}; delete $f->{constant};
+  foreach my $id ('test_points','test_at') {
+    if (defined $f->{$id}) {
+      $f->{$id} = [$f->{$id}->value] if Value::isValue($f->{$id});
+      $f->{$id} = [$f->{$id}] unless ref($f->{$id}) eq 'ARRAY';
+      $f->{$id} = [map {
+	(Value::isValue($_) ? [$_->value] :
+        (ref($_) eq 'ARRAY'? $_ : [$_]))
+      } @{$f->{$id}}];
+      $f->{$id} = $self->addConstants($f->{$id});
+    }
+  }
+  return $f;
+}
+
+#
+#  Insert dummy values for the constants for the test points
+#  (These are supposed to be +C, so the value shouldn't matter?)
+#
+sub addConstants {
+  my $self = shift; my $points = shift;
+  my @names = $self->context->variables->variables;
+  my $variables = $self->context->{variables};
+  my $Points = [];
+  foreach my $p (@{$points}) {
+    if (scalar(@{$p}) == scalar(@names)) {
+      push (@{$Points},$p);
+    } else {
+      my @P = (.1) x scalar(@names); my $j = 0;
+      foreach my $i (0..scalar(@names)-1) {
+        if (!$variables->{$names[$i]}{arbitraryConstant}) {
+	  $P[$i] = $p->[$j] if defined $p->[$j]; $j++;
+	}
+      }
+      push (@{$Points}, \@P);
+    }
+  }
+  return $Points;
+}
+
 ##################################################
 #
 #  Here we override part of the answer comparison
@@ -201,24 +257,48 @@
 sub cmp_defaults {((shift)->SUPER::cmp_defaults,showHints => 1, showLinearityHints => 1)};
 
 #
+#  Provide diagnostics based on the adapted function used to check
+#  the student's answer
+#
+sub cmp_diagnostics {
+  my $self = shift;
+  $self->inherit($self->{adapt})->SUPER::cmp_diagnostics(@_);
+}
+
+#
+#  Make it possible to graph single-variable formulas by setting
+#  the arbitrary constants to 0 first.
+#
+sub cmp_graph {
+  my $self = shift; my $diagnostics = shift;
+  my $F1 = shift; my $F2; ($F1,$F2) = @{$F1} if (ref($F1) eq 'ARRAY');
+  my %subs; my $context = $self->context;
+  foreach my $v ($context->variables->variables)
+    {$subs{$v} = 0 if ($context->variables->get($v)->{arbitraryConstant})}
+  $F1 = $F1->inherit($F1->{adapt})->substitute(%subs)->reduce;
+  $F2 = $F2->inherit($F2->{adapt})->substitute(%subs)->reduce;
+  $self->SUPER::cmp_graph($diagnostics,[$F1,$F2]);
+}
+
+#
 #  Add useful messages, if the author requested them
 #
 sub cmp_postprocess {
   my $self = shift; my $ans = shift;
-  $self->SUPER::cmp_postprocess($ans);
+  $self->SUPER::cmp_postprocess($ans,@_);
   return unless $ans->{score} == 0 && !$ans->{isPreview};
   return if $ans->{ans_message} || !$self->getFlag("showHints");
   my $student = $ans->{student_value};
-  my $result = $ans->{correct_value} <=> $student;  # compare encodes the reason in the result
+  $main::{_cmp_} = sub {return $ans->{correct_value} <=> $student}; # compare encodes the reason in the result
+  my $result = main::PG_restricted_eval('&{$main::{_cmp_}}');
+  delete $main::{_cmp_};
   $self->cmp_Error($ans,"Note: there is always more than one posibility") if $result == 2 || $result == 3;
   if ($result == 3) {
     my $context = $self->context;
     $context->flags->set(no_parameters=>0);
     $context->variables->add(x00=>'Real');
     my $correct = $self->removeConstant+"n01+n00x00";    # must use both parameters
-    $main::{_cmp_} = sub {return $correct == $student+"x00"};     # a closure to access local variables
-    $result = 1 if main::PG_restricted_eval('&{$main::{_cmp_}}'); # prevents domain errors (and other errors)
-    delete $main::{_cmp_};                                        # remove temprary function
+    $result = 1 if $correct->cmp_compare($student+"x00",{});
     $context->variables->remove('x00');
     $context->flags->set(no_parameters=>1);
   }
@@ -238,7 +318,7 @@
 #
 sub removeConstant {
   my $self = shift;
-  main::Formula($self->substitute($self->{constant}=>0))->reduce->inherit($self);
+  return $self->adjustInherit(main::Formula($self->substitute($self->{constant}=>0))->reduce);
 }
 
 #