Set-Scalar-1.29/0000755000175000017500000000000012314042712012675 5ustar davidodavidoSet-Scalar-1.29/ChangeLog0000644000175000017500000002015112314042277014454 0ustar davidodavido1.29 2014-03-24 Dave Oswald * Fixed set operations examples in POD (Xaerxess via GitHub). 1.28 2014-02-24 Dave Oswald * Fix POD example showing power_set() method returning an iterator. Now it correctly demonstrates power_set_iterator() returning an iterator. (Response to report from vagabonding_electron on PerlMonks.) 1.27 2013-12-31 Dave Oswald * Merge pull request for typo fix in POD. * Merge pull request for adding meta-data via Makefile.PL. * ChangeLog is more standards compliant. * Module POD now mentions current maintainer, and GitHub repo. 1.26 2013-06-15 Jarkko Hietaniemi * Fixed "Set::Scalar::Valued" [rt.cpan.org #69037], bug reported and fix supplied by Kiran Mukhyala, the problem was in null() not being defined for valued set universes. * Fixed qq[More whitespace in examples could show "picture" of operations] [rt.cpan.org #54172 and #54173], bug reported and fix supplied by MichaelRWolf. (ASCII art, so relies on fixed-width font.) 1.25 2009-12-27 Jarkko Hietaniemi * Fixed "trying to add an element twice prevents further adds to the set" [rt.cpan.org #52559], bug reported by Eduard Wulff. * Removed unused and deprecated (Perl 5.12?) "use UNIVERSAL 'isa'" from Set/Scalar/Virtual.pm. * Add tests for the copy overload. 1.24 2009-06-02 Jarkko Hietaniemi * Fixed "The intersection method does not like references in the set." [rt.cpan.org #46589], bug reported and fix provided by Father Chrysostomos. * Cosmetics: removed trailing whitespace. * Renamed README as README.old. It has been close to ten years. * Added new README. * Updated copyright years. 1.23 2009-01-16 Jarkko Hietaniemi * Add overload for '@{}' as suggested by John Loverso, meaning that you can now do @$set and get the members of the set (unordered, mind) * Add overload for '=' (how did we manage so long without?) [rt.cpan.org #42449] * Remove explicit import of UNIVERSAL::isa() [rt.cpan.org #42451] * Modernize META.yml. 1.22 2007-10-23 Jarkko Hietaniemi * 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. 1.21 2007-10-04 Jarkko Hietaniemi * 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. 1.20 2005-08-06 Jarkko Hietaniemi * [cpan #13816] Set::Scalar blesses unblessed refs A genuine bug, the suggested fix used, but then again Set::Scalar was never designed or tested be used with references as the set members. I would not recommend doing that unless much more testing has been conducted. A test added to misc.t for that, and a warning about using references as the set members added to the pod. * [cpan #13856] funny behavior in Set::Scalar::Base::intersection and Set::Scalar::Base::union A genuine bug, but the suggested fix as-is would break the special cases of intersecting with the null set and unioning with the universal set. A slightly enhanced version of the fix used instead, tests added to intersection.t and union.t. * [cpan #13857] Set::Scalar::Base::_binary_underload bug Not really a bug. The _binary_underload() method is only ever going to be called by Set::Scalar itself, or by classes derived from Set::Scalar, so the assumption that all references are object and that they are capable of calling the new() method (i.e. being instance of Set::Scalar) is completely valid. Trying to use the suggested fix also badly breaks the laws.t when the universal and null sets are present. 1.19 2004-03-28 Jarkko Hietaniemi * [cpan #5829] When is_disjoint() was called in list context, and the result was disjoint (not disjoint universes), the return value was a list with one undef element, from Alexei. 1.18 2003-10-04 Jarkko Hietaniemi * Removed a cut-and-paste bug from symmetric_difference(); from frederik. 1.17 2001-12-08 Jarkko Hietaniemi * Added is_empty() and empty() aliases for is_null() and null(); from Peter Oliver. * 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. 1.16 2001-10-23 Jarkko Hietaniemi * Allow customising the set display: as_string_callback(). * Got the acknoledgement about the clear() idea wrong: it was Dave Lewis, not Dan Berger. * Document that the clear() does not really release the memory. 1.15 2001-10-22 Jarkko Hietaniemi * Documentation and whitespace nits. 1.14 2001-10-20 Jarkko Hietaniemi * Changed has() and contains() to return boolean, not the member, as pointed out by Mark Dilger. * Add clear() method to remove all the elements, as suggested by Dave Lewis. Doesn't release the memory to the operating system, though (in general, Perl doesn't), just releases the memory to be reused by Perl, so don't expect your memory footprint go down when you clear your gigaset. 1.12 2001-10-13 Jarkko Hietaniemi * Add each() as a lighter weight way of iterating over sets, as suggested by Dave Lewis. 1.11 Wed 2001-10-10 Jarkko Hietaniemi * In boolean contexts the string representation of sets is not the best possible one, reported by Dan Berger. Now the size of the set is returned in boolean contexts. 1.10 2001-08-03 Jarkko Hietaniemi * Added COPYRIGHT and LICENSE. 1.09 2001-05-07 Jarkko Hietaniemi * Annotation mixup: The fix known as 1.08 by Mark Dilger, not Joy Koenig. 1.08 2001-05-07 Jarkko Hietaniemi * Set::Scalar()->new() - Set::Scalar()->new() didn't equal Set::Scalar()->new(), thanks to wrong inheritance order. Spotted and most graciously fixed by Joy Koenig. 1.07 2001-05-05 Jarkko Hietaniemi * Union could end up returning a true universe, from which one cannot delete elements (e.g. using difference), bug reported by Malcolm Purvis. The fix (which was applied to all of the union+intersection+difference+symmetric_difference) was to 'downgrade' results of the same size as the first argument. * Set::Scalar called itself Set::Scalar::Base. 1.06 2001-02-10 Jarkko Hietaniemi * Make the code Perl 5.00404-proof, patch from Ed Grimm. 1.04 2001-01-18 Jarkko Hietaniemi * Add examples of the set differences. * NOTE: unique now returns a set, not a list of elements, as it was documented and intended. * unique() was rather broken, reported by Malcolm Purvis. 1.03 2000-10-31 Jarkko Hietaniemi * Use a custom overloaded data stringification routine instead of overload::StrVal(). This solves the memory leak reported by Joshua Richardson _and_ speeds up the code by about 40%! (make test timings) 1.02 2000-09-15 Jarkko Hietaniemi * Null sets weren't subsets of every set in comparisons. Noticed by Gerard Vreeswijk . 1.01 2000-04-15 Jarkko Hietaniemi * Make to work with perl 5.6.0. * Release as 1.01 as no bug reports have been seen for many moons. 0.901 1999-09-24 Jarkko Hietaniemi * Paul Schinder reported that the set_set.t subtest #5 produces "(a (b (a (c ...) ...)) (c ...))" for him, not "(a (b (a ...)) (c ...))" as expected. Nondeterminism in stringification. Not yet resolved but the test hacked to allow either (for subtests #5 and #6). * Timothy Kimball reported that Set::Scalar 0.9 had the super/subsetness the wrong way round. Fixed. Set-Scalar-1.29/Makefile.PL0000644000175000017500000000165312303025122014646 0ustar davidodavidoprint "Welcome to Set::Scalar!\n" unless -f "Makefile"; require 5.004_04; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Set::Scalar', 'VERSION_FROM' => 'lib/Set/Scalar.pm', 'dist' => { 'COMPRESS' => 'gzip' }, PREREQ_PM => { }, AUTHOR => 'Jarkko Hietaniemi ', META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/daoswald/Set-Scalar.git', web => 'https://github.com/daoswald/Set-Scalar', }, }, }, ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl', ) : ()), ) and print <<__EOF__; Now issue 'make' and then 'make test', and if all looks good, 'make install'. __EOF__ Set-Scalar-1.29/META.yml0000644000175000017500000000100412314042712014141 0ustar davidodavido--- abstract: unknown author: - 'Jarkko Hietaniemi ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Set-Scalar no_index: directory: - t - inc requires: {} resources: repository: https://github.com/daoswald/Set-Scalar.git version: 1.29 Set-Scalar-1.29/README0000644000175000017500000000063312303024616013560 0ustar davidodavidoThe first priority of Set::Scalar is to be a convenient interface to sets (as in: unordered colletions of Perl scalars.) While not designed to be slow or big, neither has it been designed to be fast or compact. Please see lib/Set/Scalar.pm for more information, once you have installed this module, "perldoc Set::Scalar" should work. -- jhi@iki.fi : Original author. davido@cpan.org : Current maintainer. Set-Scalar-1.29/README.old0000644000175000017500000000403612303025013014326 0ustar davidodavido---- THE FOLLOWING DOCUMENT IS PRESERVED FOR ITS HISTORICAL VALUE ONLY. ---- This is a long-waited-for (I hope) rewrite of the venerable Set::Scalar module. The original 0.00x series culminated in 0.003 back in May 1996, the 0.004 in October 1998 was just a minor update. The most egregious problem with the old implementation was that having complex things such as objects as set members (for example if sets of sets were wanted) didn't really work. While this new implementation is more correct, it may be also slower. Some operations are certainly slower, but some are faster. It all depends on your mix of operations. Displaying sets is not as versatile as with the old implementation, but then on the other hand I doubt (hope) that anybody ever used the overly baroque interface anyway. If, however, I am wrong in this, please let me know, I'll think of something. The old interface should not be revived as such, I think, it was far too clunky. The "valued sets" concept is now moved to its own subclass, Set::Scalar::Valued. (There are two meta-classes, Set::Scalar::Universe and Set::Scalar::ValuedUniverse, but do not use them overmuch, as there are still some rough edges that may change in future releases. Do not use them directly (by instantiating them yourself, for example), $set->universe is about the only method that works and will continue to work. Even more internal-use-only are the Set::Scalar::Real and Set::Scalar::Virtual. Do not try to use them directly. Their interfaces are left undocumented on purpose.) The "inverted sets" concept is history, removed, gone, not to return. You can just use -$set. Let me know what you think, did I miss anything obvious? Any old functionality that I didn't purposefully/accidentally migrate to the new one? Could the documentation be better? (a rhetorical question) Any new functionality you would like to see? (Please don't say that you want the Cartesian product: it's a concept from wholly different world, the ordered sets. My sets are unordered.) -- Jarkko Hietaniemi Set-Scalar-1.29/MANIFEST0000644000175000017500000000124612260573416014043 0ustar davidodavidoChangeLog MANIFEST Makefile.PL lib/Set/Scalar.pm lib/Set/Scalar/Base.pm lib/Set/Scalar/Null.pm lib/Set/Scalar/Real.pm lib/Set/Scalar/Universe.pm lib/Set/Scalar/Valued.pm lib/Set/Scalar/ValuedUniverse.pm lib/Set/Scalar/Virtual.pm README README.old t/basic.t t/basic_overload.t t/boolean.t t/cartesian.t t/clear.t t/compare.t t/custom_display.t t/difference.t t/each.t t/has.t t/intersection.t t/laws.t t/member.t t/misc.t t/null.t t/power_set.t t/set_set.t t/symmdiff.t t/union.t t/unique.t t/universe.t t/valued.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Set-Scalar-1.29/t/0000755000175000017500000000000012314042712013140 5ustar davidodavidoSet-Scalar-1.29/t/boolean.t0000644000175000017500000000041012260573416014751 0ustar davidodavidouse Set::Scalar; print "1..2\n"; my @a = qw(One Two Three); my @b = qw(Four Five Six); my $ssa = Set::Scalar->new(@a); my $ssb = Set::Scalar->new(@b); print "not " unless $ssa; print "ok 1\n"; print "not " if $ssa->intersection($ssb); print "ok 2\n"; Set-Scalar-1.29/t/symmdiff.t0000644000175000017500000000307012260573416015155 0ustar davidodavidouse Set::Scalar; print "1..21\n"; my $a = Set::Scalar->new("a".."e"); my $b = Set::Scalar->new("c".."g"); my $d = $a->symmetric_difference($b); print "not " unless $d eq "(a b f g)"; print "ok 1\n"; print "not " unless $a eq "(a b c d e)"; print "ok 2\n"; print "not " unless $b eq "(c d e f g)"; print "ok 3\n"; my $e = $a % $b; print "not " unless $e eq "(a b f g)"; print "ok 4\n"; print "not " unless $a eq "(a b c d e)"; print "ok 5\n"; print "not " unless $b eq "(c d e f g)"; print "ok 6\n"; my $f = $b->symmetric_difference($a); print "not " unless $f eq "(a b f g)"; print "ok 7\n"; print "not " unless $a eq "(a b c d e)"; print "ok 8\n"; print "not " unless $b eq "(c d e f g)"; print "ok 9\n"; my $g = $b % $a; print "not " unless $g eq "(a b f g)"; print "ok 10\n"; print "not " unless $a eq "(a b c d e)"; print "ok 11\n"; print "not " unless $b eq "(c d e f g)"; print "ok 12\n"; my $h = $a % "x"; print "not " unless $h eq "(a b c d e x)"; print "ok 13\n"; print "not " unless $a eq "(a b c d e)"; print "ok 14\n"; my $i = "y" % $a; print "not " unless $i eq "(a b c d e y)"; print "ok 15\n"; print "not " unless $a eq "(a b c d e)"; print "ok 16\n"; my $j = $a % "c"; print "not " unless $j eq "(a b d e)"; print "ok 17\n"; print "not " unless $a eq "(a b c d e)"; print "ok 18\n"; my $k = "e" % $a; print "not " unless $k eq "(a b c d)"; print "ok 19\n"; print "not " unless $a eq "(a b c d e)"; print "ok 20\n"; my $l = Set::Scalar->new("a", "b"); my $m = Set::Scalar->new("b", "c"); print "not " unless $l % $m eq "(a c)"; print "ok 21\n"; Set-Scalar-1.29/t/compare.t0000644000175000017500000000273212260573416014771 0ustar davidodavidouse Set::Scalar; use strict; my $t = Set::Scalar->new(qw(a b c)); my $u = Set::Scalar->new(qw(a b c)); my $v = Set::Scalar->new(qw(d e f)); my $w = Set::Scalar->new(qw(a b)); my $x = Set::Scalar->new(qw(b c d)); my $n = Set::Scalar->new(qw()); my $o = Set::Scalar->new(qw()); print "1..23\n"; print "not " unless $t == $u; print "ok 1\n"; print "not " unless $t != $v; print "ok 2\n"; print "not " if $t == $v; print "ok 3\n"; print "not " if $t == $w; print "ok 4\n"; print "not " unless $t > $w; print "ok 5\n"; print "not " unless $w < $t; print "ok 6\n"; print "not " unless $t >= $u; print "ok 7\n"; print "not " unless $t <= $u; print "ok 8\n"; print "not " unless $t >= $w; print "ok 9\n"; print "not " unless $w <= $t; print "ok 10\n"; print "not " unless $t == "(a b c)"; print "ok 11\n"; print "not " unless "(a b c)" == $u; print "ok 12\n"; print "not " unless $t->compare($x) eq 'proper intersect'; print "ok 13\n"; print "not " unless $t->compare($v) eq 'disjoint'; print "ok 14\n"; print "not " unless $t > $n; print "ok 15\n"; print "not " unless $n < $t; print "ok 16\n"; print "not " unless $n == $o; print "ok 17\n"; print "not " unless $o == $n; print "ok 18\n"; print "not " if $n < $o; print "ok 19\n"; print "not " if $n > $o; print "ok 20\n"; print "not " unless $n <= $o; print "ok 21\n"; print "not " unless $n >= $o; print "ok 22\n"; # [cpan #5829] d { my @d = $t->is_disjoint($v) ; print "not " unless @d == 1 && $d[0]; print "ok 23\n"; } Set-Scalar-1.29/t/laws.t0000644000175000017500000001102512303025456014276 0ustar davidodavidouse Set::Scalar 0.9; use strict; $| = 1; print STDERR "# (WARNING: this can take awhile)...\n"; my $t = 1; use Carp; sub bite_dust { confess @_ } local $SIG{__DIE__ } = \&bite_dust; my $a = Set::Scalar->new("a", "b", "c"); my $b = Set::Scalar->new("c", "d", "e"); my $c = Set::Scalar->new("e", "f", "g"); my $n = $a->null; my $u = $a->universe; sub check { my ($l, $p, $q, $x, $y, $z) = @_; print "# $l\n"; unless ($p == $q || ($p->size == 0 && $p->size == $q->size)) { print "# got $p, expected $q\n"; print "# x = $x, y = $y, z = $z, n = $n, u = $u\n"; print "not $t\n"; exit(1); } print "ok ", $t++, "\n"; } my @a = ($a, $b, $c, $n, $u); print "1..", 19 * @a ** 3, "\n"; for my $x ( @a ) { for my $y ( @a ) { for my $z ( @a ) { # --X == X # print "# --x = ", -(-$x), "\n"; # print "# x = ", $x , "\n"; &check('Double Complement', -(-$x), $x, $x, $y, $z); # -(X + Y) == -X * -Y # print "# -(x + y) = -(", $x, " + ", $y, ") = ", -($x + $y), "\n"; # print "# -x * -y = ", -$x, " * ", -$y, " = ", -$x * -$y, "\n"; &check('DeMorgan -+', -($x + $y), -$x * -$y, $x, $y, $z); # -(X * Y) == -X + -Y # print "# -(x * y) = -(", $x, " * ", $y, ") = ", -($x * $y), "\n"; # print "# -x + -y = ", -$x, " + ", -$y, " = ", -$x + -$y, "\n"; &check('DeMorgan -*', -($x * $y), -$x + -$y, $x, $y, $z); # X + Y == Y + X # print "# x + y = ", $x + $y, "\n"; # print "# y + x = ", $y + $x, "\n"; &check('Commutative +', $x + $y, $y + $x, $x, $y, $z); # X * Y == Y * X # print "# x * y = ", $x * $y, "\n"; # print "# y * x = ", $y * $x, "\n"; &check('Commutative *', $x * $y, $y * $x, $x, $y, $z); # X + (Y + Z) == (X + Y) + Z # print "# x + (y + z) = ", $x + ($y + $z), "\n"; # print "# (x + y) + z = ", ($x + $y) + $z, "\n"; &check('Associative +', $x + ($y + $z), ($x + $y) + $z, $x, $y, $z); # X * (Y * Z) == (X * Y) * Z # print "# (y * z) = ", ($y * $z), "\n"; # print "# x * (y * z) = ", $x * ($y * $z), "\n"; # print "# (x * y) = ", ($x * $y), "\n"; # print "# (x * y) * z = ", ($x * $y) * $z, "\n"; &check('Associative *', $x * ($y * $z), ($x * $y) * $z, $x, $y, $z); # X + (Y * Z) == (X + Y) * (X + Z) # print "# y * z = ", $y * $z, "\n"; # print "# x + y = ", $x + $y, "\n"; # print "# x + z = ", $x + $z, "\n"; # print "# x + (y * z) = ", $x + ($y * $z), "\n"; # print "# (x + y) * (x + z) = ", ($x + $y) * ($x + $z), "\n"; &check('Distributive +*', $x + ($y * $z), ($x + $y) * ($x + $z), $x, $y, $z); # X * (Y + Z) == (X * Y) + (X * Z) # print "# y + z = ", $y + $z, "\n"; # print "# x * y = ", $x * $y, "\n"; # print "# x * z = ", $x * $z, "\n"; # print "# x * (y + z) = ", $x * ($y + $z), "\n"; # print "# (x * y) + (x * z) = ", ($x * $y) + ($x * $z), "\n"; &check('Distributive *+', $x * ($y + $z), ($x * $y) + ($x * $z), $x, $y, $z); # X + X == X # print "# x + x = ", $x + $x, "\n"; # print "# x = ", $x, "\n"; &check('Idempotency +', $x + $x, $x, $x, $y, $z); # X * X == X # print "# x * x = ", $x * $x, "\n"; # print "# x = ", $x, "\n"; &check('Idempotency *', $x * $x, $x, $x, $y, $z); # print "# x + n = ", $x + $n, "\n"; # print "# x = ", $x, "\n"; # X + N == X &check('Identity +N', $x + $n, $x, $x, $y, $z); # X * U == X # print "# x * u = ", $x * $u, "\n"; # print "# x = ", $x, "\n"; &check('Identity *U', $x * $u, $x, $x, $y, $z); # X + -X == U # print "# x + -x = ", $x + -$x, "\n"; # print "# u = ", $u, "\n"; &check('Inverse +-', $x + -$x, $u, $x, $y, $z); # X * -X == N # print "# x * -x = ", $x * -$x, "\n"; # print "# n = ", $n, "\n"; &check('Inverse *-', $x * -$x, $n, $x, $y, $z); # X + U == U # print "# x + u = ", $x + $u, "\n"; # print "# u = ", $u, "\n"; &check('Domination +U', $x + $u, $u, $x, $y, $z); # X * N == N # print "# x * u = ", $x * $n, "\n"; # print "# n = ", $n, "\n"; &check('Domination *N', $x * $n, $n, $x, $y, $z); # X + (X * Y) == X # print "# x + (x * y) = ", $x + ($x * $y), "\n"; # print "# x = ", $x, "\n"; &check('Absorption +*', $x + ($x * $y), $x, $x, $y, $z); # X * (X + Y) == X # print "# x * (x + y) = ", $x * ($x + $y), "\n"; # print "# x = ", $x, "\n"; &check('Absorption *+', $x * ($x + $y), $x, $x, $y, $z); } } } Set-Scalar-1.29/t/cartesian.t0000644000175000017500000000275712260573416015323 0ustar davidodavidouse 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"; Set-Scalar-1.29/t/has.t0000644000175000017500000000034512260573416014114 0ustar davidodavidouse Set::Scalar; print "1..3\n"; my $s = Set::Scalar->new(qw(a b c 0)); print "not " unless $s->has('a'); print "ok 1\n"; print "not " unless $s->contains('0'); print "ok 2\n"; print "not " if $s->has('1'); print "ok 3\n"; Set-Scalar-1.29/t/unique.t0000644000175000017500000000070512260573416014647 0ustar davidodavidouse Set::Scalar; print "1..4\n"; my $a = Set::Scalar->new("a".."e"); my $b = Set::Scalar->new("c".."g"); my $c = Set::Scalar->new(); my $d = $a->unique($b); print "not " unless $d eq "(a b f g)"; print "ok 1\n"; my $e = $b->unique($a); print "not " unless $e eq "(a b f g)"; print "ok 2\n"; my $f = $a->unique($c); print "not " unless $f eq $a; print "ok 3\n"; my $g = $a->unique($a); print "not " unless $g eq "()"; print "ok 4 # $g\n"; Set-Scalar-1.29/t/clear.t0000644000175000017500000000027212260573416014426 0ustar davidodavidouse Set::Scalar; print "1..2\n"; my $s = Set::Scalar->new(0..99); $s->clear; print "not " unless $s->is_null; print "ok 1\n"; print "not " unless $s->members == 0; print "ok 2\n"; Set-Scalar-1.29/t/power_set.t0000644000175000017500000000174412260573416015354 0ustar davidodavidouse 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"; Set-Scalar-1.29/t/custom_display.t0000644000175000017500000000141612260573416016400 0ustar davidodavidouse Set::Scalar; print "1..7\n"; $a = Set::Scalar->new("a".."e"); $b = Set::Scalar->new("a".."e"); print "not " unless $a eq "(a b c d e)"; print "ok 1 # $a\n"; my $cb = Set::Scalar->as_string_callback; Set::Scalar->as_string_callback(sub{join(",",sort shift->elements)}); print "not " unless $a eq "a,b,c,d,e"; print "ok 2 # $a\n"; $b->as_string_callback(sub{join("-",sort shift->elements)}); print "not " unless $b eq "a-b-c-d-e"; print "ok 3 # $b\n"; print "not " unless $a eq "a,b,c,d,e"; print "ok 4 # $a\n"; Set::Scalar->as_string_callback($cb); print "not " unless $a eq "(a b c d e)"; print "ok 5 # $a\n"; print "not " unless $b eq "a-b-c-d-e"; print "ok 6 # $b\n"; $b->as_string_callback(undef); print "not " unless $b eq "(a b c d e)"; print "ok 7 # $b\n"; Set-Scalar-1.29/t/union.t0000644000175000017500000000272512260573416014475 0ustar davidodavidouse Set::Scalar; print "1..19\n"; my $a = Set::Scalar->new("a".."e"); my $b = Set::Scalar->new("c".."g"); my $d = $a->union($b); print "not " unless $d eq "(a b c d e f g)"; print "ok 1\n"; print "not " unless $a eq "(a b c d e)"; print "ok 2\n"; print "not " unless $b eq "(c d e f g)"; print "ok 3\n"; my $e = $a + $b; print "not " unless $e eq "(a b c d e f g)"; print "ok 4\n"; print "not " unless $a eq "(a b c d e)"; print "ok 5\n"; print "not " unless $b eq "(c d e f g)"; print "ok 6\n"; my $f = $b->union($a); print "not " unless $f eq "(a b c d e f g)"; print "ok 7\n"; print "not " unless $a eq "(a b c d e)"; print "ok 8\n"; print "not " unless $b eq "(c d e f g)"; print "ok 9\n"; my $g = $b + $a; print "not " unless $g eq "(a b c d e f g)"; print "ok 10\n"; print "not " unless $a eq "(a b c d e)"; print "ok 11\n"; print "not " unless $b eq "(c d e f g)"; print "ok 12\n"; my $h = $a + "x"; print "not " unless $h eq "(a b c d e x)"; print "ok 13\n"; print "not " unless $a eq "(a b c d e)"; print "ok 14\n"; my $i = "y" + $a; print "not " unless $i eq "(a b c d e y)"; print "ok 15\n"; print "not " unless $a eq "(a b c d e)"; print "ok 16\n"; { # Josh@allDucky.com my $x = new Set::Scalar(1,2,3); my $y = new Set::Scalar(1,2,3,5); my $u = $x->union($y); $u->insert(4); print "not " unless $x eq "(1 2 3)"; print "ok 17\n"; print "not " unless $u eq "(1 2 3 4 5)"; print "ok 18\n"; print "not " unless $y eq "(1 2 3 5)"; print "ok 19\n"; } Set-Scalar-1.29/t/valued.t0000644000175000017500000000126512260573416014623 0ustar davidodavidouse Set::Scalar::Valued; use strict; print "1..9\n"; my $ns = Set::Scalar::Valued->new(); print $ns->is_null ? "ok 1\n" : "not ok 1\n"; print $ns->size == 0 ? "ok 2\n" : "not ok 2\n"; print $ns->null->is_null ? "ok 3\n" : "not ok 4\n"; print $ns->null->size == 0 ? "ok 4\n" : "not ok 4\n"; my $vs = Set::Scalar::Valued->new(a=>1); print $vs->is_null ? "not ok 5\n" : "ok 5\n"; print $vs->size == 0 ? "not ok 6\n" : "ok 6\n"; print $vs->null->is_null ? "ok 7\n" : "not ok 7\n"; print $vs->null->size == 0 ? "ok 8\n" : "not ok 8\n"; my $a = Set::Scalar::Valued->new(a=>1); my $b = Set::Scalar::Valued->new(a=>1, b=>2); my $c = $a-$b; print "$c" eq "()" ? "ok 9\n" : "not ok 9\n"; Set-Scalar-1.29/t/intersection.t0000644000175000017500000000353112260573416016047 0ustar davidodavidouse Set::Scalar; print "1..24\n"; my $a = Set::Scalar->new("a".."e"); my $b = Set::Scalar->new("c".."g"); my $d = $a->intersection($b); print "not " unless $d eq "(c d e)"; print "ok 1\n"; print "not " unless $a eq "(a b c d e)"; print "ok 2\n"; print "not " unless $b eq "(c d e f g)"; print "ok 3\n"; my $e = $a * $b; print "not " unless $e eq "(c d e)"; print "ok 4\n"; print "not " unless $a eq "(a b c d e)"; print "ok 5\n"; print "not " unless $b eq "(c d e f g)"; print "ok 6\n"; my $f = $b->intersection($a); print "not " unless $f eq "(c d e)"; print "ok 7\n"; print "not " unless $a eq "(a b c d e)"; print "ok 8\n"; print "not " unless $b eq "(c d e f g)"; print "ok 9\n"; my $g = $b * $a; print "not " unless $g eq "(c d e)"; print "ok 10\n"; print "not " unless $a eq "(a b c d e)"; print "ok 11\n"; print "not " unless $b eq "(c d e f g)"; print "ok 12\n"; my $h = $a * "x"; print "not " unless $h eq "()"; print "ok 13\n"; print "not " unless $a eq "(a b c d e)"; print "ok 14\n"; my $i = "y" * $a; print "not " unless $i eq "()"; print "ok 15\n"; print "not " unless $a eq "(a b c d e)"; print "ok 16\n"; my $j = $a * "c"; print "not " unless $j eq "(c)"; print "ok 17\n"; print "not " unless $a eq "(a b c d e)"; print "ok 18\n"; my $k = "e" * $a; print "not " unless $k eq "(e)"; print "ok 19\n"; print "not " unless $a eq "(a b c d e)"; print "ok 20\n"; { # Josh@allDucky.com my $x = new Set::Scalar(1,2,3); my $y = new Set::Scalar(1,2,3,5); my $i = $x->intersection($y); $i->insert(4); print "not " unless $x eq "(1 2 3)"; print "ok 21\n"; print "not " unless $i eq "(1 2 3 4)"; print "ok 22\n"; print "not " unless $y eq "(1 2 3 5)"; print "ok 23\n"; } print "not " unless join("", sort @{ new Set::Scalar \$1,\$2,\$3,->intersection( new Set::Scalar \$2,\$3,\$4 ) }) eq join "", sort \$2,\$3; print "ok 24\n"; Set-Scalar-1.29/t/universe.t0000644000175000017500000000133212260573416015176 0ustar davidodavidouse Set::Scalar; use Set::Scalar::Universe; use strict; print "1..7\n"; my $s1 = Set::Scalar->new("a".."e"); my $u1 = $s1->universe; my $u2 = Set::Scalar::Universe->new; $u2->enter; my $s2 = Set::Scalar->new("f".."j"); print "not " if $u1 == $u2; print "ok 1\n"; print "not " unless $s1->universe eq "[a b c d e]"; print "ok 2\n"; print "not " unless $s2->universe eq "[f g h i j]"; print "ok 3\n"; my $u3 = Set::Scalar::Universe->new("a".."e"); print "not " if $s1->universe == $u3; print "ok 4\n"; $u3->extend("x"); print "not " unless $u3 eq "[a b c d e x]"; print "ok 5\n"; print "not " unless "$u1" eq "[a b c d e]"; print "ok 6\n"; print "not " unless "$u2" eq "[f g h i j]"; print "ok 7\n"; # End Of File. Set-Scalar-1.29/t/each.t0000644000175000017500000000054712260573416014245 0ustar davidodavidouse Set::Scalar; print "1..2\n"; my @a = ("a".."e",0); my $a = Set::Scalar->new(@a); my $e; my %e; while (defined($e = $a->each)) { print "# e = $e\n"; $e{$e}++; } print "not " if defined $e; print "ok 1\n"; my $n; for my $e (@a) { $n++ if exists $e{$e} && $e{$e} == 1; } print "not " unless $n == @a && keys %e == @a; print "ok 2\n"; Set-Scalar-1.29/t/misc.t0000644000175000017500000000141412260573416014272 0ustar davidodavidouse Set::Scalar; print "1..3\n"; { # Malcolm Purvis my $s1 = Set::Scalar->new("A"); my $s1_again = Set::Scalar->new("A"); my $s2 = $s1->union($s1_again); my $s3 = Set::Scalar->new("C"); my $s4 = $s2->difference($s3); print "not " unless $s4 eq "(A)"; print "ok 1\n"; } { # Malcolm Purvis my $s1 = Set::Scalar->new(("A", "B")); my $s1_again = Set::Scalar->new(("A", "B")); my $s2 = $s1->union($s1_again); my $s3 = Set::Scalar->new("C"); my $s4 = $s2->difference($s3); print "not " unless $s4 eq "(A B)"; print "ok 2\n"; } { # Josh@allDucky.com use Set::Scalar; my $x = new Set::Scalar( [] ); my @m = $x->members; print "not " unless $m[0] =~ /^ARRAY\(0x[0-9a-fA-F]+\)$/; print "ok 3\n"; } Set-Scalar-1.29/t/member.t0000644000175000017500000000040012260573416014600 0ustar davidodavidouse Set::Scalar; print "1..3\n"; my $s = Set::Scalar->new(qw(a b c 0)); print "not " unless $s->member('a') eq 'a'; print "ok 1\n"; print "not " unless $s->element('0') eq '0'; print "ok 2\n"; print "not " if defined $s->member('1'); print "ok 3\n"; Set-Scalar-1.29/t/basic_overload.t0000644000175000017500000000502512260573416016315 0ustar davidodavidouse Set::Scalar; use strict; print "1..40\n"; my $s = Set::Scalar->new; print "not " unless $s->size == 0; print "ok 1\n"; print "not " unless $s->is_null; print "ok 2\n"; print "not " unless $s->is_universal; print "ok 3\n"; print "not " unless $s eq "()"; print "ok 4\n"; print "not " unless $s->universe eq "[]"; print "ok 5\n"; $s += "a"; print "not " unless $s->size == 1; print "ok 6\n"; print "not " if $s->is_null; print "ok 7\n"; print "not " unless $s->is_universal; print "ok 8\n"; print "not " unless $s eq "(a)"; print "ok 9\n"; print "not " unless $s->universe eq "[a]"; print "ok 10\n"; $s += "a"; print "not " unless $s->size == 1; print "ok 11\n"; print "not " if $s->is_null; print "ok 12\n"; print "not " unless $s->is_universal; print "ok 13\n"; print "not " unless $s eq "(a)"; print "ok 14\n"; print "not " unless $s->universe eq "[a]"; print "ok 15\n"; $s += "b"; $s += "c"; $s += "d"; $s += "e"; print "not " unless $s->size == 5; print "ok 16\n"; print "not " if $s->is_null; print "ok 17\n"; print "not " unless $s->is_universal; print "ok 18\n"; print "not " unless $s eq "(a b c d e)"; print "ok 19\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 20\n"; $s -= "b"; $s -= "d"; print "not " unless $s->size == 3; print "ok 21\n"; print "not " if $s->is_null; print "ok 22\n"; print "not " if $s->is_universal; print "ok 23\n"; print "not " unless $s eq "(a c e)"; print "ok 24\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 25\n"; $s /= "b"; $s /= "c"; $s /= "d"; print "not " unless $s->size == 4; print "ok 26\n"; print "not " if $s->is_null; print "ok 27\n"; print "not " if $s->is_universal; print "ok 28\n"; print "not " unless $s eq "(a b d e)"; print "ok 29\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 30\n"; my $t = $s; print "not " unless $t->size == 4; print "ok 31\n"; print "not " if $t->is_null; print "ok 32\n"; print "not " if $t->is_universal; print "ok 33\n"; print "not " unless $t eq "(a b d e)"; print "ok 34\n"; print "not " unless $t->universe eq "[a b c d e]"; print "ok 35\n"; $t = $t + 'f'; print "not " unless $t eq "(a b d e f)"; print "ok 36\n"; print "not " unless $t->universe eq "[a b c d e f]"; print "ok 37\n"; print "not " unless $s eq "(a b d e)"; print "ok 38\n"; print "not " unless $s->universe eq "[a b c d e f]"; print "ok 39\n"; my $a = Set::Scalar->new(); adder(2); adder(3); adder(34); sub adder { my $e = shift; $a = $a + $e; } print "not " unless $a eq "(2 3 34)"; print "ok 40\n"; # End Of File. Set-Scalar-1.29/t/set_set.t0000644000175000017500000000156712260573416015016 0ustar davidodavidouse Set::Scalar; print "1..8\n"; my $s = Set::Scalar->new("a"); my $t = Set::Scalar->new("b"); $s->insert($t); print "not " unless $s == "(a (b))"; print "ok 1\n"; $t->insert($s); print "not " unless $s == "(a (b (a ...)))"; print "ok 2\n"; print "not " unless $t == "(b (a (b ...)))"; print "ok 3\n"; my $u = Set::Scalar->new("c"); $u->insert($u); print "not " unless $u == "(c (c ...))"; print "ok 4\n"; $s->insert($u); # There is some nondeterminism that needs to be resolved. print "not " unless $s == "(a (b (a ...)) (c ...))" or $s == "(a (b (a (c ...) ...)) (c ...))"; print "ok 5\n"; print "not " unless $t == "(b (a (b ...) (c ...)))" or $t == "(b (a (b (c ...) ...) (c ...)))"; print "ok 6\n"; $t->delete($s); print "not " unless $s == "(a (b) (c ...))"; print "ok 7\n"; print "not " unless $t == "(b)"; print "ok 8\n"; Set-Scalar-1.29/t/basic.t0000644000175000017500000000630212260573416014421 0ustar davidodavidouse Set::Scalar; use strict; print "1..49\n"; my $s = Set::Scalar->new; print "not " unless $s->size == 0; print "ok 1\n"; print "not " unless $s->is_null; print "ok 2\n"; print "not " unless $s->is_universal; print "ok 3\n"; print "not " unless $s eq "()"; print "ok 4\n"; print "not " unless $s->universe eq "[]"; print "ok 5\n"; $s->insert("a"); print "not " unless $s->size == 1; print "ok 6\n"; print "not " if $s->is_null; print "ok 7\n"; print "not " unless $s->is_universal; print "ok 8\n"; print "not " unless $s eq "(a)"; print "ok 9\n"; print "not " unless $s->universe eq "[a]"; print "ok 10\n"; $s->insert("a"); print "not " unless $s->size == 1; print "ok 11\n"; print "not " if $s->is_null; print "ok 12\n"; print "not " unless $s->is_universal; print "ok 13\n"; print "not " unless $s eq "(a)"; print "ok 14\n"; print "not " unless $s->universe eq "[a]"; print "ok 15\n"; $s->insert("b", "c", "d", "e"); print "not " unless $s->size == 5; print "ok 16\n"; print "not " if $s->is_null; print "ok 17\n"; print "not " unless $s->is_universal; print "ok 18\n"; print "not " unless $s eq "(a b c d e)"; print "ok 19\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 20\n"; $s->delete("b", "d"); print "not " unless $s->size == 3; print "ok 21\n"; print "not " if $s->is_null; print "ok 22\n"; print "not " if $s->is_universal; print "ok 23\n"; print "not " unless $s eq "(a c e)"; print "ok 24\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 25\n"; $s->invert("b", "c", "d"); print "not " unless $s->size == 4; print "ok 26\n"; print "not " if $s->is_null; print "ok 27\n"; print "not " if $s->is_universal; print "ok 28\n"; print "not " unless $s eq "(a b d e)"; print "ok 29\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 30\n"; $s->fill(); print "not " unless $s->size == 5; print "ok 31\n"; print "not " if $s->is_null; print "ok 32\n"; print "not " unless $s->is_universal; print "ok 33\n"; print "not " unless $s eq "(a b c d e)"; print "ok 34\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 35\n"; $s->clear(); print "not " unless $s->size == 0; print "ok 36\n"; print "not " unless $s->is_null; print "ok 37\n"; print "not " if $s->is_universal; print "ok 38\n"; print "not " unless $s eq "()"; print "ok 39\n"; print "not " unless $s->universe eq "[a b c d e]"; print "ok 40\n"; eval { $s->clear("x") }; print "not " unless $@ =~ /\Q::clear(): need no arguments/; print "ok 41\n"; eval { $s->fill("y") }; print "not " unless $@ =~ /\Q::fill(): need no arguments/; print "ok 42\n"; $s->insert("a".."e"); print "not " unless "@{ [ sort $s->members ] }" eq "a b c d e"; print "ok 43\n"; print "not " unless "@{ [ sort @$s ] }" eq "a b c d e"; print "ok 44\n"; my $t = Set::Scalar->new(@$s); print "not " unless "@{ [ sort @$t ] }" eq "a b c d e"; print "ok 45\n"; $t += "f"; print "not " unless "@{ [ sort @$t ] }" eq "a b c d e f"; print "ok 46\n"; my $u = $t; print "not " unless "@{ [ sort @$u ] }" eq "a b c d e f"; print "ok 47\n"; $t += "g"; print "not " unless "@{ [ sort @$t ] }" eq "a b c d e f g"; print "ok 48\n"; print "not " unless "@{ [ sort @$u ] }" eq "a b c d e f"; print "ok 49\n"; # End Of File. Set-Scalar-1.29/t/difference.t0000644000175000017500000000256612260573416015442 0ustar davidodavidouse Set::Scalar; print "1..28\n"; sub check { my ($test, $ok) = @_; if ($ok) { print "ok $test\n"; } else { print "not ok $test\n"; } } my $a = Set::Scalar->new("a".."e"); my $b = Set::Scalar->new("c".."g"); my $d = $a->difference($b); check( 1, $d eq "(a b)" ); check( 2, $a eq "(a b c d e)" ); check( 3, $b eq "(c d e f g)" ); my $e = $a - $b; check( 4, $e eq "(a b)" ); check( 5, $a eq "(a b c d e)" ); check( 6, $b eq "(c d e f g)" ); my $f = $b->difference($a); check( 7, $f eq "(f g)" ); check( 8, $a eq "(a b c d e)" ); check( 9, $b eq "(c d e f g)" ); my $g = $b - $a; check( 10, $g eq "(f g)" ); check( 11, $a eq "(a b c d e)" ); check( 12, $b eq "(c d e f g)" ); my $h = $a - "x"; check( 13, $h eq "(a b c d e)" ); check( 14, $a eq "(a b c d e)" ); my $i = "y" - $a; check( 15, $i eq "(y)" ); check( 16, $a eq "(a b c d e)" ); my $j = $a - "c"; check( 17, $j eq "(a b d e)" ); check( 18, $a eq "(a b c d e)" ); my $k = "e" - $a; check( 19, $k eq "()" ); check( 20, $a eq "(a b c d e)" ); my $m = new Set::Scalar(); my $n = new Set::Scalar(); my $o = $m - $n; check( 21, defined($m) && ref($m) && $m->isa("Set::Scalar") ); check( 22, defined($n) && ref($n) && $n->isa("Set::Scalar") ); check( 23, $m eq $n ); check( 24, $n eq $o ); check( 25, $o eq $m ); check( 26, $m == $n ); check( 27, $n == $o ); check( 28, $o == $m ); Set-Scalar-1.29/t/null.t0000644000175000017500000000100412260573416014304 0ustar davidodavidouse Set::Scalar; my $s0 = Set::Scalar->new; my $s1 = Set::Scalar->new(qw(a b c)); print "1..8\n"; print $s0->is_null ? "ok 1\n" : "not ok 1\n"; print $s1->is_null ? "not ok 2\n" : "ok 2\n"; print $s0->is_empty ? "ok 3\n" : "not ok 3\n"; print $s1->is_empty ? "not ok 4\n" : "ok 4\n"; print $s0 == $s0->null ? "ok 5\n" : "not ok 5\n"; print $s1 == $s1->null ? "not ok 6\n" : "ok 6\n"; print $s0 == $s0->empty ? "ok 7\n" : "not ok 7\n"; print $s1 == $s0->empty ? "not ok 8\n" : "ok 8\n"; Set-Scalar-1.29/META.json0000644000175000017500000000176412314042712014326 0ustar davidodavido{ "abstract" : "unknown", "author" : [ "Jarkko Hietaniemi " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Set-Scalar", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/daoswald/Set-Scalar.git", "web" : "https://github.com/daoswald/Set-Scalar" } }, "version" : "1.29" } Set-Scalar-1.29/lib/0000755000175000017500000000000012314042712013443 5ustar davidodavidoSet-Scalar-1.29/lib/Set/0000755000175000017500000000000012314042712014176 5ustar davidodavidoSet-Scalar-1.29/lib/Set/Scalar.pm0000644000175000017500000002634712314042312015751 0ustar davidodavidopackage Set::Scalar; use strict; # local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Real Set::Scalar::Null Set::Scalar::Base); use Set::Scalar::Base qw(_make_elements is_equal as_string_callback); use Set::Scalar::Real; use Set::Scalar::Null; use Set::Scalar::Universe; sub ELEMENT_SEPARATOR { " " } sub SET_FORMAT { "(%s)" } sub _insert_hook { my $self = shift; if (@_) { my $elements = shift; $self->universe->_extend( $elements ); $self->_insert_elements( $elements ); } } sub _new_hook { my $self = shift; my $elements = shift; $self->{ universe } = Set::Scalar::Universe->universe; $self->_insert( { _make_elements( @$elements ) } ); } =pod =head1 NAME Set::Scalar - basic set operations =head1 SYNOPSIS use Set::Scalar; $s = Set::Scalar->new; $s->insert('a', 'b'); $s->delete('b'); $t = Set::Scalar->new('x', 'y', $z); =head1 DESCRIPTION =head2 Creating $s = Set::Scalar->new; $s = Set::Scalar->new(@members); $t = $s->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. Note that clear() only releases the memory used by the set to be reused by Perl; it will not reduce the overall memory use. =head2 Displaying print $s, "\n"; The display format of a set is the members of the set separated by spaces and enclosed in parentheses (), for example: my $s = Set::Scalar->new(); $s->insert("a".."e"); print $s, "\n"; will output a b c d e You can even display recursive sets. See L for customising the set display. =head2 Querying Assuming a set C<$s>: @members = $s->members; @elements = $s->elements; # Alias for members. @$s # Overloaded 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. =head2 Deriving $u = $s->union($t); $i = $s->intersection($t); $d = $s->difference($t); $e = $s->symmetric_difference($t); $v = $s->unique($t); $c = $s->complement; 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 Both the C and C are symmetric on all their arguments. For two sets they are identical but for more than two sets beware: C returns true for elements that are in an odd number (1, 3, 5, ...) of sets, C returns true for elements that are in one set. Some examples of the various set differences below (the _ is just used to align the elements): set or difference value $a (a b c d e _ _ _ _) $b (_ _ c d e f g _ _) $c (_ _ _ _ e f g h i) $a->difference($b) (a b _ _ _ _ _ _ _) $a->symmetric_difference($b) (a b _ _ _ f g _ _) $a->unique($b) (a b _ _ _ f g _ _) $b->difference($a) (_ _ _ _ _ f g _ _) $b->symmetric_difference($a) (a b _ _ _ f g _ _) $b->unique($a) (a b _ _ _ f g _ _) $a->difference($b, $c) (a b _ _ _ _ _ _ _) $a->symmetric_difference($b, $c) (a b _ _ e _ _ h i) $a->unique($b, $c) (a b _ _ _ _ _ h i) =head2 Comparing $eq = $s->is_equal($t); $dj = $s->is_disjoint($t); $pi = $s->is_properly_intersecting($t); $ps = $s->is_proper_subset($t); $pS = $s->is_proper_superset($t); $is = $s->is_subset($t); $iS = $s->is_superset($t); $cmp = $s->compare($t); The C method returns a string from the following list: "equal", "disjoint", "proper subset", "proper superset", "proper intersect", and in future (once I get around implementing it), "disjoint universes". These methods have operator overloads: $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 $cmp = $s <=> $t; =head2 Boolean contexts In Boolean contexts such as if ($set) { ... } while ($set1 && $set2) { ... } the size of the C<$set> is tested, so empty sets test as false, and non-empty sets as true. =head2 Iterating while (defined(my $e = $s->each)) { ... } This is more memory-friendly than for my $e ($s->elements) { ... } which would first construct the full list of elements and then walk through it: the C<$s-Eeach> handles one element at a time. Analogously to using normal C in scalar context, using C<$s-Eeach> has the following caveats: =over 4 =item * The elements are returned in (apparently) random order. So don't expect any particular order. =item * When no more elements remain C is returned. Since you may one day have elements named C<0> don't test just like this while (my $e = $s->each) { ... } # WRONG! but instead like this while (defined(my $e = $s->each)) { ... } # Right. (An C as a set element doesn't really work, you get C<"">.) =item * There is one iterator per one set which is shared by many element-accessing interfaces-- using the following will reset the iterator: C, C, C, C, C. C causes the iterator of the set being inserted (not the set being the target of insertion) becoming reset. C causes the iterators of all the participant sets becoming reset. B So avoid doing that. For C the story is a little bit more complex: it depends on what element you are deleting and on the version of Perl. On modern Perls you can safely delete the element you just deleted. But deleting random elements can affect the iterator, so beware. =item * Modifying the set during the iteration may cause elements to be missed or duplicated, or in the worst case, an endless loop; so don't do that, either. =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 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 not. This means two things: firstly, that [e, b] is B 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_iterator($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 modify the C callback. You can modify it either for all sets by using C as a class method: my $class_callback = sub { ... }; Set::Scalar->as_string_callback($class_callback); or for specific sets by using C as an object method: my $callback = sub { ... }; $s1->as_string_callback($callback); $s2->as_string_callback($callback); The anonymous subroutine gets as its first (and only) argument the set to display as a string. For example to display the set C<$s> as C instead of C<(a b c d e)> $s->as_string_callback(sub{join("-",sort $_[0]->elements)}); If called without an argument, the current callback is returned. If called as a class method with undef as the only argument, the original callback (the one returning C<(a b c d e)>) for all the sets is restored, or if called for a single set the callback is removed (and the callback for all the sets will be used). =head1 CAVEATS The first priority of Set::Scalar is to be a convenient interface to sets. While not designed to be slow or big, neither has it been designed to be fast or compact. Using references (or objects) as set members has not been extensively tested. The desired semantics are not always clear: what should happen when the elements behind the references change? Especially unclear is what should happen when the objects start having their own stringification overloads. =head1 SEE ALSO Set::Bag for bags (multisets, counted sets), and Bit::Vector for fast set operations (you have to take care of the element name to bit number and back mappings yourself), or Set::Infinite for sets of intervals, and many more. CPAN is your friend. =head1 AUTHOR Jarkko Hietaniemi David Oswald is the current maintainer. The GitHub repo is at L =head1 COPYRIGHT AND LICENSE Copyright 2001,2002,2003,2004,2005,2007,2009,2013 by Jarkko Hietaniemi This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Set-Scalar-1.29/lib/Set/Scalar/0000755000175000017500000000000012314042712015403 5ustar davidodavidoSet-Scalar-1.29/lib/Set/Scalar/Valued.pm0000644000175000017500000001015612314042356017170 0ustar davidodavidopackage Set::Scalar::Valued; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Base Set::Scalar::Real); use Set::Scalar::Base qw(_make_elements as_string _strval); use Set::Scalar::Real; use Set::Scalar::ValuedUniverse; use overload '""' => \&as_string, 'cmp' => \&cmp; sub ELEMENT_SEPARATOR { ", " } sub VALUE_SEPARATOR { " => " } sub SET_FORMAT { "{%s}" } sub _make_valued_elements { my $elements = shift; my %elements; while (my ($key, $value) = splice @$elements, 0, 2) { $elements{ _strval($key) } = [ $key, $value ]; } return %elements; } sub _insert_hook { my $self = shift; if (@_) { my $elements = shift; $self->universe->_extend( { _make_elements( map { $_->[0] } values %$elements ) } ); $self->_insert_elements( $elements ); } } sub _new_hook { my $self = shift; my $elements = shift; $self->{'universe'} = Set::Scalar::ValuedUniverse->universe; $self->_insert( { _make_valued_elements( $elements ) } ); } sub insert { my $self = shift; $self->_insert( { _make_valued_elements \@_ } ); } sub _valued_elements { my $self = shift; return @_ ? @{ $self->{'elements'} }{ map { _strval($_) } @_ } : values %{ $self->{'elements'} }; } sub valued_elements { my $self = shift; return map { @$_ } $self->_valued_elements(@_); } *valued_members = \&valued_elements; sub value { my $self = shift; my $member = shift; return $self->{'elements'}->{ $member }; } sub elements { my $self = shift; return map { $_->[0] } $self->_valued_elements(@_); } sub values { my $self = shift; return map { $_->[1] } $self->_valued_elements(@_); } sub _elements_as_string { my $self = shift; my %valued_elements = $self->valued_elements; my $value_separator = $self->_value_separator; my @elements = map { $_ . $value_separator . $valued_elements{$_} } keys %valued_elements; return (join($self->_element_separator, sort @elements), $self->_elements_have_reference([%valued_elements])); } sub _value_separator { my $self = shift; return $self->{'display'}->{'value_separator'} if exists $self->{'display'}->{'value_separator'}; my $universe = $self->universe; return $universe->{'display'}->{'value_separator'} if exists $universe->{'display'}->{'value_separator'}; return (ref $self)->VALUE_SEPARATOR; } sub invert { my $self = shift; $self->_invert( { _make_valued_elements \@_ } ); } sub fill { die "$0: ", __PACKAGE__, "::fill() inappropriate.\n"; } =pod =head1 NAME Set::Scalar::Valued - valued sets =head1 SYNOPSIS use Set::Scalar::Valued; $s = Set::Scalar::Valued->new; $s->insert(a => 12, 'b c' => $d); $s->delete('b c' => $d); $t = Set::Scalar->new(x => $y, y => $z); =head1 DESCRIPTION Valued sets are an extension of the traditional set concept. In addition to a member just existing in the set, the member also has a distinct value. You can think of this a combination of a traditional set and a Perl hash. The used methods are as for the traditional of Set::Scalar, with the difference that when creating (new()) or modifying (insert(), delete(), invert()), you must supply twice the number of arguments: the member-value pairs, instead of just the members. Note, though, that in the current implementation of delete() the value half is unused, the deletion is by the member. In future implementation this behavior may change so that also the value matters. There are a couple of additional methods: %ve = $s->valued_members; which returns the member-value pairs, and @v = $s->values; which returns just the values (in the same order as the members() method would return the members), and $v = $s->value($member); which returns the value of the member. The display format of a valued set is the member-value pairs separated by " => ", the pairs separated by ", " and enclosed in curly brackets {}. =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/Real.pm0000644000175000017500000000437112314042340016626 0ustar davidodavidopackage Set::Scalar::Real; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Base); use Set::Scalar::Base qw(_make_elements _binary_underload); use overload '+=' => \&_insert_overload, '-=' => \&_delete_overload, '/=' => \&_invert_overload; sub insert { my $self = shift; $self->_insert( { _make_elements @_ } ); return $self; } sub _insert_overload { my ($this, $that) = _binary_underload( \@_ ); $that = (ref $this)->new($that) unless ref $that; $this->insert( $that->elements ); return $this; } sub _delete { my $self = shift; my $elements = shift; delete @{ $self->{'elements'} }{ keys %$elements }; $self->_invalidate_cached; return $self; } sub delete { my $self = shift; $self->_delete( { _make_elements @_ } ); } sub _delete_overload { my ($this, $that) = _binary_underload( \@_ ); $this->delete( $that->elements ); return $this; } sub _invert { my $self = shift; my $elements = shift; foreach my $element ( keys %$elements ) { if ( exists $self->{'elements'}->{ $element } ) { delete $self->{'elements'}->{ $element }; } else { $self->{'elements'}->{ $element } = $elements->{ $element }; } } $self->_invalidate_cached; } sub invert { my $self = shift; $self->_invert( { _make_elements @_ } ); return $self; } sub _invert_overload { my ($this, $that) = _binary_underload( \@_ ); $this->invert( $that->elements ); return $this; } sub clear { my $self = shift; die __PACKAGE__ . "::clear(): need no arguments.\n" if @_; $self->delete( $self->elements ); return $self; } sub fill { my $self = shift; die __PACKAGE__ . "::fill(): need no arguments.\n" if @_; $self->insert( $self->universe->elements ); return $self; } sub DESTROY { my $self = shift; delete $self->{'null' }; delete $self->{'universe'}; $self->clear; } =pod =head1 NAME Set::Scalar::Real - internal class for Set::Scalar =head1 SYNOPSIS B. =head1 DESCRIPTION B If you want documentation see L. =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/Virtual.pm0000644000175000017500000000220412314042374017371 0ustar davidodavidopackage Set::Scalar::Virtual; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Base); use Set::Scalar::Base qw(_make_elements as_string _compare _strval); use overload '""' => \&as_string, 'eq' => \&are_equal, '==' => \&are_equal; sub ELEMENT_SEPARATOR { " " } sub _extend { my $self = shift; my $elements = shift; $self->_insert_elements( $elements ); } sub extend { my $self = shift; $self->_extend( { _make_elements( @_ ) } ); } sub compare { my $a = shift; my $b = shift; if (ref $a && ref $b && $a->isa(__PACKAGE__) && $b->isa(__PACKAGE__)) { $a = _strval($a); $b = _strval($b); } return _compare($a, $b); } sub are_equal { my $a = shift; my $b = shift; return $a->compare($b) eq 'equal'; } sub clone { my $self = shift; return $self; } =pod =head1 NAME Set::Scalar::Virtual - internal class for Set::Scalar =head1 SYNOPSIS B. =head1 DESCRIPTION B See the L. =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/Null.pm0000644000175000017500000000171312314042332016653 0ustar davidodavidopackage Set::Scalar::Null; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Base Set::Scalar::Virtual); use Set::Scalar::Virtual; use Set::Scalar::Base; use overload 'neg' => \&_complement_overload; sub SET_FORMAT { "(%s)" } sub _new_hook { my $self = shift; my $universe = $_[0]->[0]; $self->universe( $universe ); } sub universe { my $self = shift; $self->{'universe'} = shift if @_; return $self->{'universe'}; } sub elements { return (); } sub size { return 0; } sub _complement_overload { my $self = shift; return Set::Scalar->new( $self->universe->elements ); } =pod =head1 NAME Set::Scalar::Null - internal class for Set::Scalar =head1 SYNOPSIS B. =head1 DESCRIPTION B If you want documentation see L. =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/Universe.pm0000644000175000017500000000300012314042347017536 0ustar davidodavidopackage Set::Scalar::Universe; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Virtual Set::Scalar::Base); use Set::Scalar::Base qw(_make_elements); use Set::Scalar::Virtual; use Set::Scalar::Null; use overload 'neg' => \&_complement_overload; my $UNIVERSE = __PACKAGE__->new; sub SET_FORMAT { "[%s]" } sub universe { my $self = shift; return $UNIVERSE; } sub null { my $self = shift; return $self->{'null'}; } sub enter { my $self = shift; $UNIVERSE = $self; } sub _new_hook { my $self = shift; my $elements = shift; $self->{'universe'} = $UNIVERSE; $self->{'null' } = Set::Scalar::Null->new( $self ); $self->_extend( { _make_elements( @$elements ) } ); } sub _complement_overload { my $self = shift; return Set::Scalar::Null->new( $self ); } =pod =head1 NAME Set::Scalar::Universe - universes for set members =head1 SYNOPSIS B =head1 DESCRIPTION There are only two guaranteed interfaces, both sort of indirect. The first one is accessing the universe of a set: $set->universe This contains the members of the universe $set->universe->members of the C<$set>. The second supported interface is displaying set universes. print $set->universe, "\n"; This will display the members of the set inside square brackets: [], as opposed to sets, which have their members shown inside parentheses: (). =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/Base.pm0000644000175000017500000004055312314042322016617 0ustar davidodavidopackage Set::Scalar::Base; use strict; # local $^W = 1; require Exporter; use vars qw($VERSION @ISA @EXPORT_OK); $VERSION = '1.29'; @ISA = qw(Exporter); 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 as_string_callback _compare is_equal _binary_underload _unary_underload _strval); use overload '+' => \&_union_overload, '*' => \&_intersection_overload, '-' => \&_difference_overload, 'neg' => \&_complement_overload, '%' => \&_symmetric_difference_overload, '/' => \&_unique_overload, 'eq' => \&is_equal, '==' => \&is_equal, '!=' => \&is_disjoint, '<=>' => \&compare, '<' => \&is_proper_subset, '>' => \&is_proper_superset, '<=' => \&is_subset, '>=' => \&is_superset, 'bool' => \&size, '@{}' => sub { [ $_[0]->members ] }, '=' => sub { $_[0]->clone($_[1]) }, 'cmp' => sub { "$_[0]" cmp "$_[1]" }; use constant OVERLOAD_BINARY_2ND_ARG => 1; use constant OVERLOAD_BINARY_REVERSED => 2; sub _binary_underload { # Handle overloaded binary operators. my (@args) = @{ $_[0] }; if (@args == 3) { $args[1] = (ref $args[0])->new( $args[1] ) unless ref $args[1]; @args[0, 1] = @args[1, 0] if $args[OVERLOAD_BINARY_REVERSED]; pop @args; } return @args; } sub _unary_underload { # Handle overloaded unary operators. if (@{ $_[0] } == 3) { pop @{ $_[0] }; pop @{ $_[0] }; } } sub _new_hook { # Just an empty stub. } sub new { my $class = shift; my $self = { }; bless $self, ref $class || $class; $self->_new_hook( \@_ ); return $self; } sub _strval { my $class = ref $_[0]; return $_[0] unless $class; sprintf "%s(%s)", $class, refaddr $_[0]; } sub _make_elements { return map { (defined $_ ? _strval($_) : "") => $_ } @_; } sub _invalidate_cached { my $self = shift; delete @{ $self }{ "as_string" }; } sub _insert_hook { # Just an empty stub. } sub _insert { my $self = shift; my $elements = shift; $self->_insert_hook( $elements ); } sub _insert_elements { my $self = shift; my $elements = shift; @{ $self->{'elements'} }{ keys %$elements } = values %$elements; $self->_invalidate_cached; } sub universe { my $self = shift; return $self->{'universe'}; } sub size { my $self = shift; return scalar keys %{ $self->{'elements'} }; } sub elements { my $self = shift; return @_ ? @{ $self->{'elements'} }{ map { _strval($_) } @_ } : values %{ $self->{'elements'} }; } *members = \&elements; sub element { my $self = shift; $self->elements( shift ); } *member = \&element; sub has { my $self = shift; my @has = map { exists $self->{'elements'}->{ $_ } } @_; return wantarray ? @has : @_ > 1 ? grep { $_ } @has : $has[0]; } *contains = \&has; sub each { my $self = shift; my ($k, $e) = each %{ $self->{'elements'} }; 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->_empty_clone($original); $self->_insert( $original->{'elements'} ); } sub clone { my $self = shift; my $clone = (ref $self)->new; $clone->_clone( $self ); return $clone; } *copy = \&clone; sub empty_clone { my $self = shift; my $clone = (ref $self)->new; $clone->_empty_clone( $self ); return $clone; } sub clear { my $self = shift; undef %{ $self }; undef @{ $self }{ "as_string" }; } sub _union ($$) { my ($this, $that) = @_; my $this_universe = $this->universe; return (undef, 1, undef) unless $this_universe == $that->universe; return ($this->clone, 0, ref $this) if $that->is_null; return ($that->clone, 0, ref $that) if $this->is_null; return ($this, 1, ref $this) if $this->is_universal; return ($that, 1, ref $that) if $that->is_universal; my $union = $this->clone; $union->insert( $that->elements ); return ($union, $union->is_universal, ref $this); } sub _union_overload { my ($this, $that) = _binary_underload( \@_ ); my ($union, $is_universal, $class) = $this->_union( $that ); return $union; } sub union { my $self = shift; my $union = $self->clone; my $is_universal; my $class; foreach my $next ( @_ ) { unless ($next->is_null) { ($union, $is_universal, $class) = $union->_union( $next ); last if $is_universal; } } $union = $self if $is_universal && $union->size == $self->size; return $union; } sub _intersection ($$) { my $this = shift; my $that = shift; return (undef, 1) unless $this->universe == $that->universe; return ($this->null, 1) if $this->is_null || $that->is_null; return ($this->clone, 0) if $that->is_universal; return ($that->clone, 0) if $this->is_universal; my $intersection = $this->clone; my %intersection = _make_elements $intersection->elements; delete @intersection{ keys %{{ _make_elements $that->elements }} }; $intersection->delete( values %intersection ); return ($intersection, $intersection->is_null); } sub _intersection_overload { my ($this, $that) = _binary_underload( \@_ ); my ($intersection) = $this->_intersection( $that ); return $intersection; } sub intersection { my $self = shift; my $intersection = $self->clone; my $is_null; foreach my $next ( @_ ) { unless ($next->is_universal) { ($intersection, $is_null) = $intersection->_intersection( $next ); last if $is_null; } } $intersection = $self if $is_null && $intersection->size == $self->size; return $intersection; } sub _difference ($$) { my $this = shift; my $that = shift; return undef unless $this->universe == $that->universe; return $this->null if $this->is_null || $that->is_universal; return $this->clone if $that->is_null; my $difference = $this->clone; my %that = _make_elements $that->elements; $difference->delete( values %that ); return $difference; } sub _difference_overload { my ($this, $that) = _binary_underload( \@_ ); return $this->_difference( $that ); } sub difference { my $this = shift; return $this->null if $this->is_null; return $this->clone unless @_; my $that = shift; $that = $that->union( @_ ); return undef unless defined $that; return $this->null if $that->is_universal; my $difference = $this->_difference( $that ); $difference = $this if $difference->size == $this->size; return $difference; } sub _symmetric_difference ($$) { my $this = shift; my $that = shift; return (undef, 1) unless $this->universe == $that->universe; return $that->clone if $this->is_null; return $this->clone if $that->is_null; return $that->complement if $this->is_universal; return $this->complement if $that->is_universal; my $symmetric_difference = $this->clone; $symmetric_difference->invert( $that->elements ); return $symmetric_difference; } sub _symmetric_difference_overload { my ($this, $that ) = _binary_underload( \@_ ); return $this->_symmetric_difference( $that ); } sub symmetric_difference { my $this = shift; my $symmetric_difference = $this->clone; foreach my $next ( @_ ) { $symmetric_difference->invert( $next->elements ); } return $symmetric_difference; } *symmdiff = \&symmetric_difference; sub _complement { my $self = shift; my $complement = (ref $self)->new( $self->universe->elements ); $complement->delete( $self->elements ); return $complement; } sub _complement_overload { _unary_underload( \@_ ); my $self = shift; return $self->_complement; } sub complement { my $self = shift; return $self->_complement; } sub _unique { my $universe = $_[0]->universe; my %frequency; for my $set ( @_ ) { if ($set->universe == $universe) { foreach my $element ( keys %{ $set->{'elements'} } ) { $frequency{ $element }++; } } else { return (ref $_[0])->new(); } } return (ref $_[0])->new(grep { $frequency{ $_ } == 1 } keys %frequency); } sub _unique_overload { my ($this, $that) = _binary_underload( \@_ ); return $this->_unique( $that ); } sub unique { 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 { my $self = shift; return $self->size == $self->universe->size; } sub is_null { my $self = shift; return $self->size == 0; } *is_empty = \&is_null; sub null { my $self = shift; return $self->universe->null; } *empty = \&null; sub _compare { my $a = shift; my $b = shift; return "$a" eq "$b" ? 'equal' : 'different'; } sub compare { my $a = shift; my $b = shift; return _compare("$a", "$b") unless ref $a && $a->isa(__PACKAGE__) && ref $b && $b->isa(__PACKAGE__); return 'disjoint universes' unless $a->universe == $b->universe; my $c = $a->intersection($b); my $na = $a->size; my $nb = $b->size; my $nc = $c->size; return 'proper superset' if $na && $nb == 0; return 'proper subset' if $na == 0 && $nb; return 'disjoint' if $na && $nb && $nc == 0; return 'equal' if $na == $nc && $nb == $nc; return 'proper superset' if $nb == $nc; return 'proper subset' if $na == $nc; return 'proper intersect'; } sub is_disjoint { my $a = shift; my $b = shift; return $a->compare($b) eq 'disjoint' || $a->compare($b) eq 'disjoint universes'; } sub is_equal { my $a = shift; my $b = shift; return $a->compare($b) eq 'equal'; } sub is_proper_subset { my $a = shift; my $b = shift; return $a->compare($b) eq 'proper subset'; } sub is_proper_superset { my $a = shift; my $b = shift; return $a->compare($b) eq 'proper superset'; } sub is_properly_intersecting { my $a = shift; my $b = shift; return $a->compare($b) eq 'proper intersect'; } sub is_subset { my $a = shift; my $b = shift; my $c = $a->compare($b); return $c eq 'equal' || $c eq 'proper subset'; } sub is_superset { my $a = shift; my $b = shift; my $c = $a->compare($b); return $c eq 'equal' || $c eq 'proper superset'; } sub cmp { return "$_[0]" cmp "$_[1]"; } sub have_same_universe { my $self = shift; my $universe = $self->universe; foreach my $set ( @_ ) { return 0 unless $set->universe == $universe; } return 1; } sub _elements_have_reference { my $self = shift; my $elements = shift; foreach my $element (@$elements) { return 1 if ref $element; } return 0; } use constant RECURSIVE_SELF => 1; use constant RECURSIVE_DEEP => 2; sub _elements_as_string { my $self = shift; my $history = shift; my @elements = $self->elements; my $self_id = _strval($self); my %history; %history = %{ $history } if defined $history; my $have_reference = $self->_elements_have_reference(\@elements); my @simple_elements; my @complex_elements; my $recursive; foreach my $element (@elements) { my $element_id = _strval($element); if (exists $history{ $element_id }) { if ($element_id eq $self_id) { $recursive = RECURSIVE_SELF; } else { $recursive = RECURSIVE_DEEP; } } elsif (blessed $element && $element->isa(__PACKAGE__)) { local $history{ $element_id } = 1; push @complex_elements, $element->as_string( \%history ); } else { push @simple_elements, $element; } } @elements = sort @simple_elements; push @elements, sort @complex_elements; return (join($self->_element_separator, @elements), $have_reference, $recursive); } my $AS_STRING_CALLBACK = sub { my $self = shift; my $string = ''; if (exists $self->{'as_string'}) { $string = $self->{'as_string'}; } else { ($string, my $have_reference, my $is_recursive) = $self->_elements_as_string(@_ ? shift : { _strval($self) => 1 }); $string .= $self->_element_separator . "..." if $is_recursive; $string = sprintf $self->_set_format, $string; $self->{'as_string'} = $string unless $have_reference; } return $string; }; my $as_string_callback = $AS_STRING_CALLBACK; sub as_string_callback { my $arg = shift; if (ref $arg) { if (@_) { $arg->{'as_string_callback'} = shift; delete $arg->{'as_string_callback'} unless defined $arg->{'as_string_callback'}; } else { return $arg->{'as_string_callback'}; } } else { if (@_) { $as_string_callback = shift; $as_string_callback = $AS_STRING_CALLBACK unless defined $as_string_callback; } else { return $as_string_callback; } } } sub as_string { my $self = shift; if (exists $self->{'as_string_callback'}) { return $self->{'as_string_callback'}->($self, @_); } else { return $as_string_callback->($self, @_); } } sub _element_separator { my $self = shift; return $self->{'display'}->{'element_separator'} if exists $self->{'display'}->{'element_separator'}; my $universe = $self->universe; return $universe->{'display'}->{'element_separator'} if exists $universe->{'display'}->{'element_separator'}; return (ref $self)->ELEMENT_SEPARATOR; } sub _set_format { my $self = shift; return $self->{'display'}->{'set_format'} if exists $self->{'display'}->{'set_format'}; my $universe = $self->universe; return $universe->{'display'}->{'set_format'} if exists $universe->{'display'}->{'set_format'}; return (ref $self)->SET_FORMAT; } =pod =head1 NAME Set::Scalar::Base - base class for Set::Scalar =head1 SYNOPSIS B. =head1 DESCRIPTION B See the L. =head1 AUTHOR Jarkko Hietaniemi =cut 1; Set-Scalar-1.29/lib/Set/Scalar/ValuedUniverse.pm0000644000175000017500000000220112314042365020701 0ustar davidodavidopackage Set::Scalar::ValuedUniverse; use strict; local $^W = 1; use vars qw($VERSION @ISA); $VERSION = '1.29'; @ISA = qw(Set::Scalar::Virtual Set::Scalar::Base); use Set::Scalar::Virtual; use Set::Scalar::Null; my $UNIVERSE = __PACKAGE__->new; sub SET_FORMAT { "[%s]" } sub universe { my $self = shift; return $UNIVERSE; } sub null { my $self = shift; return Set::Scalar::Null->new( $self ); } =pod =head1 NAME Set::Scalar::ValuedUniverse - universes for valued set members =head1 SYNOPSIS B =head1 DESCRIPTION There are only two guaranteed interfaces, both sort of indirect. The first one is accessing the universe of a valued set: $valued_set->universe This contains the members of the universe $valued_set->universe->members of the C<$valued_set>. The second supported interface is displaying universes of valued sets. print $valued_set->universe, "\n"; This will display the members of the valued set inside square brackets: [], as opposed to valued sets, which have their members shown inside parentheses: (). =head1 AUTHOR Jarkko Hietaniemi =cut 1;