r11253 - in /branches/upstream/libset-scalar-perl/current: ChangeLog MANIFEST META.yml Makefile.PL lib/Set/Scalar.pm lib/Set/Scalar/Base.pm t/cartesian.t t/clear.t t/laws.t t/power_set.t
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Mon Dec 17 00:58:39 UTC 2007
Author: tincho-guest
Date: Mon Dec 17 00:58:38 2007
New Revision: 11253
URL: http://svn.debian.org/wsvn/?sc=1&rev=11253
Log:
[svn-upgrade] Integrating new upstream version, libset-scalar-perl (1.22)
Added:
branches/upstream/libset-scalar-perl/current/t/cartesian.t
branches/upstream/libset-scalar-perl/current/t/power_set.t
Modified:
branches/upstream/libset-scalar-perl/current/ChangeLog
branches/upstream/libset-scalar-perl/current/MANIFEST
branches/upstream/libset-scalar-perl/current/META.yml
branches/upstream/libset-scalar-perl/current/Makefile.PL
branches/upstream/libset-scalar-perl/current/lib/Set/Scalar.pm
branches/upstream/libset-scalar-perl/current/lib/Set/Scalar/Base.pm
branches/upstream/libset-scalar-perl/current/t/clear.t
branches/upstream/libset-scalar-perl/current/t/laws.t
Modified: branches/upstream/libset-scalar-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/ChangeLog?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/ChangeLog (original)
+++ branches/upstream/libset-scalar-perl/current/ChangeLog Mon Dec 17 00:58:38 2007
@@ -1,3 +1,24 @@
+2007-10-23 Jarkko Hietaniemi <jhi at iki.fi>
+
+ * Add cartesian_product() and power_set(), both as full
+ constructors and as iterators.
+
+ * Add empty_clone().
+
+ * Makefile.PL not requiring Test::More since we are not using it.
+
+ * Released as 1.22.
+
+2007-10-04 Jarkko Hietaniemi <jhi at iki.fi>
+
+ * Made to work with the upcoming Perl 5.005_05
+ (yes, you read that right), most importantly
+ Scalar::Util made optional (we fall back to
+ pure Perl emulations for blessed() and refaddr()
+ if necessary). Everything else already worked.
+
+ * Released as 1.21.
+
Sat Aug 6 12:39:43 2005 Jarkko Hietaniemi <jhi at iki.fi>
* [cpan #13816] Set::Scalar blesses unblessed refs
@@ -27,6 +48,8 @@
Trying to use the suggested fix also badly breaks the
laws.t when the universal and null sets are present.
+ * Released as 1.20.
+
Sun Mar 28 17:16:26 2004 Jarkko Hietaniemi <jhi at iki.fi>
* [cpan #5829] When is_disjoint() was called in list
@@ -48,7 +71,7 @@
* Added is_empty() and empty() aliases for is_null()
and null(); from Peter Oliver.
- * In the display callack discussion show by example
+ * In the display callback discussion show by example
that one can use the same callback for several sets
(instead of generating a new anonymous subroutine each time),
and clarify the class versus object method wording.
Modified: branches/upstream/libset-scalar-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/MANIFEST?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/MANIFEST (original)
+++ branches/upstream/libset-scalar-perl/current/MANIFEST Mon Dec 17 00:58:38 2007
@@ -13,6 +13,7 @@
t/basic.t
t/basic_overload.t
t/boolean.t
+t/cartesian.t
t/clear.t
t/compare.t
t/custom_display.t
@@ -24,6 +25,7 @@
t/member.t
t/misc.t
t/null.t
+t/power_set.t
t/set_set.t
t/symmdiff.t
t/union.t
Modified: branches/upstream/libset-scalar-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/META.yml?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/META.yml (original)
+++ branches/upstream/libset-scalar-perl/current/META.yml Mon Dec 17 00:58:38 2007
@@ -1,12 +1,10 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Set-Scalar
-version: 1.20
+version: 1.22
version_from: lib/Set/Scalar.pm
installdirs: site
requires:
- Scalar::Util: 0
- Test::More: 0
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30
Modified: branches/upstream/libset-scalar-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/Makefile.PL?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/Makefile.PL (original)
+++ branches/upstream/libset-scalar-perl/current/Makefile.PL Mon Dec 17 00:58:38 2007
@@ -10,9 +10,11 @@
'dist' => { 'COMPRESS' => 'gzip' },
PREREQ_PM =>
{
- 'Scalar::Util' => 0,
- 'Test::More' => 0,
+ # 'Scalar::Util' => 0, # Not a requirement anymore.
+ # 'Test::More' => 0,
},
)
and
-print "Now issue 'make' and then 'make test', and if all looks good, 'make install'.\n";
+print <<__EOF__;
+Now issue 'make' and then 'make test', and if all looks good, 'make install'.
+__EOF__
Modified: branches/upstream/libset-scalar-perl/current/lib/Set/Scalar.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/lib/Set/Scalar.pm?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/lib/Set/Scalar.pm (original)
+++ branches/upstream/libset-scalar-perl/current/lib/Set/Scalar.pm Mon Dec 17 00:58:38 2007
@@ -1,13 +1,11 @@
package Set::Scalar;
use strict;
-local $^W = 1;
+# local $^W = 1;
use vars qw($VERSION @ISA);
-$VERSION = '1.20';
-
-use Scalar::Util qw(blessed refaddr);
+$VERSION = '1.22';
@ISA = qw(Set::Scalar::Real Set::Scalar::Null Set::Scalar::Base);
@@ -62,15 +60,16 @@
$s = Set::Scalar->new(@members);
$t = $s->clone;
- $t = $s->copy; # clone of clone
+ $t = $s->copy; # Clone of clone.
+ $t = $s->empty_clone; # Like clone() but with no members.
=head2 Modifying
$s->insert(@members);
$s->delete(@members);
- $s->invert(@members); # insert if hasn't, delete if has
-
- $s->clear; # removes all the elements
+ $s->invert(@members); # Insert if hasn't, delete if has.
+
+ $s->clear; # Removes all the elements.
Note that clear() only releases the memory used by the set to
be reused by Perl; it will not reduce the overall memory use.
@@ -89,25 +88,25 @@
=head2 Querying
@members = $s->members;
- @elements = $s->elements; # alias for members
-
- $size = $s->size; # the number of members
-
- $s->has($m) # return true if has that member
- $s->contains($m) # alias for has
+ @elements = $s->elements; # Alias for members.
+
+ $size = $s->size; # The number of members.
+
+ $s->has($m) # Return true if has that member.
+ $s->contains($m) # Alias for has().
if ($s->has($member)) { ... }
- $s->member($m) # returns the member if has that member
- $s->element($m) # alias for member
-
- $s->is_null # returns true if the set is empty
- $s->is_empty # alias for is_null
- $s->is_universal # returns true if the set is universal
-
- $s->null # the null set
- $s->empty # alias for null
- $s->universe # the universe of the set
+ $s->member($m) # Returns the member if has that member.
+ $s->element($m) # Alias for member.
+
+ $s->is_null # Returns true if the set is empty.
+ $s->is_empty # Alias for is_null.
+ $s->is_universal # Returns true if the set is universal.
+
+ $s->null # The null set.
+ $s->empty # Alias for null.
+ $s->universe # The universe of the set.
=head2 Deriving
@@ -120,12 +119,12 @@
These methods have operator overloads:
- $u = $s + $t; # union
- $i = $s * $t; # intersection
- $d = $s - $t; # difference
- $e = $s % $t; # symmetric_difference
- $v = $s / $t; # unique
- $c = -$s; # complement
+ $u = $s + $t; # union
+ $i = $s * $t; # intersection
+ $d = $s - $t; # difference
+ $e = $s % $t; # symmetric_difference
+ $v = $s / $t; # unique
+ $c = -$s; # complement
Both the C<symmetric_difference> and C<unique> are symmetric on all
their arguments. For two sets they are identical but for more than
@@ -172,13 +171,13 @@
These methods have operator overloads:
- $eq = $s == $t; # is_equal
- $dj = $s != $t; # is_disjoint
+ $eq = $s == $t; # is_equal
+ $dj = $s != $t; # is_disjoint
# No operator overload for is_properly_intersecting.
- $ps = $s < $t; # is_proper_subset
- $pS = $s > $t; # is_proper_superset
- $is = $s <= $t; # is_subset
- $iS = $s >= $t; # is_superset
+ $ps = $s < $t; # is_proper_subset
+ $pS = $s > $t; # is_proper_superset
+ $is = $s <= $t; # is_subset
+ $iS = $s >= $t; # is_superset
$cmp = $s <=> $t;
@@ -218,11 +217,11 @@
When no more elements remain C<undef> is returned. Since you may one
day have elements named C<0> don't test just like this
- while (my $e = $s->each) { ... } # WRONG
+ while (my $e = $s->each) { ... } # WRONG!
but instead like this
- while (defined(my $e = $s->each)) { ... } # right
+ while (defined(my $e = $s->each)) { ... } # Right.
(An C<undef> as a set element doesn't really work, you get C<"">.)
@@ -244,6 +243,86 @@
=back
+=head2 Cartesian Product and Power Set
+
+=over 4
+
+=item *
+
+Cartesian product is a product of two or more sets. For two sets, it
+is the set consisting of B<ordered pairs> of members from each set.
+For example for the sets
+
+ (a b)
+ (c d e)
+
+The Cartesian product of the above is the set
+
+ ([a, c] [a, d] [a, e] [b, c] [b, d] [b, e])
+
+The [,] notation is for the ordered pairs, which sets are are not.
+This means two things: firstly, that [e, b] is B<not> in the above
+Cartesian product, and secondly, [b, b] is a possibility:
+
+ (a b)
+ (b c e)
+
+ ([a, b] [a, c] [a, e] [b, b] [b, c] [b, d])
+
+For example:
+
+ my $a = Set::Scalar->new(1..2);
+ my $b = Set::Scalar->new(3..5);
+ my $c = $a->cartesian_product($b); # As an object method.
+ my $d = Set::Scalar->cartesian_product($a, $b); # As a class method.
+
+The $c and $d will be of the same class as $a. The members of $c and
+$c in the above will be anonymous arrays (array references), not sets,
+since sets wouldn't be able to represent the ordering or that a member
+can be present more than once. Also note that since the members of
+the input sets are unordered, the ordered pairs themselves are
+unlikely to be in any particular order.
+
+If you don't want to construct the Cartesian product set, you can
+construct an iterator and call it while it returns more members:
+
+ my $iter = Set::Scalar->cartesian_product_iterator($a, $b, $c);
+ while (my @m = $iter->()) {
+ process(@m);
+ }
+
+=item *
+
+Power set is the set of all the subsets of a set. If the set has N
+members, its power set has 2**N members. For example for the set
+
+ (a b c)
+
+size 3, its power set is
+
+ (() (a) (b) (c) (a b) (a c) (b c) (a b c))
+
+size 8. Note that since the elements of the power set are sets, they
+are unordered, and therefore (b c) is equal to (c b). For example:
+
+ my $a = Set::Scalar->new(1..3);
+ my $b = $a->power_set; # As an object method.
+ my $c = Set::Scalar->power_set($a); # As a class method.
+
+Even the empty set has a power set, of size one.
+
+If you don't want to construct the power set, you can construct an
+iterator and call it until it returns no more members:
+
+ my $iter = Set::Scalar->power_set($a);
+ my @m;
+ do {
+ @m = $iter->();
+ process(@m);
+ } while (@m);
+
+=back
+
=head2 Customising Display
If you want to customise the display routine you will have to
Modified: branches/upstream/libset-scalar-perl/current/lib/Set/Scalar/Base.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/lib/Set/Scalar/Base.pm?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/lib/Set/Scalar/Base.pm (original)
+++ branches/upstream/libset-scalar-perl/current/lib/Set/Scalar/Base.pm Mon Dec 17 00:58:38 2007
@@ -11,7 +11,34 @@
use UNIVERSAL 'isa';
-use Scalar::Util qw(refaddr blessed);
+BEGIN {
+ eval 'require Scalar::Util';
+ unless ($@) {
+ import Scalar::Util qw(blessed refaddr);
+ } else {
+ # Use the pure Perl emulations (directly snagged from Scalar::Util).
+ eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
+ *blessed = sub ($) {
+ local($@, $SIG{__DIE__}, $SIG{__WARN__});
+ length(ref($_[0]))
+ ? eval { $_[0]->a_sub_not_likely_to_be_here }
+ : undef
+ };
+ *refaddr = sub ($) {
+ my $pkg = ref($_[0]) or return undef;
+ if (blessed($_[0])) {
+ bless $_[0], 'Scalar::Util::Fake';
+ }
+ else {
+ $pkg = undef;
+ }
+ "$_[0]" =~ /0x(\w+)/;
+ my $i = do { local $^W; hex $1 };
+ bless $_[0], $pkg if defined $pkg;
+ $i;
+ };
+ }
+}
@EXPORT_OK = qw(_make_elements
as_string
@@ -69,7 +96,7 @@
my $self = { };
- bless $self, $class;
+ bless $self, ref $class || $class;
$self->_new_hook( \@_ );
@@ -160,13 +187,19 @@
return $e;
}
+sub _empty_clone {
+ my $self = shift;
+ my $original = shift;
+
+ $self->{'universe'} = $original->{'universe'};
+ $self->{'null' } = $original->{'null' };
+}
+
sub _clone {
my $self = shift;
my $original = shift;
- $self->{'universe'} = $original->{'universe'};
-
- $self->{'null' } = $original->{'null' };
+ $self->_empty_clone($original);
$self->_insert( $original->{'elements'} );
}
@@ -181,6 +214,15 @@
}
*copy = \&clone;
+
+sub empty_clone {
+ my $self = shift;
+ my $clone = (ref $self)->new;
+
+ $clone->_empty_clone( $self );
+
+ return $clone;
+}
sub clear {
my $self = shift;
@@ -435,6 +477,91 @@
my $this = shift;
return $this->_unique( @_ );
+}
+
+sub _make_cartesian_product_iterator {
+ my @iter;
+ my @value;
+ for my $set (@_) {
+ return unless $set->isa('Set::Scalar');
+ my @member = $set->members;
+ my %member;
+ @member{@member} = @member;
+ push @iter, \%member;
+ push @value, scalar CORE::each(%{ $iter[-1] });
+ }
+ return sub {
+ return unless @iter;
+ my @now = @value;
+ my $ix;
+ for ($ix = $#iter; $ix >= 0; $ix--) {
+ my $next = CORE::each(%{ $iter[$ix] });
+ if (defined $next) {
+ $value[$ix] = $next;
+ last;
+ } else {
+ keys %{ $iter[$ix] }; # Reset the iterator.
+ $value[$ix] = CORE::each(%{ $iter[$ix] });
+ }
+ }
+ if ($ix < 0) {
+ @iter = (); # All done.
+ }
+ return @now;
+ };
+}
+
+sub cartesian_product_iterator {
+ shift unless ref $_[0];
+ return &_make_cartesian_product_iterator;
+}
+
+sub cartesian_product {
+ my $iterator = &cartesian_product_iterator;
+ return unless defined $iterator;
+ my $product = $_[0]->empty_clone;
+ while (my @member = $iterator->()) {
+ $product->insert(\@member);
+ }
+ return $product;
+}
+
+sub _make_power_set_iterator {
+ return unless $_[0]->isa('Set::Scalar');
+ my @member = $_[0]->members;
+ my @iter = (0) x @member;
+ return sub {
+ return unless @iter;
+ my $ix;
+ for ($ix = 0; $ix < @iter; $ix++) {
+ if ($iter[$ix]++ == 0) {
+ last;
+ } else {
+ $iter[$ix] = 0;
+ }
+ }
+ if ($ix == @iter) {
+ @iter = (); # All done.
+ }
+ return map { $member[$_] } grep { $iter[$_] } 0..$#iter;
+ };
+}
+
+sub power_set_iterator {
+ shift unless ref $_[0];
+ return &_make_power_set_iterator;
+}
+
+sub power_set {
+ my $iterator = &power_set_iterator;
+ return unless defined $iterator;
+ my $power = $_[0]->empty_clone;
+ my @member;
+ do {
+ @member = $iterator->();
+ $power->insert($_[0]->empty_clone->insert(@member));
+ } while (@member);
+ return $power;
}
sub is_universal {
Added: branches/upstream/libset-scalar-perl/current/t/cartesian.t
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/t/cartesian.t?rev=11253&op=file
==============================================================================
--- branches/upstream/libset-scalar-perl/current/t/cartesian.t (added)
+++ branches/upstream/libset-scalar-perl/current/t/cartesian.t Mon Dec 17 00:58:38 2007
@@ -1,0 +1,65 @@
+use Set::Scalar;
+
+print "1..9\n";
+
+my $a = Set::Scalar->new(1..2);
+my $b = Set::Scalar->new(3..5);
+
+my $c = $a->cartesian_product($b);
+my $d = Set::Scalar->cartesian_product($a, $b);
+my $e = $a->cartesian_product($a);
+my $f = $a->cartesian_product();
+my $g = Set::Scalar->cartesian_product($a, $b, $b);
+my $h = Set::Scalar->cartesian_product($a, $c);
+
+print "not " unless $c->members == 6;
+print "ok 1\n";
+
+print "not " unless $d->members == 6;
+print "ok 2\n";
+
+print "not " unless $e->members == 4;
+print "ok 3\n";
+
+print "not " unless $f->members == 2;
+print "ok 4\n";
+
+sub verify {
+ my ($p, @q) = @_;
+ my @p = $p->members;
+ return unless @p == @q;
+ my %p; @p{ map { "@$_" } @p } = @p;
+ my %q; @q{ map { "@$_" } @q } = @q;
+ my %P = %p; delete @P{ keys %q };
+ my %Q = %q; delete @Q{ keys %p };
+ return keys %P == 0 && keys %Q == 0;
+}
+
+print "not " unless verify($c,
+ [1, 3], [1, 4], [1, 5],
+ [2, 3], [2, 4], [2, 5]);
+print "ok 5\n";
+
+print "not " unless verify($d,
+ [1, 3], [1, 4], [1, 5],
+ [2, 3], [2, 4], [2, 5]);
+print "ok 6\n";
+
+print "not " unless verify($e,
+ [1, 2], [1, 1],
+ [2, 1], [2, 2]);
+print "ok 7\n";
+
+print "not " unless verify($f,
+ [1], [2]);
+print "ok 8\n";
+
+print "not " unless verify($g,
+ [1, 3, 3], [1, 4, 3], [1, 5, 3],
+ [2, 3, 3], [2, 4, 3], [2, 5, 3],
+ [1, 3, 4], [1, 4, 4], [1, 5, 4],
+ [2, 3, 4], [2, 4, 4], [2, 5, 4],
+ [1, 3, 5], [1, 4, 5], [1, 5, 5],
+ [2, 3, 5], [2, 4, 5], [2, 5, 5]);
+print "ok 9\n";
+
Modified: branches/upstream/libset-scalar-perl/current/t/clear.t
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/t/clear.t?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/t/clear.t (original)
+++ branches/upstream/libset-scalar-perl/current/t/clear.t Mon Dec 17 00:58:38 2007
@@ -1,6 +1,6 @@
use Set::Scalar;
-print "1..1\n";
+print "1..2\n";
my $s = Set::Scalar->new(0..99);
@@ -9,3 +9,6 @@
print "not " unless $s->is_null;
print "ok 1\n";
+print "not " unless $s->members == 0;
+print "ok 2\n";
+
Modified: branches/upstream/libset-scalar-perl/current/t/laws.t
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/t/laws.t?rev=11253&op=diff
==============================================================================
--- branches/upstream/libset-scalar-perl/current/t/laws.t (original)
+++ branches/upstream/libset-scalar-perl/current/t/laws.t Mon Dec 17 00:58:38 2007
@@ -4,7 +4,7 @@
$| = 1;
-print STDERR "(WARNING: this will take a while)...";
+print STDERR "(WARNING: this can take a while)...";
my $t = 1;
Added: branches/upstream/libset-scalar-perl/current/t/power_set.t
URL: http://svn.debian.org/wsvn/branches/upstream/libset-scalar-perl/current/t/power_set.t?rev=11253&op=file
==============================================================================
--- branches/upstream/libset-scalar-perl/current/t/power_set.t (added)
+++ branches/upstream/libset-scalar-perl/current/t/power_set.t Mon Dec 17 00:58:38 2007
@@ -1,0 +1,53 @@
+use Set::Scalar;
+
+print "1..6\n";
+
+my $a = Set::Scalar->new(1..3);
+my $b = Set::Scalar->new();
+
+my $c = $a->power_set;
+my $d = Set::Scalar->power_set($a);
+my $e = $b->power_set;
+
+print "not " unless $c->members == 8;
+print "ok 1\n";
+
+print "not " unless $d->members == 8;
+print "ok 2\n";
+
+print "not " unless $e->members == 1;
+print "ok 3\n";
+
+sub verify {
+ my ($p, @q) = @_;
+ my @p = $p->members;
+ return unless @p == @q;
+ @q = map { Set::Scalar->new(@$_) } @q;
+ my %p; @p{ map { "$_" } @p } = @p;
+ my %q; @q{ map { "$_" } @q } = @q;
+ my %P = %p; delete @P{ keys %q };
+ my %Q = %q; delete @Q{ keys %p };
+ return keys %P == 0 && keys %Q == 0;
+}
+
+print "not " unless verify($c,
+ [],
+ [1], [2], [3],
+ [1, 2], [1, 3], [2, 3],
+ [1, 2, 3]);
+print "ok 4\n";
+
+print "not " unless verify($d,
+ [],
+ [1], [2], [3],
+ [1, 2], [1, 3], [2, 3],
+ [1, 2, 3]);
+print "ok 5\n";
+
+print "not " unless verify($e,
+ []);
+print "ok 6\n";
+
+
+
+
More information about the Pkg-perl-cvs-commits
mailing list