#!/run/bin/perl
#       for-walkingthecow-balls.pl
#       = Copyright 2010 Xiong Changnian <xiong@cpan.org> =
#       = Free Software = Artistic License 2.0 = NO WARRANTY =

use 5.010;
use strict;
use warnings;

use List::Compare;              # Compare elements of two or more list
+s

#~ use Devel::Comments '###', '####';

#---------------------------------------------------------------------
+-------#

# Declare hypothetical data set.

# These are the things that may be distributed to containers, non-uniq
+uely.
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 );  # u
+nsorted
    
    # Pretty-print for debug.
    $lc->print_subset_chart;
    
    # Find out if any (other) box contains all the elements in the unb
+ox.
    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
[download]