[WWcvs] pg: The make() method now inherits all the settings of the parent object, so that flags set by the user (e.g., tolerances,

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

Log Message:
-----------
The make() method now inherits all the settings of the parent object,
so that flags set by the user (e.g., tolerances, periods, and so on)
will be passed on as new objects are created.  For example, in

     $x = Real(1)=>with(tolerance=>.0001);
     $y = sin($x);

$y will also have tolerance set to .0001.

This also applies to binary operations, where the result will now
inherit all the values of either operand, with the left-hand operand
taking precedence when they both have a flag set but to different
values.

This is a significant change, and there may be unforeseen side effects
that I'll have to take care of as they appear.  It passes my test
suite, however, so I'm hoping they will be limited.

Modified Files:
--------------
    pg/lib:
        Value.pm
    pg/lib/Value:
        Complex.pm
        Matrix.pm
        Point.pm
        Real.pm
        Vector.pm

Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.90
retrieving revision 1.91
diff -Llib/Value.pm -Llib/Value.pm -u -r1.90 -r1.91
--- lib/Value.pm
+++ lib/Value.pm
@@ -195,7 +195,7 @@
 push(@{$$context->{data}{values}},'method','precedence');
 
 #
-#  Copy a context and its data
+#  Copy an item and its data
 #
 sub copy {
   my $self = shift;
@@ -557,7 +557,7 @@
 sub make {
   my $self = shift; my $class = ref($self) || $self;
   my $context = (Value::isContext($_[0]) ? shift : $self->context);
-  bless {data => [@_], context => $context}, $class;
+  bless {$self->hash, data => [@_], context => $context}, $class;
 }
 
 #
@@ -570,6 +570,35 @@
   bless {%{$self},@_}, ref($self);
 }
 
+#
+#  Return a copy with the specified fields removed
+#
+sub without {
+  my $self = shift;
+  $self = bless {%{$self}}, ref($self);
+  foreach my $id (@_) {delete $self->{$id} if defined $self->{$id}}
+  return $self;
+}
+
+#
+#  Return the hash data as an array of key=>value pairs
+#
+sub hash {
+  my $self = shift;
+  return %$self if isHash($self);
+  return ();
+}
+
+#
+#  Copy attributes that are not already in the current object
+#  from the given objects.  (Used by binary operators to make sure
+#  the result inherits the values from the two terms.)
+#
+sub inherit {
+  my $self = shift;
+  bless {(map {%$_} @_),%$self}, ref($self);
+}
+
 ######################################################################
 
 #
@@ -688,7 +717,7 @@
 #
 sub checkOpOrder {
   my ($l,$r,$flag) = @_;
-  if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)}
+  if ($flag) {return ($l,$r,$l,$r)} else {return ($l,$l,$r,$r)}
 }
 
 #
@@ -697,7 +726,7 @@
 #
 sub checkOpOrderWithPromote {
   my ($l,$r,$flag) = @_; $r = $l->promote($r);
-  if ($flag) {return ($l,$r,$l)} else {return ($l,$l,$r)}
+  if ($flag) {return ($l,$r,$l,$r)} else {return ($l,$l,$r,$r)}
 }
 
 #
