Menu
▾
▴
[WWcvs] pg: Added isSetOfReals and canBeInUnion methods to the Value objects,
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 20:57:50
|
Log Message:
-----------
Added isSetOfReals and canBeInUnion methods to the Value objects, and
replaced the ad hoc tests for these conditions to call these
routines.
Cleaned up the make() methods for Intervals, Sets and Unions, and
improved the new() methods to handle more cases better.
Fixed Value::makeValue() to handle an array reference correctly.
I don't THINK any of this will break anything. :-)
Modified Files:
--------------
pg/lib:
Value.pm
pg/lib/Parser:
Value.pm
pg/lib/Value:
AnswerChecker.pm
Interval.pm
Set.pm
Union.pm
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -Llib/Value.pm -Llib/Value.pm -u -r1.43 -r1.44
--- lib/Value.pm
+++ lib/Value.pm
@@ -155,12 +155,19 @@
sub isOne {0}
+sub isSetOfReals {0}
+sub canBeInUnion {
+ my $self = shift;
+ return $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' &&
+ $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/;
+}
+
#
# Convert non-Value objects to Values, if possible
#
sub makeValue {
my $x = shift; my %params = (showError => 0, makeFormula => 1, @_);
- return $x if ref($x) || $x eq '';
+ return $x if (ref($x) && ref($x) ne 'ARRAY') || $x eq '';
return Value::Real->make($x) if matchNumber($x);
if (matchInfinite($x)) {
my $I = Value::Infinity->new();
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.15 -r1.16
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -47,10 +47,7 @@
sub check {
my $self = shift;
my $type = $self->{type}; my $value = $self->{value};
- $self->{canBeInterval} = 1
- if $value->{canBeInterval} ||
- ($value->class =~ m/Point|List/ &&
- $type->{length} == 2 && $type->{entryType}{name} eq 'Number');
+ $self->{canBeInterval} = $value->canBeInUnion;
$self->{isZero} = $value->isZero;
$self->{isOne} = $value->isOne;
}
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.6 -r1.7
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -45,8 +45,7 @@
}
return $self->formula($p) if $isFormula;
my $def = $$Value::context->lists->get('Set');
- my $set = bless {data => $p, canBeInterval => 1,
- open => $def->{open}, close => $def->{close}}, $class;
+ my $set = bless {data => $p, open => $def->{open}, close => $def->{close}}, $class;
$set = $set->reduce if $self->getFlag('reduceSets');
return $set;
}
@@ -58,7 +57,6 @@
my $self = shift;
my $def = $$Value::context->lists->get('Set');
$self = $self->SUPER::make(@_);
- $self->{canBeInterval} = 1;
$self->{open} = $def->{open}; $self->{close} = $def->{close};
return $self;
}
@@ -66,14 +64,18 @@
sub isOne {0}
sub isZero {0}
+sub canBeInUnion {1}
+sub isSetOfReals {1}
+
#
# Try to promote arbitrary data to a set
#
sub promote {
- my $x = shift;
- return $pkg->new($x,@_)
- if scalar(@_) > 0 || ref($x) eq 'ARRAY' || Value::isRealNumber($x);
- return $x if Value::class($x) =~ m/Interval|Union|Set/;
+ my $x = Value::makeValue(shift);
+ return $pkg->new($x,@_) if scalar(@_) > 0 || Value::isRealNumber($x);
+ return $x if ref($x) eq $pkg;
+ $x = Value::Interval::promote($x) if $x->canBeInUnion;
+ return $x if $x->isSetOfReals;
Value::Error("Can't convert %s to a Set",Value::showClass($x));
}
@@ -134,7 +136,7 @@
return @union if $a == $b;
$I->{open} = '(';
} elsif ($x < $b) {
- push(@union,Value::Interval->new($I->{open},$a,$x,')'));
+ push(@union,Value::Interval->make($I->{open},$a,$x,')'));
$I->{open} = '('; $I->{data}[0] = $x;
} else {
$I->{close} = ')' if ($x == $b);
@@ -192,7 +194,7 @@
#
#
-# Remove redundant values
+# Remove repeated values
#
sub reduce {
my $self = shift;
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.59
retrieving revision 1.60
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.59 -r1.60
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -199,7 +199,7 @@
my $self = shift; my $ans = shift;
my $class = $self->showClass; $class =~ s/Real //;
return $class if $class =~ m/Formula/;
- return "an Interval, Set or Union" if $class =~ m/Interval|Set|Union/i;
+ return "an Interval, Set or Union" if $self->isSetOfReals;
return $class;
}
@@ -260,7 +260,7 @@
unless $R[$i] == $S[$i] && $R[$i]->length == $S[$i]->length;
}
} elsif ($student->type eq 'Set' && $student->length >= 2) {
- return "Your$nth set should have no redundant elements"
+ return "Your$nth set should have no repeated elements"
unless $student->reduce->length == $student->length;
}
return;
@@ -803,15 +803,10 @@
sub typeMatch {
my $self = shift; my $other = shift;
- return 0 unless ref($other) && $other->class ne 'Formula';
- return $other->length == 2 &&
- ($other->{open} eq '(' || $other->{open} eq '[') &&
- ($other->{close} eq ')' || $other->{close} eq ']')
- if $other->type =~ m/^(Point|List)$/;
- $other->type =~ m/^(Interval|Union|Set)$/;
+ return 0 if !Value::isValue($other) || $other->isFormula;
+ return $other->canBeInUnion;
}
-
#
# Check for unreduced sets and unions
#
@@ -851,12 +846,8 @@
sub typeMatch {
my $self = shift; my $other = shift;
- return 0 unless ref($other) && $other->class ne 'Formula';
- return $other->length == 2 &&
- ($other->{open} eq '(' || $other->{open} eq '[') &&
- ($other->{close} eq ')' || $other->{close} eq ']')
- if $other->type =~ m/^(Point|List)$/;
- $other->type =~ m/^(Interval|Union|Set)/;
+ return 0 if !Value::isValue($other) || $other->isFormula;
+ return $other->canBeInUnion;
}
#
@@ -905,7 +896,7 @@
($other->{open} eq '(' || $other->{open} eq '[') &&
($other->{close} eq ')' || $other->{close} eq ']')
if $other->type =~ m/^(Point|List)$/;
- $other->type =~ m/^(Interval|Union|Set)/;
+ $other->isSetOfReals;
}
#
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.25 -r1.26
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -26,7 +26,7 @@
#
sub new {
my $self = shift; my $class = ref($self) || $self;
- if (scalar(@_) == 1 && !ref($_[0])) {
+ if (scalar(@_) == 1 && (!ref($_[0]) || ref($_[0]) eq 'ARRAY')) {
my $x = Value::makeValue($_[0]);
if (Value::isFormula($x)) {
return $x if $x->type eq 'Interval';
@@ -34,13 +34,16 @@
}
return promote($x);
}
- my ($open,$a,$b,$close) = @_;
+ my @params = @_;
+ Value::Error("Interval can't be empty") unless scalar(@params) > 0;
+ Value::Error("Extra arguments for Interval()") if scalar(@params) > 4;
+ return Value::Set->new(@params) if scalar(@params) == 1;
+ @params = ('(',@params,')') if (scalar(@params) == 2);
+ my ($open,$a,$b,$close) = @params;
if (!defined($close)) {$close = $b; $b = $a}
- Value::Error("Interval() must be called with 3 or 4 arguments")
- unless defined($open) && defined($a) && defined($b) && defined($close) && scalar(@_) <= 4;
$a = Value::makeValue($a); $b = Value::makeValue($b);
return $self->formula($open,$a,$b,$close) if Value::isFormula($a) || Value::isFormula($b);
- Value::Error("Endpoints of intervals must be numbers on infinities") unless
+ Value::Error("Endpoints of intervals must be numbers or infinities") unless
isNumOrInfinity($a) && isNumOrInfinity($b);
my ($ia,$ib) = (isInfinity($a),isInfinity($b));
my ($nia,$nib) = (isNegativeInfinity($a),isNegativeInfinity($b));
@@ -60,7 +63,6 @@
bless {
data => [$a,$b], open => $open, close => $close,
leftInfinite => $nia, rightInfinite => $ib,
- canBeInterval => 1,
}, $class;
}
@@ -74,7 +76,6 @@
bless {
data => [$a,$b], open => $open, close => $close,
leftInfinite => isNegativeInfinity($a), rightInfinite => isInfinity($b),
- canBeInterval => 1,
}, $class
}
@@ -114,6 +115,9 @@
sub isOne {0}
sub isZero {0}
+sub canBeInUnion {1}
+sub isSetOfReals {1}
+
#
# Return the open and close parens as well as the endpoints
#
@@ -136,16 +140,13 @@
# Convert points and lists to intervals, when needed
#
sub promote {
- my $x = shift;
- return $pkg->new($x,@_) if scalar(@_) > 0 || ref($x) eq 'ARRAY';
- return $x if ref($x) eq $pkg;
- $x = Value::makeValue($x);
+ my $x = Value::makeValue(shift);
+ return $pkg->new($x,@_) if scalar(@_) > 0;
+ return $x if $x->isSetOfReals;
return Value::Set->new($x) if Value::class($x) eq 'Real';
my $open = $x->{open}; $open = '(' unless defined($open);
my $close = $x->{close}; $close = ')' unless defined($close);
- return $pkg->new($open,$x->value,$close)
- if Value::class($x) =~ m/^(Point|List)$/ && $x->length == 2 &&
- ($open eq '(' || $open eq '[') && ($close eq ')' || $close eq ']');
+ return $pkg->new($open,$x->value,$close) if $x->canBeInUnion;
Value::Error("Can't convert %s to an Interval",Value::showClass($x));
}
@@ -192,18 +193,18 @@
push(@union,$l) unless $a == $b && $l->{close} eq ')';
} else {
if ($a == $c) {
- push(@union,Value::Set->new($a))
+ push(@union,Value::Set->make($a))
if $l->{open} eq '[' && $r->{open} eq '(';
} elsif ($a < $c) {
my $close = ($r->{open} eq '[')? ')': ']';
- push(@union,Value::Interval->new($l->{open},$a,$c,$close));
+ push(@union,Value::Interval->make($l->{open},$a,$c,$close));
}
if ($d == $b) {
- push(@union,Value::Set->new($b))
+ push(@union,Value::Set->make($b))
if $l->{close} eq ']' && $r->{close} eq ')';
} elsif ($d < $b) {
my $open = ($r->{close} eq ']') ? '(': '[';
- push(@union,Value::Interval->new($open,$d,$b,$l->{close}));
+ push(@union,Value::Interval->make($open,$d,$b,$l->{close}));
}
}
return @union;
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.21 -r1.22
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -33,28 +33,26 @@
$x = promote($x); $x = $pkg->make($x) unless $x->type eq 'Union';
return $x;
}
- Value::Error("Empty unions are not allowed") if scalar(@_) == 0;
my @intervals = (); my $isFormula = 0;
foreach my $xx (@_) {
- my $x = $xx; $x = Value::makeValue($x);
- if (Value::isFormula($x)) {
+ next if $xx eq ''; my $x = Value::makeValue($xx);
+ if ($x->isFormula) {
$x->{tree}->typeRef->{name} = 'Interval'
if ($x->type =~ m/Point|List/ && $x->length == 2 &&
$x->typeRef->{entryType}{name} eq 'Number');
- if ($x->type =~ m/Interval|Set/) {push(@intervals,$x)}
- elsif ($x->type eq 'Union') {push(@intervals,$x->{tree}->makeUnion)}
+ if ($x->type eq 'Union') {push(@intervals,$x->{tree}->makeUnion)}
+ elsif ($x->isSetOfReals) {push(@intervals,$x)}
else {Value::Error("Unions can be taken only for Intervals and Sets")}
$isFormula = 1;
} else {
- if (Value::class($x) eq 'Point' || Value::class($x) eq 'List') {
- if ($x->length == 1) {$x = Value::Interval->new('[',$x->value,$x->value,']')}
- elsif ($x->length == 2) {$x = Value::Interval->new($x->{open},$x->value,$x->{close})}
- }
- if (Value::class($x) =~ m/Interval|Set/) {push(@intervals,$x)}
- elsif (Value::class($x) eq 'Union') {push(@intervals,@{$x->{data}})}
+ if ($x->type ne 'Interval' && $x->canBeInUnion)
+ {$x = Value::Interval->new($x->{open},$x->value,$x->{close})}
+ if ($x->class eq 'Union') {push(@intervals,$x->value)}
+ elsif ($x->isSetOfReals) {push(@intervals,$x)}
else {Value::Error("Unions can be taken only for Intervals or Sets")}
}
}
+ Value::Error("Empty unions are not allowed") if scalar(@intervals) == 0;
return $self->formula(@intervals) if $isFormula;
my $union = form(@intervals);
$union = $self->make($union) unless $union->type eq 'Union';
@@ -62,16 +60,6 @@
}
#
-# Set the canBeInterval flag
-#
-sub make {
- my $self = shift;
- $self = $self->SUPER::make(@_);
- $self->{canBeInterval} = 1;
- return $self;
-}
-
-#
# Make a union or interval or set, depending on how
# many there are in the union, and mark the
#
@@ -95,6 +83,9 @@
sub isOne {0}
sub isZero {0}
+sub canBeInUnion {1}
+sub isSetOfReals {1}
+
#
# Recursively convert the list of intervals to a tree of unions
#
@@ -115,12 +106,11 @@
# Try to promote arbitrary data to a set
#
sub promote {
- my $x = shift;
- return Value::Set->new($x,@_)
- if scalar(@_) > 0 || ref($x) eq 'ARRAY' || Value::isRealNumber($x);
- return $x if Value::class($x) eq 'Union';
- $x = Value::Interval::promote($x) if Value::class($x) eq 'List';
- return $pkg->make($x) if Value::class($x) =~ m/Interval|Set/;
+ my $x = Value::makeValue(shift);
+ return Value::Set->new($x,@_) if scalar(@_) > 0 || Value::isRealNumber($x);
+ return $x if ref($x) eq $pkg;
+ $x = Value::Interval::promote($x) if $x->canBeInUnion;
+ return $pkg->make($x) if Value::isValue($x) && $x->isSetOfReals;
Value::Error("Can't convert %s to an Interval, Set or Union",Value::showClass($x));
}
|
