Set-Functional
view release on metacpan or search on metacpan
return keys %set;
}
=head2 setify_by(&@)
Given a choice function and a list, return a new set defined by the choice
function. Order is not guaranteed.
=cut
sub setify_by(&@){
my $func = shift;
my %set;
@set{ map { $func->($_) } @_ } = @_ if @_;
return values %set;
}
=head1 OPERATORS
return keys %set;
}
=head2 difference_by(&@)
Given a choice function and multiple set references, return a new set with all the elements
in the first set that don't exist in subsequent sets according to the choice function.
=cut
sub difference_by(&@) {
my $func = shift;
my $first = shift;
return unless $first && @$first;
my %set;
@set{ map { $func->($_) } @$first } = @$first;
do { delete @set{ map { $func->($_) } @$_ } if @$_ } for @_;
}
=head2 disjoint_by(&@)
Given a choice function and multiple set references, return corresponding sets containing
all the elements from the original set that exist in any set exactly once
according to the choice function.
=cut
sub disjoint_by(&@) {
my $func = shift;
my %key_to_count;
do { ++$key_to_count{$func->($_)} for @$_ } for @_;
return map { [grep { $key_to_count{$func->($_)} == 1 } @$_] } @_;
}
=head2 distinct(@)
return grep { $element_to_count{$_} == 1 } keys %element_to_count;
}
=head2 distinct_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in any set exactly once according to the choice function.
=cut
sub distinct_by(&@) {
my $func = shift;
my %key_to_count;
for (@_) {
for (@$_) {
my $key = $func->($_);
$key_to_count{$key} = exists $key_to_count{$key} ? undef : $_;
}
}
return keys %set;
}
=head2 intersection_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in all sets according to the choice function.
=cut
sub intersection_by(&@) {
my $func = shift;
my $first = shift;
return unless $first && @$first;
my %set;
@set{ map { $func->($_) } @$first } = @$first;
for (@_) {
}
=head2 symmetric_difference_by(&@)
Given a choice function and multiple set references, return a new set containing
all the elements that exist an odd number of times across all sets according to
the choice function.
=cut
sub symmetric_difference_by(&@) {
my $func = shift;
my $count;
my %key_to_count;
do { ++$key_to_count{$func->($_)} for @$_ } for @_;
return map {
grep {
$count = delete $key_to_count{$func->($_)};
return keys %set;
}
=head2 union_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in any set according to the choice function.
=cut
sub union_by(&@) {
my $func = shift;
my %set;
do { @set{ map { $func->($_) } @$_ } = @$_ if @$_ } for @_;
return values %set;
}
=head1 PREDICATES
return ! @set;
}
=head2 is_disjoint_by(&$$)
Given a choice function and two sets references, return true if both sets
contain none of the same values according to the choice function.
=cut
sub is_disjoint_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return ! @set;
}
=head2 is_equal($$)
Given two set references, return true if both sets contain all the same values.
Aliased by is_equivalent.
is_equal [1 .. 5], [1 .. 5] => true
*is_equivalent = \&is_equal;
=head2 is_equal_by(&$$)
Given a choice function and two sets references, return true if both sets
contain all the same values according to the choice function.
Aliased by is_equivalent_by.
=cut
sub is_equal_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]} && @set == @{$_[2]};
}
*is_equivalent_by = \&is_equal_by;
=head2 is_pairwise_disjoint(@)
Given multiple set references, return true if every set is disjoint from every
other set.
return 1;
}
=head2 is_pairwise_disjoint_by(&@)
Given a choice function and multiple set references, return true if every set
is disjoint from every other set according to the choice function.
=cut
sub is_pairwise_disjoint_by(&@) {
my @sets = &disjoint_by((shift), @_);
do { return 0 if @{$sets[$_]} != @{$_[$_]} } for 0 .. $#sets;
return 1;
}
=head2 is_proper_subset($$)
Given two set references, return true if the first set is fully contained by
but is not equivalent to the second.
}
=head2 is_proper_subset_by(&$$)
Given a choice function and two set references, return true if the first set
is fully contained by but is not equivalent to the second according to the
choice function.
=cut
sub is_proper_subset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]} && @set != @{$_[2]};
}
=head2 is_proper_superset($$)
Given two set references, return true if the first set fully contains but is
not equivalent to the second.
is_proper_superset [1 .. 10], [1 .. 5] => true
}
=head2 is_proper_superset_by(&$$)
Given a choice function and two set references, return true if the first set
fully contains but is not equivalent to the second according to the choice
function.
=cut
sub is_proper_superset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set != @{$_[1]} && @set == @{$_[2]};
}
=head2 is_subset($$)
Given two set references, return true if the first set is fully contained by
the second.
is_subset [1 .. 5], [1 .. 10] => true
return @set == @{$_[0]};
}
=head2 is_subset_by(&$$)
Given a choice function and two set references, return true if the first set
is fully contained by the second according to the choice function.
=cut
sub is_subset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]};
}
=head2 is_superset($$)
Given two set references, return true if the first set fully contains the
second.
is_superset [1 .. 10], [1 .. 5] => true
return @set == @{$_[1]};
}
=head2 is_superset_by(&$$)
Given a choice function and two set references, return true if the first set
fully contains the second according to the choice function.
=cut
sub is_superset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[2]};
}
=head1 AUTHOR
Aaron Cohen, C<< <aarondcohen at gmail.com> >>
Special thanks to:
L<Logan Bell|http://metacpan.org/author/logie>
benchmarks/intersect.pl view on Meta::CPAN
for (@_) {
undef @other_set{@$_};
delete @set{grep { ! exists $other_set{$_} } keys %set};
#return unless keys %set;
%other_set = ();
}
return keys %set;
}
sub intersection_delete_fn(&@) {
my $func = shift;
my $first = shift;
do { return unless @$_ } for @_;
my (%set, %other_set);
@set{ map { $func->($_) } @$first } = @$first;
for (@_) {
benchmarks/intersect.pl view on Meta::CPAN
return values %set;
}
sub intersection_grep {
my %set;
undef @set{@{$_[0]}};
return grep { exists $set{$_} } @{$_[1]};
}
sub intersection_grep_defined_fn(&@) {
my $func = shift;
my $lhs = shift;
return unless $lhs && @$lhs;
my @int;
my %set;
@set{ map { $func->($_) } @$lhs } = @$lhs;
for (@_) {
@int = grep { defined } @set{ map { $func->($_) } @$_ };
return unless @int;
undef %set;
@set{ map { $func->($_) } @int } = @int;
}
return keys %set;
}
sub intersection_grep_exists_fn(&@) {
my $func = shift;
my $lhs = shift;
return unless $lhs && @$lhs;
my @int;
my %set;
@set{ map { $func->($_) } @$lhs } = @$lhs;
for (@_) {
@int = grep { exists $set{$func->($_)} } @$_;
return unless @int;
undef %set;
@set{ map { $func->($_) } @int } = @int;
}
return keys %set;
}
sub intersection_grep_exists_fn_2(&@) {
my $func = shift;
my $lhs = shift;
return unless $lhs && @$lhs;
my @int;
my %set;
@set{ map { $func->($_) } @$lhs } = @$lhs;
for (@_) {
benchmarks/symmetric-difference.pl view on Meta::CPAN
return map {
grep {
$match = $element_to_count{$_} % 2;
$element_to_count{$_} = 0;
$match
} @$_
} @_;
}
sub symmetric_difference_by_assign_fn(&@) {
my $func = shift;
my $element;
my $match;
my %element_to_count;
do { ++$element_to_count{$func->($_)} for @$_ } for @_;
return map {
grep {
benchmarks/symmetric-difference.pl view on Meta::CPAN
sub symmetric_difference_by_delete(@) {
my $count;
my %element_to_count;
do { ++$element_to_count{$_} for @$_ } for @_;
return map { grep { $count = delete $element_to_count{$_}; defined($count) && $count % 2 } @$_ } @_;
}
sub symmetric_difference_by_delete_fn(&@) {
my $func = shift;
my $count;
my %element_to_count;
do { ++$element_to_count{$func->($_)} for @$_ } for @_;
return map { grep { $count = delete $element_to_count{$func->($_)}; defined($count) && $count % 2 } @$_ } @_;
}
sub symmetric_difference_by_exists(@) {
my %element_to_count;
do { ++$element_to_count{$_} for @$_ } for @_;
return map { grep { exists $element_to_count{$_} && delete($element_to_count{$_}) % 2 } @$_ } @_;
}
sub symmetric_difference_by_exists_fn(&@) {
my $func = shift;
my $key;
my %element_to_count;
do { ++$element_to_count{$func->($_)} for @$_ } for @_;
return map { grep { $key = $func->($_); exists $element_to_count{$key} && delete($element_to_count{$key}) % 2 } @$_ } @_;
}
sub symmetric_difference_by_push_fn(&@){
my $func = shift;
my %key_to_elements;
do { push @{$key_to_elements{$func->($_)}}, $_ for @$_ } for @_;
return map { $_->[0] } grep { @$_ % 2 } values %key_to_elements;
}
lib/Set/Functional.pm view on Meta::CPAN
return keys %set;
}
=head2 setify_by(&@)
Given a choice function and a list, return a new set defined by the choice
function. Order is not guaranteed.
=cut
sub setify_by(&@){
my $func = shift;
my %set;
@set{ map { $func->($_) } @_ } = @_ if @_;
return values %set;
}
=head1 OPERATORS
lib/Set/Functional.pm view on Meta::CPAN
return keys %set;
}
=head2 difference_by(&@)
Given a choice function and multiple set references, return a new set with all the elements
in the first set that don't exist in subsequent sets according to the choice function.
=cut
sub difference_by(&@) {
my $func = shift;
my $first = shift;
return unless $first && @$first;
my %set;
@set{ map { $func->($_) } @$first } = @$first;
do { delete @set{ map { $func->($_) } @$_ } if @$_ } for @_;
lib/Set/Functional.pm view on Meta::CPAN
}
=head2 disjoint_by(&@)
Given a choice function and multiple set references, return corresponding sets containing
all the elements from the original set that exist in any set exactly once
according to the choice function.
=cut
sub disjoint_by(&@) {
my $func = shift;
my %key_to_count;
do { ++$key_to_count{$func->($_)} for @$_ } for @_;
return map { [grep { $key_to_count{$func->($_)} == 1 } @$_] } @_;
}
=head2 distinct(@)
lib/Set/Functional.pm view on Meta::CPAN
return grep { $element_to_count{$_} == 1 } keys %element_to_count;
}
=head2 distinct_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in any set exactly once according to the choice function.
=cut
sub distinct_by(&@) {
my $func = shift;
my %key_to_count;
for (@_) {
for (@$_) {
my $key = $func->($_);
$key_to_count{$key} = exists $key_to_count{$key} ? undef : $_;
}
}
lib/Set/Functional.pm view on Meta::CPAN
return keys %set;
}
=head2 intersection_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in all sets according to the choice function.
=cut
sub intersection_by(&@) {
my $func = shift;
my $first = shift;
return unless $first && @$first;
my %set;
@set{ map { $func->($_) } @$first } = @$first;
for (@_) {
lib/Set/Functional.pm view on Meta::CPAN
}
=head2 symmetric_difference_by(&@)
Given a choice function and multiple set references, return a new set containing
all the elements that exist an odd number of times across all sets according to
the choice function.
=cut
sub symmetric_difference_by(&@) {
my $func = shift;
my $count;
my %key_to_count;
do { ++$key_to_count{$func->($_)} for @$_ } for @_;
return map {
grep {
$count = delete $key_to_count{$func->($_)};
lib/Set/Functional.pm view on Meta::CPAN
return keys %set;
}
=head2 union_by(&@)
Given a choice function and multiple set references, return a new set containing all the
elements that exist in any set according to the choice function.
=cut
sub union_by(&@) {
my $func = shift;
my %set;
do { @set{ map { $func->($_) } @$_ } = @$_ if @$_ } for @_;
return values %set;
}
=head1 PREDICATES
lib/Set/Functional.pm view on Meta::CPAN
return ! @set;
}
=head2 is_disjoint_by(&$$)
Given a choice function and two sets references, return true if both sets
contain none of the same values according to the choice function.
=cut
sub is_disjoint_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return ! @set;
}
=head2 is_equal($$)
Given two set references, return true if both sets contain all the same values.
Aliased by is_equivalent.
is_equal [1 .. 5], [1 .. 5] => true
lib/Set/Functional.pm view on Meta::CPAN
*is_equivalent = \&is_equal;
=head2 is_equal_by(&$$)
Given a choice function and two sets references, return true if both sets
contain all the same values according to the choice function.
Aliased by is_equivalent_by.
=cut
sub is_equal_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]} && @set == @{$_[2]};
}
*is_equivalent_by = \&is_equal_by;
=head2 is_pairwise_disjoint(@)
Given multiple set references, return true if every set is disjoint from every
other set.
lib/Set/Functional.pm view on Meta::CPAN
return 1;
}
=head2 is_pairwise_disjoint_by(&@)
Given a choice function and multiple set references, return true if every set
is disjoint from every other set according to the choice function.
=cut
sub is_pairwise_disjoint_by(&@) {
my @sets = &disjoint_by((shift), @_);
do { return 0 if @{$sets[$_]} != @{$_[$_]} } for 0 .. $#sets;
return 1;
}
=head2 is_proper_subset($$)
Given two set references, return true if the first set is fully contained by
but is not equivalent to the second.
lib/Set/Functional.pm view on Meta::CPAN
}
=head2 is_proper_subset_by(&$$)
Given a choice function and two set references, return true if the first set
is fully contained by but is not equivalent to the second according to the
choice function.
=cut
sub is_proper_subset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]} && @set != @{$_[2]};
}
=head2 is_proper_superset($$)
Given two set references, return true if the first set fully contains but is
not equivalent to the second.
is_proper_superset [1 .. 10], [1 .. 5] => true
lib/Set/Functional.pm view on Meta::CPAN
}
=head2 is_proper_superset_by(&$$)
Given a choice function and two set references, return true if the first set
fully contains but is not equivalent to the second according to the choice
function.
=cut
sub is_proper_superset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set != @{$_[1]} && @set == @{$_[2]};
}
=head2 is_subset($$)
Given two set references, return true if the first set is fully contained by
the second.
is_subset [1 .. 5], [1 .. 10] => true
lib/Set/Functional.pm view on Meta::CPAN
return @set == @{$_[0]};
}
=head2 is_subset_by(&$$)
Given a choice function and two set references, return true if the first set
is fully contained by the second according to the choice function.
=cut
sub is_subset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[1]};
}
=head2 is_superset($$)
Given two set references, return true if the first set fully contains the
second.
is_superset [1 .. 10], [1 .. 5] => true
lib/Set/Functional.pm view on Meta::CPAN
return @set == @{$_[1]};
}
=head2 is_superset_by(&$$)
Given a choice function and two set references, return true if the first set
fully contains the second according to the choice function.
=cut
sub is_superset_by(&$$) {
my @set = &intersection_by(@_[0,1,2]);
return @set == @{$_[2]};
}
=head1 AUTHOR
Aaron Cohen, C<< <aarondcohen at gmail.com> >>
Special thanks to:
L<Logan Bell|http://metacpan.org/author/logie>
( run in 0.269 second using v1.01-cache-2.11-cpan-49f99fa48dc )