Index: Real.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Real.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -Llib/Value/Real.pm -Llib/Value/Real.pm -u -r1.39 -r1.40
--- lib/Value/Real.pm
+++ lib/Value/Real.pm
@@ -72,41 +72,41 @@
 #
 
 sub add {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
-  return $self->make($l->{data}[0] + $r->{data}[0]);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  return $self->inherit($other)->make($l->{data}[0] + $r->{data}[0]);
 }
 
 sub sub {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
-  return $self->make($l->{data}[0] - $r->{data}[0]);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  return $self->inherit($other)->make($l->{data}[0] - $r->{data}[0]);
 }
 
 sub mult {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
-  return $self->make($l->{data}[0] * $r->{data}[0]);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  return $self->inherit($other)->make($l->{data}[0] * $r->{data}[0]);
 }
 
 sub div {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   Value::Error("Division by zero") if $r->{data}[0] == 0;
-  return $self->make($l->{data}[0] / $r->{data}[0]);
+  return $self->inherit($other)->make($l->{data}[0] / $r->{data}[0]);
 }
 
 sub power {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my $x = $l->{data}[0] ** $r->{data}[0];
-  return $self->make($x) unless $x eq 'nan';
+  return $self->inherit($other)->make($x) unless $x eq 'nan';
   Value::Error("Can't raise a negative number to a power") if ($l->{data}[0] < 0);
   Value::Error("Result of exponention is not a number");
 }
 
 sub modulo {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   $l = $l->{data}[0]; $r = $r->{data}[0];
-  return $self->make(0) if $r == 0; # non-fuzzy check
+  return $self->inherit($other)->make(0) if $r == 0; # non-fuzzy check
   my $m = $l/$r;
   my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
-  return $self->make($l - $n*$r);
+  return $self->inherit($other)->make($l - $n*$r);
 }
 
 sub compare {
@@ -116,6 +116,8 @@
   #
   my $m = $self->getFlag("period");
   if (defined $m) {
+    $l = $l->with(period=>undef);  # make sure tests below don't use period
+    $r = $r->with(period=>undef);
     if ($self->getFlag("logPeriodic")) {
       return 1 if $l->value == 0 || $r->value == 0; # non-fuzzy checks
       $l = log($l); $r = log($r);
@@ -161,8 +163,8 @@
 sub cos {my $self = shift; $self->make(CORE::cos($self->{data}[0]))}
 
 sub atan2 {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
-  return $self->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  return $self->inherit($other)->make(CORE::atan2($l->{data}[0],$r->{data}[0]));
 }
 
 ##################################################
@@ -170,7 +172,8 @@
 sub string {
   my $self = shift; my $equation = shift; my $prec = shift;
   my $n = $self->{data}[0];
-  my $format = $self->getFlag("format",$equation->{format} || ($equation->{context} || $self->context)->{format}{number});
+  my $format = $self->getFlag("format",$equation->{format} ||
+			        ($equation->{context} || $self->context)->{format}{number});
   if ($format) {
     $n = sprintf($format,$n);
     if ($format =~ m/#\s*$/) {$n =~ s/(\.\d*?)0*#$/$1/; $n =~ s/\.$//}
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Vector.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -Llib/Value/Vector.pm -Llib/Value/Vector.pm -u -r1.32 -r1.33
--- lib/Value/Vector.pm
+++ lib/Value/Vector.pm
@@ -50,16 +50,6 @@
 }
 
 #
-#  Make sure column vector is retained
-#
-sub make {
-  my $self = shift;
-  my $v = $self->SUPER::make(@_);
-  $v->{ColumnVector} = 1 if ref($self) && $self->{ColumnVector};
-  return $v;
-}
-
-#
 #  Try to promote arbitary data to a vector
 #
 sub promote {
@@ -69,7 +59,7 @@
   return $self->new($context,$x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
   $x = Value::makeValue($x,context=>$context);
   return $x->inContext($context) if ref($x) eq $class;
-  return $self->make($context,$x->value) if Value::classMatch($x,'Point');
+  return $self->make($context,$x->value)->inherit($x->without('open','close')) if Value::classMatch($x,'Point');
   Value::Error("Can't convert %s to %s",Value::showClass($x),Value::showClass($self));
 }
 
@@ -81,23 +71,23 @@
 #
 
 sub add {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
   Value::Error("Can't add Vectors with different numbers of coordinates")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub sub {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
   Value::Error("Can't subtract Vectors with different numbers of coordinates")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub mult {
@@ -137,13 +127,13 @@
 }
 
 sub cross {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
   Value::Error("Vectors for cross product must be in 3-space")
     unless scalar(@l) == 3 && scalar(@r) == 3;
-  $self->make($l[1]*$r[2] - $l[2]*$r[1],
-            -($l[0]*$r[2] - $l[2]*$r[0]),
-              $l[0]*$r[1] - $l[1]*$r[0]);
+  $self->inherit($other)->make($l[1]*$r[2] - $l[2]*$r[1],
+                             -($l[0]*$r[2] - $l[2]*$r[0]),
+                               $l[0]*$r[1] - $l[1]*$r[0]);
 }
 
 #
@@ -153,6 +143,10 @@
 sub compare {
   my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
+  if ($self->getFlag("ignoreTrailingZeros")) {
+    while (scalar(@l) < scalar(@r) && $r[scalar(@l)] == 0) {push(@l,0)}
+    while (scalar(@r) < scalar(@l) && $r[scalar(@r)] == 0) {push(@r,0)}
+  }
   return scalar(@l) <=> scalar(@r) unless scalar(@l) == scalar(@r);
   my $cmp = 0;
   foreach my $i (0..scalar(@l)-1) {
@@ -300,4 +294,3 @@
 ###########################################################################
 
 1;
-
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Complex.pm,v
retrieving revision 1.34
retrieving revision 1.35
diff -Llib/Value/Complex.pm -Llib/Value/Complex.pm -u -r1.34 -r1.35
--- lib/Value/Complex.pm
+++ lib/Value/Complex.pm
@@ -39,7 +39,7 @@
   my $self = shift; my $class = ref($self) || $self;
   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   while (scalar(@_) < 2) {push(@_,0)}
-  my $c = bless {data => [@_[0,1]], context => $context}, $class;
+  my $c = bless {$self->hash, data => [@_[0,1]], context => $context}, $class;
   foreach my $x (@{$c->{data}}) {$x = $context->Package("Real")->make($context,$x) unless Value::isValue($x)}
   return $c;
 }
@@ -84,42 +84,42 @@
 #
 
 sub add {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
-  return $self->make($a + $c, $b + $d);
+  return $self->inherit($other)->make($a + $c, $b + $d);
 }
 
 sub sub {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
-  return $self->make($a - $c, $b - $d);
+  return $self->inherit($other)->make($a - $c, $b - $d);
 }
 
 sub mult {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
-  return $self->make($a*$c - $b*$d, $b*$c + $a*$d);
+  return $self->inherit($other)->make($a*$c - $b*$d, $b*$c + $a*$d);
 }
 
 sub div {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
   my $x = $c*$c + $d*$d;
   Value::Error("Division by zero") if $x->value == 0;
-  return $self->make(($a*$c + $b*$d)/$x,($b*$c - $a*$d)/$x);
+  return $self->inherit($other)->make(($a*$c + $b*$d)/$x,($b*$c - $a*$d)/$x);
 }
 
 sub power {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
-  return $self->make(1,0) if ($a->value == 1 && $b->value == 0) || ($c->value == 0 && $d->value == 0);
-  return $self->make(0,0) if $c->value > 0 && ($a->value == 0 && $b->value == 0);
+  return $self->inherit($other)->make(1,0) if ($a->value == 1 && $b->value == 0) || ($c->value == 0 && $d->value == 0);
+  return $self->inherit($other)->make(0,0) if $c->value > 0 && ($a->value == 0 && $b->value == 0);
   return exp($r * log($l))
  }
 
 sub modulo {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
-  return $self->make(0) if abs($r)->value == 0; # non-fuzzy check
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  return $self->inherit($other)->make(0) if abs($r)->value == 0; # non-fuzzy check
   my $m = Re($l/$r)->value;
   my $n = int($m); $n-- if $n > $m; # act as floor() rather than int()
   return $l - $n*$r;
@@ -132,6 +132,8 @@
   #
   my $m = $self->getFlag("period");
   if (defined $m) {
+    $l = $l->with(period=>undef);  # make sure tests below don't use period
+    $r = $r->with(period=>undef);
     if ($self->getFlag("logPeriodic")) {
       return 1 if abs($l)->value == 0 || abs($r)->value == 0; # non-fuzzy checks
       $l = log($l); $r = log($r);
@@ -248,7 +250,8 @@
 
 # atan2(z1,z2) = atan(z1/z2)
 sub atan2 {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
+  $self = $self->inherit($other);
   my ($a,$b) = $l->value; my ($c,$d) = $r->value;
   if ($c->value == 0 && $d->value == 0) {
     return $self->make(0,0) if ($a->value == 0 && $b->value == 0);
@@ -333,7 +336,7 @@
   $a->{format} = $b->{format} = $format if defined $format;
   my $bi = 'i';
   return $a->$method($equation) if $b == 0;
-  $bi = CORE::abs($b)->with(format=>$format)->$method($equation,1) . 'i' if CORE::abs($b) ne 1;
+  $bi = CORE::abs($b)->with(format=>$format)->$method($equation,1) . 'i' if CORE::abs($b) !~ m/^1(\.0*)?$/;
   $bi = '-' . $bi if $b < 0;
   return $bi if $a == 0;
   $bi = '+' . $bi if $b > 0;
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Matrix.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -Llib/Value/Matrix.pm -Llib/Value/Matrix.pm -u -r1.33 -r1.34
--- lib/Value/Matrix.pm
+++ lib/Value/Matrix.pm
@@ -175,27 +175,27 @@
 #
 
 sub add {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = @{$l->data}; my @r = @{$r->data};
   Value::Error("Can't add Matrices with different dimensions")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub sub {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = @{$l->data}; my @r = @{$r->data};
   Value::Error("Can't subtract Matrices with different dimensions")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub mult {
-  my ($l,$r,$flag) = @_; my $self = $l;
+  my ($l,$r,$flag) = @_; my $self = $l; my $other = $r;
   #
   #  Constant multiplication
   #
@@ -230,6 +230,7 @@
     }
     push(@M,$self->make(@row));
   }
+  $self = $self->inherit($other) if Value::isValue($other);
   return $self->make(@M);
 }
 
Index: Point.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Point.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -Llib/Value/Point.pm -Llib/Value/Point.pm -u -r1.28 -r1.29
--- lib/Value/Point.pm
+++ lib/Value/Point.pm
@@ -60,23 +60,23 @@
 #
 
 sub add {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
   Value::Error("Can't add Points with different numbers of coordinates")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] + $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub sub {
-  my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_);
+  my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_);
   my @l = $l->value; my @r = $r->value;
   Value::Error("Can't subtract Points with different numbers of coordinates")
     unless scalar(@l) == scalar(@r);
   my @s = ();
   foreach my $i (0..scalar(@l)-1) {push(@s,$l[$i] - $r[$i])}
-  return $self->make(@s);
+  return $self->inherit($other)->make(@s);
 }
 
 sub mult {