#!/run/bin/perl # for-walkingthecow-balls.pl # = Copyright 2010 Xiong Changnian = # = Free Software = Artistic License 2.0 = NO WARRANTY = use 5.010; use strict; use warnings; use List::Compare; # Compare elements of two or more lists #~ use Devel::Comments '###', '####'; #----------------------------------------------------------------------------# # Declare hypothetical data set. # These are the things that may be distributed to containers, non-uniquely. my @balls = qw( red green blue yellow ); # These are the containers. Note the spares for further fooling around. my %boxes = ( #~ round => [ qw( red green blue yellow ) ], #~ cube => [ qw( red green blue yellow ) ], #~ flat => [ qw( red green blue yellow ) ], round => [ qw( red ) ], cube => [ qw( green blue ) ], flat => [ qw( red green blue yellow ) ], ); # This is the goal state. my $want = 1; # How many boxes contain all balls? #----------------------------------------------------------------------------# # Invoke code under test. say qq{Want: $want, Got: }, do_compare (\@balls, values %boxes ); exit(0); #----------------------------------------------------------------------------# # Uses List::Compare. Calling syntax is highly flexible and orthogonal. sub do_compare { my $unbox_ref = shift; my @boxes_refs = @_; my $got ; # accumulate "finds" here # Construct a work-object. my $lc = List::Compare->new( '-u', $unbox_ref, @boxes_refs ); # unsorted # Pretty-print for debug. $lc->print_subset_chart; # Find out if any (other) box contains all the elements in the unbox. my $ixL = 0; # the unbox; index of first ref to new() for my $ixR ( 1..scalar @boxes_refs ) { my $bool = $lc->is_LsubsetR( $ixL, $ixR ); # true if all L in R ### $bool $got += $bool; }; return $got; }; __END__ Subset Relationships Right: 0 1 2 3 Left: 0: 1 0 0 1 1: 1 1 0 1 2: 1 0 1 1 3: 1 0 0 1 Want: 1, Got: 1