File Coverage

blib/lib/OBO/Util/Set.pm
Criterion Covered Total %
statement 74 76 97.3
branch 14 18 77.7
condition n/a
subroutine 12 12 100.0
pod 9 10 90.0
total 109 116 93.9


line stmt bran cond sub pod time code
1             # $Id: Set.pm 2014-09-29 erick.antezana $
2             #
3             # Module : Set.pm
4             # Purpose : An implementation of a Set of scalars.
5             # License : Copyright (c) 2006-2014 by Erick Antezana. All rights reserved.
6             # This program is free software; you can redistribute it and/or
7             # modify it under the same terms as Perl itself.
8             # Contact : Erick Antezana
9             #
10             # TODO implement function 'eliminate duplicates', see GoaAssociationSet.t
11             package OBO::Util::Set;
12              
13 23     23   8921 use strict;
  23         32  
  23         714  
14 23     23   107 use warnings;
  23         28  
  23         10903  
15              
16             sub new {
17 24887     24887 0 20067 my $class = shift;
18 24887         22300 my $self = {};
19 24887         17577 @{$self->{SET}} = ();
  24887         37777  
20            
21 24887         30094 bless ($self, $class);
22 24887         43547 return $self;
23             }
24              
25             =head2 add
26              
27             Usage - $set->add($element)
28             Returns - true if the element was successfully added
29             Args - the element to be added
30             Function - adds an element to this set
31            
32             =cut
33              
34             sub add {
35 11852     11852 1 11025 my ($self, $ele) = @_;
36 11852         9003 my $result = 0; # nothing added
37 11852 50       16005 if ($ele) {
38 11852 100       15004 if ( !$self -> contains($ele) ) {
39 11827         8052 push @{$self->{SET}}, $ele;
  11827         13789  
40 11827         10923 $result = 1; # successfully added
41             }
42             }
43 11852         18795 return $result;
44             }
45              
46             =head2 add_all
47              
48             Usage - $set->add_all($ele1, $ele2, $ele3, ...)
49             Returns - true if the elements were successfully added
50             Args - the elements to be added
51             Function - adds the given elements to this set
52            
53             =cut
54              
55             sub add_all {
56 2306     2306 1 2291 my $self = shift;
57 2306         1890 my $result = 1; # something added
58 2306         3043 foreach (@_) {
59 9120         10206 $result *= $self->add ($_);
60             }
61 2306         3190 return $result;
62             }
63              
64             =head2 get_set
65              
66             Usage - $set->get_set()
67             Returns - this set
68             Args - none
69             Function - returns this set
70            
71             =cut
72              
73             sub get_set {
74 38510     38510 1 32393 my $self = shift;
75 38510 100       45167 return (!$self->is_empty())?@{$self->{SET}}:();
  7529         16616  
76             }
77              
78             =head2 contains
79              
80             Usage - $set->contains($ele)
81             Returns - 1 (true) if this set contains the given element
82             Args - the element to be checked
83             Function - checks if this set constains the given element
84            
85             =cut
86              
87             sub contains {
88 12841     12841 1 10616 my ($self, $target) = @_;
89 12841         9298 my $result = 0;
90 12841         8501 foreach my $ele ( @{$self->{SET}}) {
  12841         15090  
91 24598 100       37732 if ( $target eq $ele) {
92 3052         2737 $result = 1;
93 3052         3402 last;
94             }
95             }
96 12841         23320 return $result;
97             }
98              
99             =head2 size
100              
101             Usage - $set->size()
102             Returns - the size of this set
103             Args - none
104             Function - tells the number of elements held by this set
105            
106             =cut
107              
108             sub size {
109 70     70 1 94 my $self = shift;
110 70         71 return $#{$self->{SET}} + 1;
  70         276  
111             }
112              
113             =head2 clear
114              
115             Usage - $set->clear()
116             Returns - none
117             Args - none
118             Function - clears this list
119            
120             =cut
121              
122             sub clear {
123 10     10 1 19 my $self = shift;
124 10         14 @{$self->{SET}} = ();
  10         25  
125             }
126              
127             =head2 remove
128              
129             Usage - $set->remove($element_to_be_removed)
130             Returns - 1 (true) if this set contained the given element
131             Args - element to be removed from this set, if present
132             Function - removes an element from this set if it is present
133            
134             =cut
135              
136             sub remove {
137 2     2 1 5 my $self = shift;
138 2         2 my $element_to_be_removed = shift;
139 2         6 my $result = $self->contains($element_to_be_removed);
140 2 100       7 if ($result) {
141 1         3 for (my $i = 0; $i <= $#{$self->{SET}}; $i++) {
  3         15  
142 3 100       3 if ($element_to_be_removed eq ${$self->{SET}}[$i]) {
  3         9  
143 1         2 splice(@{$self->{SET}}, $i, 1); # erase the slot
  1         4  
144 1         2 last;
145             }
146             }
147             }
148 2         4 return $result;
149             }
150              
151             =head2 is_empty
152              
153             Usage - $set->is_empty()
154             Returns - true if this set is empty
155             Args - none
156             Function - checks if this set is empty
157            
158             =cut
159              
160             sub is_empty {
161 38533     38533 1 26546 my $self = shift;
162 38533         26531 return ($#{$self->{SET}} == -1);
  38533         114620  
163             }
164              
165             =head2 equals
166              
167             Usage - $set->equals($another_set)
168             Returns - either 1 (true) or 0 (false)
169             Args - the set (Core::Util::Set) to compare with
170             Function - tells whether this set is equal to the given one
171            
172             =cut
173              
174             sub equals {
175 1     1 1 1 my $self = shift;
176 1         2 my $result = 0; # I initially guess they're NOT identical
177 1 50       3 if (@_) {
178 1         1 my $other_set = shift;
179 1         2 my %count = ();
180            
181 1         1 my @this = map ({scalar $_;} @{$self->{SET}});
  4         6  
  1         3  
182 1         2 my @that = map ({scalar $_;} $other_set->get_set());
  4         4  
183            
184 1 50       4 if ($#this == $#that) {
185 1         16 foreach (@this, @that) {
186 8         10 $count{$_}++;
187             }
188 1         5 foreach my $count (sort values %count) {
189 4 50       5 if ($count != 2) {
190 0         0 $result = 0;
191 0         0 last;
192             } else {
193 4         6 $result = 1;
194             }
195             }
196             }
197             }
198 1         4 return $result;
199             }
200              
201             1;
202              
203             __END__