Menu
▾
▴
[WWcvs] pg: Added ability for Unions and Sets to simplify themselves
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 00:23:53
|
Log Message:
-----------
Added ability for Unions and Sets to simplify themselves
(automatically or on demand), and added flags to the Context and
answer checkers to control these features. The new Context flags
are
reduceUnions tells whether unions are automatically
reduced when they are created.
reduceUnionsForComparison tells whether unions are reduced
before comparing them for equality
or inequality (etc) if they aren't
reduced already.
reduceSets tells whether redundent elements are
removed from sets as they are created.
reduceSetsForComparison tells whether sets are reduced before
comparing them.
All of these default to true.
The Interval, Set, Union, and List answer checkers not have two new
flags for controlling these values:
studentsMustReduceUnions tells whether unions and sets will be
counted as incorrect when they are not
reduced to non-overlapping intervals
and at most one set with no repeated
entries.
showUnionReduceWarnings tells whether an error message will
be produced for non-reduced unions and
sets, or if they will be marked wrong
silently. (Not available in Lists.)
Both of these are true by default, since most professors probably want
their students to write intervals in reduced form. (Is this true?)
This corresponds the the current behavior of the interval checkers,
which require the student's answer to be the same set of intervals as
in the professor's, but with the addition of an error message when the
student answer is not reduced.
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.41
retrieving revision 1.42
diff -Llib/Value.pm -Llib/Value.pm -u -r1.41 -r1.42
--- lib/Value.pm
+++ lib/Value.pm
@@ -28,6 +28,14 @@
#
infiniteWord => 'infinity',
#
+ # For intervals and unions:
+ #
+ ignoreEndpointTypes => 0,
+ reduceSets => 1,
+ reduceSetsForComparison => 1,
+ reduceUnions => 1,
+ reduceUnionsForComparison => 1,
+ #
# For fuzzy reals:
#
useFuzzyReals => 1,
@@ -36,13 +44,13 @@
zeroLevel => 1E-14,
zeroLevelTol => 1E-12,
#
- # For functions
+ # For Formulas:
#
- limits => [-2,2],
- num_points => 5,
- granularity => 1000,
- resolution => undef,
- max_adapt => 1E8,
+ limits => [-2,2],
+ num_points => 5,
+ granularity => 1000,
+ resolution => undef,
+ max_adapt => 1E8,
checkUndefinedPoints => 0,
max_undefined => undef,
},
@@ -93,6 +101,19 @@
push(@{$$context->{data}{values}},'method','precedence');
+#
+# Get the value of a flag from the object itself,
+# or from the context, or from the default context
+# or from the given default, whichever is found first.
+#
+sub getFlag {
+ my $self = shift; my $name = shift;
+ return $self->{$name} if ref($self) && defined($self->{$name});
+ return $self->{context}{flags}{$name} if ref($self) && defined($self->{context}{flags}{$name});
+ return $$Value::context->{flags}{$name} if defined($$Value::context->{flags}{$name});
+ return shift;
+}
+
#############################################################
#
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.14 -r1.15
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -37,14 +37,22 @@
value => $value, type => $type, isConstant => 1,
ref => $ref, equation => $equation,
}, $class;
- $c->{canBeInterval} = 1
+ $c->check;
+ return $c;
+}
+
+#
+# Set flags for the object
+#
+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');
-
- $c->{isZero} = $value->isZero;
- $c->{isOne} = $value->isOne;
- return $c;
+ $self->{isZero} = $value->isZero;
+ $self->{isOne} = $value->isOne;
}
#
@@ -53,6 +61,16 @@
sub eval {return (shift)->{value}}
#
+# Call the Value object's reduce method and reset the flags
+#
+sub reduce {
+ my $self = shift;
+ $self->{value} = $self->{value}->reduce;
+ $self->check;
+ return $self;
+}
+
+#
# Return the item's list of coordinates
# (for points, vectors, matrices, etc.)
#
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.2 -r1.3
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -45,17 +45,18 @@
}
return $self->formula($p) if $isFormula;
my $def = $$Value::context->lists->get('Set');
- bless {
- data => $p, canBeInterval => 1,
- open => $def->{open}, close => $def->{close}
- }, $class;
+ my $set = bless {data => $p, canBeInterval => 1,
+ open => $def->{open}, close => $def->{close}}, $class;
+ $set = $set->reduce if $self->getFlag('reduceSets');
+ return $set;
}
#
# Set the canBeInterval flag
#
sub make {
- my $self = shift; my $def = $$Value::context->lists->get('Set');
+ 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};
@@ -88,15 +89,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- return Value::Union->new($l,$r)
- unless Value::class($l) eq 'Set' && Value::class($r) eq 'Set';
- my @combined = (sort {$a <=> $b} (@{$l->data},@{$r->data}));
- my @entries = ();
- while (scalar(@combined)) {
- push(@entries,shift(@combined));
- shift(@combined) while (scalar(@combined) && $entries[-1] == $combined[0]);
- }
- return $pkg->make(@entries);
+ Value::Union::form($l,$r);
}
sub dot {my $self = shift; $self->add(@_)}
@@ -184,8 +177,10 @@
if ($l->length == 1 && $a == $b) || $a != $c;
return ($flag? 1: -1);
}
+ if ($l->getFlag('reduceSetsForComparison')) {$l = $l->reduce; $r = $r->reduce}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} @{$l->data}; my @r = sort {$a <=> $b} @{$r->data};
+ my @l = sort {$a <=> $b} $l->value;
+ my @r = sort {$a <=> $b} $r->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -193,6 +188,21 @@
return scalar(@l) - scalar(@r);
}
+#
+# Remove redundant values
+#
+sub reduce {
+ my $self = shift;
+ return $self if $self->{isReduced} || $self->length < 2;
+ my @data = (sort {$a <=> $b} ($self->value));
+ my @set = ();
+ while (scalar(@data)) {
+ push(@set,shift(@data));
+ shift(@data) while (scalar(@data) && $set[-1] == $data[0]);
+ }
+ return $pkg->make(@set)->with(isReduced=>1);
+}
+
###########################################################################
1;
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.54
retrieving revision 1.55
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.54 -r1.55
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -21,6 +21,8 @@
showTypeWarnings => 1,
showEqualErrors => 1,
ignoreStrings => 1,
+ studentsMustReduceUnions => 1,
+ showUnionReduceWarnings => 1,
)}
sub cmp {
@@ -62,6 +64,12 @@
showExtraParens => 1, # make student answer painfully unambiguous
reduceConstants => 0, # don't combine student constants
reduceConstantFunctions => 0, # don't reduce constant functions
+ ($ans->{studentsMustReduceUnions} ?
+ (reduceUnions => 0, reduceSets => 0,
+ reduceUnionsForComparison => $ans->{showUnionReduceWarnings},
+ reduceSetsForComparison => $ans->{showUnionReduceWarnings}) :
+ (reduceUnions => 1, reduceSets => 1,
+ reduceUnionsForComparison => 1, reduceSetsForComparison => 1)),
($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
$self->cmp_contextFlags($ans), # any additional ones from the object itself
);
@@ -234,6 +242,33 @@
sub cmp_contextFlags {return ()}
#
+# For reducing Unions, Sets and Intervals
+#
+sub cmp_checkUnionReduce {
+ my $self = shift; my $ans = shift;
+ return unless $ans->{studentsMustReduceUnions} &&
+ $ans->{showUnionReduceWarnings} &&
+ !$ans->{isPreview};
+ my $student = $ans->{student_value};
+ return unless defined($student) && !Value::isFormula($student);
+ if ($student->type eq 'Union' && $student->length >= 2) {
+ my $reduced = $student->reduce;
+ return "Your union can be written in a simpler form"
+ unless $reduced->type eq 'Union' && $reduced->length == $student->length;
+ my @R = $reduced->value; my @S = sort {$a <=> $b} $student->value;
+ foreach my $i (0..$#R) {
+ return "Your union can be written in a simpler form"
+ unless $R[$i] == $S[$i];
+ }
+ } elsif ($student->type eq 'Set') {
+ my $reduced = $student->reduce;
+ return "Your set must have no redundant elements"
+ unless $reduced->length == $student->length;
+ }
+ return;
+}
+
+#
# create answer rules of various types
#
sub ans_rule {shift; pgCall('ans_rule',@_)}
@@ -779,6 +814,16 @@
}
#
+# Check for unreduced unions and sets
+#
+sub cmp_equal {
+ my $self = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ $self->SUPER::cmp_equal($ans);
+}
+
+#
# Check for wrong enpoints and wrong type of endpoints
#
sub cmp_postprocess {
@@ -832,12 +877,15 @@
#
# Use the list checker if the student answer is a set
# otherwise use the standard compare (to get better
-# error messages
+# error messages). But check for unreduced unions
+# and sets first.
#
sub cmp_equal {
my ($self,$ans) = @_;
- Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
- Value::cmp_equal(@_);
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
+ $self->SUPER::cmp_equal($ans);
}
#############################################################
@@ -867,7 +915,15 @@
entry_type => 'an interval or set',
)}
-sub cmp_equal {Value::List::cmp_equal(@_)}
+#
+# Check for unreduced sets and unions
+#
+sub cmp_equal {
+ my $self = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ Value::List::cmp_equal($self,$ans);
+}
#############################################################
@@ -906,6 +962,7 @@
sub cmp {
my $self = shift;
my $cmp = $self->SUPER::cmp(@_);
+ $cmp->{rh_ans}{showUnionReduceWarnings} = 0;
if ($cmp->{rh_ans}{removeParens}) {
$self->{open} = $self->{close} = '';
$cmp->ans_hash(correct_ans => $self->stringify)
@@ -1010,6 +1067,17 @@
}
#
+ # If all the entries are in error, don't give individual messages
+ #
+ if ($score == 0) {
+ my $i = 0;
+ while ($i <= $#errors) {
+ if ($errors[$i++] =~ m/^Your .* is incorrect$/)
+ {splice(@errors,--$i,1)}
+ }
+ }
+
+ #
# Finalize the score
#
$score = 0 if ($score != $maxscore && !$partialCredit);
@@ -1212,7 +1280,7 @@
# Use the list checker if the formula is a list or union
# Otherwise use the normal checker
#
- if ($self->type =~ m/^(List|Union)$/) {
+ if ($self->type =~ m/^(List|Union|Set)$/) {
Value::List::cmp_equal($self,$ans);
} else {
$self->SUPER::cmp_equal($ans);
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.23 -r1.24
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -161,7 +161,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- return Value::Union->new($l,$r);
+ Value::Union::form($l,$r);
}
sub dot {my $self = shift; $self->add(@_)}
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.16 -r1.17
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -30,7 +30,8 @@
return $x if $x->type =~ m/Interval|Union|Set/;
Value::Error("Formula does not return an Interval, Set or Union");
}
- return $self->new(promote($x));
+ $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;
@@ -55,7 +56,9 @@
}
}
return $self->formula(@intervals) if $isFormula;
- bless {data => [@intervals], canBeInterval => 1}, $class;
+ my $union = form(@intervals);
+ $union = $self->make($union) unless $union->type eq 'Union';
+ return $union;
}
#
@@ -70,12 +73,15 @@
#
# Make a union or interval or set, depending on how
-# many there are in the union
+# many there are in the union, and mark the
+#
#
sub form {
- return @_[0] if scalar(@_) == 1;
+ return $_[0] if scalar(@_) == 1;
return Value::Set->new() if scalar(@_) == 0;
- $pkg->new(@_);
+ my $union = $pkg->make(@_);
+ $union = $union->reduce if $union->getFlag('reduceUnions');
+ return $union;
}
#
@@ -112,8 +118,9 @@
my $x = shift;
return Value::Set->new($x,@_)
if scalar(@_) > 0 || ref($x) eq 'ARRAY' || Value::isRealNumber($x);
- return $x if Value::class($x) =~ m/Interval|Union|Set/;
- return Value::Interval::promote($x) if Value::class($x) eq 'List';
+ 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/;
Value::Error("Can't convert %s to an Interval, Set or Union",Value::showClass($x));
}
@@ -129,9 +136,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- $l = $pkg->make($l) if ($l->class ne 'Union');
- $r = $pkg->make($r) if ($r->class ne 'Union');
- return $pkg->make(@{$l->data},@{$r->data});
+ form(@{$l->data},@{$r->data});
}
sub dot {my $self = shift; $self->add(@_)}
@@ -142,9 +147,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- my $ll = [($l->class eq 'Union')? $l->value: $l];
- my $rr = [($r->class eq 'Union')? $r->value: $r];
- form(subUnionUnion($ll,$rr));
+ form(subUnionUnion($l->data,$r->data));
}
#
@@ -183,8 +186,10 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
$r = promote($r);
+ if ($l->getFlag('reduceUnionsForComparison')) {$l = $l->reduce; $r = $r->reduce}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} $l->value; my @r = sort {$a <=> $b} $r->value;
+ my @l = sort {$a <=> $b} $l->value;
+ my @r = sort {$a <=> $b} $r->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -192,7 +197,51 @@
return scalar(@l) - scalar(@r);
}
-# @@@ simplify (combine intervals, if possible) @@@
+############################################
+#
+# Reduce unions to simplest form
+#
+
+sub reduce {
+ my $self = shift;
+ return $self if $self->{isReduced} || $self->length < 2;
+ my @singletons = (); my @intervals = ();
+ foreach my $x ($self->value) {
+ if ($x->type eq 'Set') {push(@singletons,$x->value)}
+ elsif ($x->{data}[0] == $x->{data}[1]) {push(@singletons,$x->{data}[0])}
+ else {push(@intervals,$x)}
+ }
+ my @union = (); my @set = (); my $prevX;
+ @intervals = (sort {$a <=> $b} @intervals);
+ ELEMENT: foreach my $x (@singletons) {
+ next if defined($prevX) && $prevX == $x; $prevX = $x;
+ foreach my $I (@intervals) {
+ my ($a,$b) = $I->value;
+ last if $x < $a;
+ if ($x > $a && $x < $b) {next ELEMENT}
+ elsif ($x == $a) {$I->{open} = '['; next ELEMENT}
+ elsif ($x == $b) {$I->{close} = ']'; next ELEMENT}
+ }
+ push(@set,$x);
+ }
+ while (scalar(@intervals) > 1) {
+ my $I = shift(@intervals); my $J = $intervals[0];
+ my ($a,$b) = $I->value; my ($c,$d) = $J->value;
+ if ($b < $c || ($b == $c && $I->{close} eq ')' && $J->{open} eq '(')) {
+ push(@union,$I);
+ } else {
+ if ($a < $c) {$J->{data}[0] = $a; $J->{open} = $I->{open}}
+ else {$J->{open} = '[' if $I->{open} eq '['}
+ if ($b > $d) {$J->{data}[1] = $b; $J->{close} = $I->{close}}
+ else {$J->{close} = ']' if $b == $d && $I->{close} eq ']'}
+ }
+ }
+ push(@union,@intervals);
+ push(@union,Value::Set->make(@set)) unless scalar(@set) == 0;
+ return Value::Set->new() if scalar(@union) == 0;
+ return $union[0] if scalar(@union) == 1;
+ return $pkg->make(@union)->with(isReduced=>1);
+}
############################################
#
|
