package Text::Wigwam::Library::Sets;

    use strict;
    use warnings;
    no warnings q/recursion/;
    our $VERSION = '0.01';

    use base q/Exporter/;

    use Text::Wigwam::Const qw/ ARRAY /;

    our %EXPORT_TAGS = (
        all => [
          qw/
            _proto_intersection         _intersection
            _proto_set_minus            _set_minus
            _proto_symdiff              _symdiff
            _proto_symmetric_difference _symmetric_difference
            _proto_union                _union
          /
        ],
        intersection => [ qw/ _proto_intersection _intersection / ],
        set_minus    => [ qw/ _proto_set_minus    _set_minus / ],
        symdiff      => [ qw/ _proto_symdiff      _symdiff / ],
        symmetric_difference => [
          qw/
            _proto_symmetric_difference
            _symmetric_difference
          /
        ],
        union => [ qw/ _proto_union _union / ],
    );
    our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
    our @EXPORT = qw( );

=head1 Name

Text::Wigwam::Library::Sets - A Wigwam directive library.

=head1 Description

This library provides directives which are useful for performing operations on
data sets.

=head1 Usage

The directives within this library can be imported into specific branches of
the directive tree (which transcends from  C<Text::Wigwam::Directives>) via
plug-ins or modules using one of the following techniques.

 package Text::Wigwam::Directives::some::arbitrary::branch;
 # import everything
 use Text::Wigwam::Library::Sets qw/:all/;

 package Text::Wigwam::Directives::another::arbitrary::branch;
 # import selectively
 use Text::Wigwam::Library::Sets( qw /
  :intersection
  :set_minus
  :symdiff
  :symmetric_difference
  :union
 / );

=head1 Directives

=cut

sub _proto_intersection { [ ARRAY, ARRAY ] }
sub _intersection {
    my($setA, $setB, $intersect) = ( $_[0]->get_arg, $_[0]->get_arg, [] );
    my(%setAh, %setBh);
    my $setAB = distinct( [ @$setA, @$setB ] );
    @setAh{ @$setA } = ( @$setA ); @setBh{ @$setB } = ( @$setB );
    defined($setBh{$_}) and defined($setAh{$_}) and push(@$intersect, $_)
      for @$setAB;
    return $intersect;
}

=head2 #intersection I<array1> I<array2>

Returns an array of elements common to both I<array1> and I<array2>

 [!!
   #join ", " #intersection ( 1 2 3 4 5 6 ) ( 2 4 6 8 10 )
  /* output: 2, 4, 6 */
 !!]

=cut

sub _proto_set_minus { [ ARRAY, ARRAY ] }
sub _set_minus {
    my( $setA, $setB, $array ) = ( $_[0]->get_arg, $_[0]->get_arg, [] );
    my( %setBh, $element, $key );
    @setBh{ @$setB } = @$setB;
    !defined( $setBh{$_} ) and push( @$array, $_ ) for @$setA;
    return $array;
}

=head2 #set_minus I<array1> I<array2>

Returns an array containing elements from I<array1> that are not in I<array2>.

 [!!
  #join ", " #set_minus ( 1 2 3 4 5 6 ) ( 2 4 6 8 10 )
  /* output: 1, 3 ,5 */
 !!]

=cut

sub _proto_symdiff { _proto_symmetric_difference(@_) }
sub _symdiff { _symmetric_difference(@_) }

=head2 #symdiff I<array1> I<array2>

Shorthand for C<#symmetric_difference>.

=cut

sub _proto_symmetric_difference { [ ARRAY, ARRAY ] }
sub _symmetric_difference {
    my( $setA, $setB, $symdiff ) = ( $_[0]->get_arg, $_[0]->get_arg, [] );
    my( %setAh, %setBh );
    my( $setAB ) = distinct( [ @$setA, @$setB ] );
    @setAh{ @$setA } = ( @$setA ); @setBh{ @$setB } = ( @$setB );
    (defined($setBh{$_}) xor defined($setAh{$_})) and push(@$symdiff, $_)
      for @$setAB;
    return $symdiff;
}

=head2 #symmetric_difference I<array1> I<array2>

Returns an array of elements which exist in either I<array1> or I<array2>, but
not both.

 [!!
  #join ", " #symmetric_difference ( 1 2 3 4 5 6 ) ( 2 4 6 8 10 )
  /* output: 1, 3, 5, 8, 10 */
 !!]

=cut

sub _proto_union { [ ARRAY, ARRAY ] }
sub _union { distinct( [ @{$_[0]->get_arg}, @{$_[0]->get_arg} ] ) }

=head2 #union I<array1> I<array2>

Returns an array containing all elements of I<array1> and I<array2> without
duplicates.

 [!!
  #join ", " #union ( 1 2 3 4 5 6 ) ( 5 6 7 8 9 10 )
  /* output: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 */
 !!]

=cut

# removes duplicates in a given list, keeps sequence in order - accepts an
# array reference as its only argument
sub distinct {
    no warnings 'uninitialized';
    my %done;
    [ grep { ++$done{$_} == 1 } @{$_[0]} ];
}

1;
