The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id: Set.pm 2014-09-29 erick.antezana $
#
# Module  : Set.pm
# Purpose : An implementation of a Set of scalars.
# License : Copyright (c) 2006-2014 by Erick Antezana. All rights reserved.
#           This program is free software; you can redistribute it and/or
#           modify it under the same terms as Perl itself.
# Contact : Erick Antezana <erick.antezana -@- gmail.com>
#
# TODO implement function 'eliminate duplicates', see GoaAssociationSet.t
package OBO::Util::Set;

use strict;
use warnings;

sub new {
	my $class        = shift;
	my $self         = {};
	@{$self->{SET}}  = ();
	
	bless ($self, $class);
	return $self;
}

=head2 add

  Usage    - $set->add($element)
  Returns  - true if the element was successfully added
  Args     - the element to be added
  Function - adds an element to this set
  
=cut

sub add {
	my ($self, $ele) = @_;
	my $result = 0; # nothing added
	if ($ele) {
		if ( !$self -> contains($ele) ) {
			push @{$self->{SET}}, $ele;
			$result = 1; # successfully added
		}
	}
	return $result;
}

=head2 add_all

  Usage    - $set->add_all($ele1, $ele2, $ele3, ...)
  Returns  - true if the elements were successfully added
  Args     - the elements to be added
  Function - adds the given elements to this set
  
=cut

sub add_all {
	my $self = shift;
	my $result = 1; # something added
	foreach (@_) {
		$result *= $self->add ($_);
	}
	return $result;
}

=head2 get_set

  Usage    - $set->get_set()
  Returns  - this set
  Args     - none
  Function - returns this set
  
=cut

sub get_set {
	my $self = shift;
	return (!$self->is_empty())?@{$self->{SET}}:();
}

=head2 contains

  Usage    - $set->contains($ele)
  Returns  - 1 (true) if this set contains the given element
  Args     - the element to be checked
  Function - checks if this set constains the given element
  
=cut

sub contains {
	my ($self, $target) = @_;
	my $result = 0;
	foreach my $ele ( @{$self->{SET}}) {
		if ( $target eq $ele) {
			$result = 1;
			last;
		}
	}
	return $result;
}

=head2 size

  Usage    - $set->size()
  Returns  - the size of this set
  Args     - none
  Function - tells the number of elements held by this set
  
=cut

sub size {
	my $self = shift;
	return $#{$self->{SET}} + 1;
}

=head2 clear

  Usage    - $set->clear()
  Returns  - none
  Args     - none
  Function - clears this list
  
=cut

sub clear {
	my $self = shift;
	@{$self->{SET}} = ();
}

=head2 remove

  Usage    - $set->remove($element_to_be_removed)
  Returns  - 1 (true) if this set contained the given element
  Args     - element to be removed from this set, if present
  Function - removes an element from this set if it is present
  
=cut

sub remove {
	my $self = shift;
	my $element_to_be_removed = shift;
	my $result = $self->contains($element_to_be_removed);
	if ($result) {
		for (my $i = 0; $i <= $#{$self->{SET}}; $i++) {
			if ($element_to_be_removed eq ${$self->{SET}}[$i]) {
				splice(@{$self->{SET}}, $i, 1); # erase the slot
				last;
			}
		}
	}
	return $result;
}

=head2 is_empty

  Usage    - $set->is_empty()
  Returns  - true if this set is empty
  Args     - none
  Function - checks if this set is empty
  
=cut

sub is_empty {
	my $self = shift;
	return ($#{$self->{SET}} == -1);
}

=head2 equals

  Usage    - $set->equals($another_set)
  Returns  - either 1 (true) or 0 (false)
  Args     - the set (Core::Util::Set) to compare with
  Function - tells whether this set is equal to the given one
  
=cut

sub equals {
	my $self = shift;
	my $result = 0; # I initially guess they're NOT identical
	if (@_) {
		my $other_set = shift;
		my %count = ();
	
		my @this = map ({scalar $_;} @{$self->{SET}});
		my @that = map ({scalar $_;} $other_set->get_set());
		
		if ($#this == $#that) {
			foreach (@this, @that) {
				$count{$_}++;
			}
			foreach my $count (sort values %count) {
				if ($count != 2) {
					$result = 0;
					last;
				} else {
					$result = 1;
				}
			}
		}
	}
	return $result;
}

1;

__END__


=head1 NAME

OBO::Util::Set - An implementation of a set of scalars (sensu PERL).
    
=head1 SYNOPSIS

use OBO::Util::Set;

use strict;

my $my_set = OBO::Util::Set->new();

$my_set->add("APO:P0000001");

print "contains" if ($my_set->contains("APO:P0000001"));

$my_set->add_all("APO:P0000002", "APO:P0000003", "APO:P0000004");

print "contains" if ($my_set->contains("APO:P0000002") && $my_set->contains("APO:P0000003") && $my_set->contains("APO:P0000004"));

foreach ($my_set->get_set()) {

	print $_, "\n";

}

print "\nContained!\n" if ($my_set->contains("APO:P0000001"));

my $my_set2 = OBO::Util::Set->new();

$my_set2->add_all("APO:P0000001", "APO:P0000002", "APO:P0000003", "APO:P0000004");

print "contains" if ($my_set2->contains("APO:P0000002") && $my_set->contains("APO:P0000003") && $my_set->contains("APO:P0000004"));

$my_set->equals($my_set2);

$my_set2->size() == 4;

$my_set2->remove("APO:P0000003");

print "contains" if ($my_set2->contains("APO:P0000001") && $my_set->contains("APO:P0000002") && $my_set->contains("APO:P0000004"));

$my_set2->size() == 3;

$my_set2->remove("APO:P0000005");

print "contains" if ($my_set2->contains("APO:P0000001") && $my_set->contains("APO:P0000002") && $my_set->contains("APO:P0000004"));

$my_set2->size() == 3;

$my_set2->clear();

print "not contains" if (!$my_set2->contains("APO:P0000001") || !$my_set->contains("APO:P0000002") || !$my_set->contains("APO:P0000004"));

$my_set2->size() == 0;

if ($my_set2->is_empty()) {
	print "my_set2 is empty";
}


=head1 DESCRIPTION

A collection that contains no duplicate elements. More formally, sets contain no 
pair of elements $e1 and $e2 such that $e1->equals($e2). As implied by its name, 
this interface models the mathematical set abstraction.

=head1 AUTHOR

Erick Antezana, E<lt>erick.antezana -@- gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2006-2014 by Erick Antezana

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.

=cut