File Coverage

blib/lib/OBO/Util/ObjectIdSet.pm
Criterion Covered Total %
statement 34 71 47.8
branch 3 18 16.6
condition n/a
subroutine 10 15 66.6
pod 9 10 90.0
total 56 114 49.1


line stmt bran cond sub pod time code
1             # $Id: ObjectIdSet.pm 2015-02-12 erick.antezana $
2             #
3             # Module : ObjectIdSet.pm
4             # Purpose : A generic set of ontology objects.
5             # License : Copyright (c) 2006-2015 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             package OBO::Util::ObjectIdSet;
11              
12 23     23   112 use Carp;
  23         39  
  23         1387  
13 23     23   113 use strict;
  23         40  
  23         475  
14 23     23   109 use warnings;
  23         36  
  23         17273  
15              
16             sub new {
17 38227     38227 0 51255 my $class = shift;
18 38227         52030 my $self = {};
19 38227         80223 $self->{MAP} = {}; # id vs. obj
20            
21 38227         58700 bless ($self, $class);
22 38227         92082 return $self;
23             }
24              
25             =head2 add
26              
27             Usage - $set->add()
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 0     0 1 0 my ($self, $ele) = @_;
36 0         0 my $result = 0; # nothing added
37 0 0       0 if ($ele) {
38 0 0       0 if (!$self->contains($ele)) {
39 0         0 $self->{MAP}->{$ele} = $ele;
40 0         0 $result = 1; # successfully added
41             }
42             } else {
43             # don't add repeated elements
44             }
45 0         0 return $result;
46             }
47              
48             =head2 add_all
49              
50             Usage - $set->add_all($ele1, $ele2, $ele3, ...)
51             Returns - true if the elements were successfully added
52             Args - the elements to be added
53             Function - adds the given elements to this set
54            
55             =cut
56              
57             sub add_all {
58 0     0 1 0 my $self = shift;
59 0         0 my $result = 1; # something added
60 0         0 foreach (@_) {
61 0         0 $result *= $self->add($_);
62             }
63 0         0 return $result;
64             }
65              
66             =head2 get_set
67              
68             Usage - $set->get_set()
69             Returns - this set
70             Args - none
71             Function - returns this set
72            
73             =cut
74              
75             sub get_set {
76 52733     52733 1 68858 my $self = shift;
77 52733     51773   136724 my @the_set = __sort_by_id(sub {shift}, values (%{$self->{MAP}})); # I know, it is an ordered "set".
  51773         154394  
  52733         149713  
78 52733 100       174575 return (!$self->is_empty())?@the_set:();
79             }
80              
81             sub __sort_by_id {
82 52733 50   52733   123753 caller eq __PACKAGE__ or croak;
83 52733         85136 my ($subRef, @input) = @_;
84 51773         128552 my @result = map { $_->[0] } # restore original values
85 43200         71083 sort { $a->[1] cmp $b->[1] } # sort
86 52733         102255 map { [$_, &$subRef($_->id())] } # transform: value, sortkey
  51773         134217  
87             @input;
88             }
89              
90             =head2 contains
91              
92             Usage - $set->contains($element)
93             Returns - 1 (true) if this set contains the given element
94             Args - the element to be checked
95             Function - checks if this set constains the given element
96            
97             =cut
98              
99             sub contains {
100 0     0 1 0 my ($self, $target) = @_;
101 0 0       0 return (defined $self->{MAP}->{$target})?1:0;
102             }
103              
104             =head2 size
105              
106             Usage - $set->size()
107             Returns - the size of this set
108             Args - none
109             Function - tells the number of elements held by this set
110            
111             =cut
112              
113             sub size {
114 127     127 1 622 my $self = shift;
115 127         179 my $size = keys %{$self->{MAP}};
  127         289  
116 127         521 return $size;
117             }
118              
119             =head2 clear
120              
121             Usage - $set->clear()
122             Returns - none
123             Args - none
124             Function - clears this list
125            
126             =cut
127              
128             sub clear {
129 6     6 1 12 my $self = shift;
130 6         19 $self->{MAP} = {};
131             }
132              
133             =head2 remove
134              
135             Usage - $set->remove($element_to_be_removed)
136             Returns - 1 (true) if this set contained the given element
137             Args - element to be removed from this set, if present
138             Function - removes an element from this set if it is present
139            
140             =cut
141              
142             sub remove {
143 0     0 1 0 my ($self, $element_to_be_removed) = @_;
144 0         0 my $result = $self->contains($element_to_be_removed);
145 0 0       0 delete $self->{MAP}->{$element_to_be_removed} if ($result);
146 0         0 return $result;
147             }
148              
149             =head2 is_empty
150              
151             Usage - $set->is_empty()
152             Returns - true if this set is empty
153             Args - none
154             Function - checks if this set is empty
155            
156             =cut
157              
158             sub is_empty {
159 52750     52750 1 66172 my $self = shift;
160 52750         55977 return ((keys(%{$self->{MAP}}) + 0) == 0);
  52750         271299  
161             }
162              
163             =head2 equals
164              
165             Usage - $set->equals($another_set)
166             Returns - either 1 (true) or 0 (false)
167             Args - the set (Core::Util::Set) to compare with
168             Function - tells whether this set is equal to the given one
169            
170             =cut
171              
172             sub equals {
173 0     0 1   my $self = shift;
174 0           my $result = 0; # I initially guess they're NOT identical
175 0 0         if (@_) {
176 0           my $other_set = shift;
177            
178 0           my %count = ();
179            
180 0           my @this = map ({scalar $_;} sort values %{$self->{MAP}});
  0            
  0            
181 0           my @that = map ({scalar $_;} $other_set->get_set());
  0            
182            
183 0 0         if ($#this == $#that) {
184 0           foreach (@this, @that) {
185 0           $count{$_}++;
186             }
187 0           foreach my $count (sort values %count) {
188 0 0         if ($count != 2) {
189 0           $result = 0;
190 0           last;
191             } else {
192 0           $result = 1;
193             }
194             }
195             }
196             }
197 0           return $result;
198             }
199              
200             1;
201              
202             __END__