File Coverage

blib/lib/OBO/XO/OBO_ID_Term_Map.pm
Criterion Covered Total %
statement 87 130 66.9
branch 18 42 42.8
condition 8 36 22.2
subroutine 14 21 66.6
pod 15 16 93.7
total 142 245 57.9


line stmt bran cond sub pod time code
1             # $Id: OBO_ID_Term_Map.pm 2014-20-02 erick.antezana $
2             #
3             # Module : OBO_ID_Term_Map.pm
4             # Purpose : A (birectional) map OBO_ID vs Term name.
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             package OBO::XO::OBO_ID_Term_Map;
11              
12 3     3   12685 use Carp;
  3         6  
  3         204  
13 3     3   16 use strict;
  3         4  
  3         119  
14              
15 3     3   1088 use open qw(:std :utf8); # Make All I/O Default to UTF-8
  3         2589  
  3         18  
16              
17 3     3   1643 use OBO::XO::OBO_ID_Set;
  3         6  
  3         3792  
18              
19             sub new {
20 2     2 0 13 my $class = shift;
21 2         3 my $self = {};
22 2         27 $self->{FILE} = shift;
23              
24 2         3 %{ $self->{MAP_BY_ID} } = (); # key=obo_id; value=term name
  2         5  
25 2         3 %{ $self->{MAP_BY_TERM} } = (); # key=term name; value=obo_id
  2         2  
26 2         15 $self->{KEYS} = OBO::XO::OBO_ID_Set->new();
27              
28 2         2 bless( $self, $class );
29              
30 2 50       10 croak if ( !defined $self->{FILE} );
31              
32             # if the file exists:
33 2 50 33     64 if ( -e $self->{FILE} && -r $self->{FILE} ) {
34 2         53 open( OBO_ID_MAP_IN_FH, '<'.$self->{FILE} );
35 2         39 while () {
36 16         21 chomp;
37 16 50       56 if ( $_ =~ /(\w+:\d+)\s+(.*)/ ) {
38 16         25 my ( $key, $value ) = ( $1, $2 ); # e.g.: GO:0007049 cell cycle
39 16         32 $self->{MAP_BY_ID}->{$key} = $value; # put
40 16         51 $self->{MAP_BY_TERM}->{$value} = $key; # put
41             } else {
42 0         0 warn "\nThe following entry: '", $_, "' found in '", $self->{FILE}, "' is not recognized as a valid OBO key-value pair!";
43             }
44             }
45 2         12 close OBO_ID_MAP_IN_FH;
46             } else {
47 0         0 open( OBO_ID_MAP_IN_FH, "$self->{FILE}" );
48             # TODO Should I include a file creation date?
49 0         0 close OBO_ID_MAP_IN_FH;
50             }
51              
52 2         3 $self->{KEYS}->add_all_as_string( sort keys( %{ $self->{MAP_BY_ID} } ) );
  2         20  
53 2         5 return $self;
54             }
55              
56             sub _is_valid_id () {
57 5     5   4 my $new_name = $_[0];
58 5 50       35 return ($new_name =~ /\w+:\d+/)?1:0;
59             }
60              
61             =head2 put
62              
63             Usage - $map->put("GO:0007049", "cell cycle")
64             Returns - the size of map
65             Args - OBO id (string), term name (string)
66             Function - either puts a new entry in the map or modifies an existing entry by changing the term name
67             Remark - prior to adding new entries to the map, use method get_new_id()
68            
69             =cut
70              
71             sub put {
72 7     7 1 9 my ( $self, $new_id, $new_name ) = @_;
73            
74 7 50 33     26 if ( $new_id && $new_name ) {
75 7 50       13 croak "The ID is not valid: '$new_id'\n" if ($self->_is_valid_id($new_id));
76              
77 7         11 my $has_key = $self->contains_key($new_id);
78 7         9 my $has_value = $self->contains_value($new_name);
79              
80 7 100 66     34 if (!$has_key && !$has_value) { # new pair : 'new key' and 'new value'
    50 33        
    0 0        
81 4         9 $self->{MAP_BY_ID}->{$new_id} = $new_name; # put: id->name
82 4         6 $self->{MAP_BY_TERM}->{$new_name} = $new_id; # put: name->id
83 4         15 $self->{KEYS}->add_as_string($new_id);
84             } elsif ($has_key && !$has_value) { # updating the value (=term name)
85 3         5 my $old_value = $self->{MAP_BY_ID}->{$new_id};
86 3         6 $self->{MAP_BY_ID}->{$new_id} = $new_name; # updating the value
87 3         7 delete $self->{MAP_BY_TERM}->{$old_value}; # erase the old entry
88 3         5 $self->{MAP_BY_TERM}->{$new_name} = $new_id; # put: name->id
89             } elsif ($has_key && $has_value) { # the pair: key-value is already there
90 0 0 0     0 if ($self->{MAP_BY_ID}->{$new_id} eq $new_name &&
91             $self->{MAP_BY_TERM}->{$new_name} eq $new_id){ # they should be identical
92             # Do nothing...
93             } else {
94 0         0 warn "The pair: $new_id, $new_name is part of the map BUT they correspond to other entries!";
95             }
96             } else {
97 0         0 croak "This case should have never happened: -> ($new_id, $new_name)";
98             }
99 7         11 return $self->size();
100             } else {
101 0         0 croak "You should provide both a term ID and a term name -> ($new_id, $new_name)\n";
102             }
103             }
104              
105             =head2 get_new_id
106              
107             Usage - $map->get_new_id('GO', 'cell cycle')
108             Returns - a new OBO ID (string)
109             Args - idspace (string), term (string), seed_id (string)
110             Function - get a new OBO ID and insert it (put) into this map
111            
112             =cut
113              
114             sub get_new_id {
115 0     0 1 0 my ( $self, $idspace, $term_name, $seed_id ) = @_;
116 0         0 my $new_id;
117 0 0 0     0 if ( $idspace && $term_name ) {
118 0 0 0     0 if ( $self->is_empty() && !$seed_id) {
    0 0        
      0        
119 0         0 $new_id = $idspace.":0000001"; # use 7 'numeric placeholders'
120             } elsif($seed_id && $seed_id =~ /$idspace:\d{7}/ && !$self->contains_key($seed_id)) {
121 0         0 $new_id = $seed_id; # TODO Test the addition of one more argument: $seed_id = to fix/force the starting ID
122             } else {
123 0         0 $new_id = $self->{KEYS}->get_new_id($idspace);
124             }
125 0         0 $self->put( $new_id, $term_name ); # put: id->name
126             }
127 0         0 return $new_id;
128             }
129              
130             =head2 get_term_by_id
131              
132             Usage - $map->get_term_by_id($obo_id)
133             Returns - the term name (string) associated to the given OBO id
134             Args - an OBO id (string)
135             Function - the term name associated to the given OBO id
136            
137             =cut
138              
139             sub get_term_by_id {
140 50     50 1 39 my ( $self, $obo_id ) = @_;
141 50         111 return $self->{MAP_BY_ID}->{$obo_id};
142             }
143              
144             =head2 get_id_by_term
145              
146             Usage - $map->get_id_by_term($term_name)
147             Returns - the OBO id associated to the given term name
148             Args - a term name (string)
149             Function - the term associated to the given term
150            
151             =cut
152              
153             sub get_id_by_term {
154 50     50 1 38 my ( $self, $term_name ) = @_;
155 50         132 return $self->{MAP_BY_TERM}->{$term_name};
156             }
157              
158             =head2 keys_set
159              
160             Usage - $map->keys_set()
161             Returns - the keys (or OBO ids)
162             Args - none
163             Function - the keys (or OBO ids)
164            
165             =cut
166              
167             sub keys_set {
168 0     0 1 0 my $self = shift;
169 0         0 return sort keys( %{ $self->{MAP_BY_ID} } );
  0         0  
170             }
171              
172             =head2 values_set
173              
174             Usage - $map->values_set()
175             Returns - the values (or terms names)
176             Args - none
177             Function - the keys (or terms names)
178            
179             =cut
180              
181             sub values_set {
182 0     0 1 0 my $self = shift;
183 0         0 return sort values( %{ $self->{MAP_BY_ID} } );
  0         0  
184             }
185              
186             =head2 contains_key
187              
188             Usage - $map->contains_key($k)
189             Returns - 1 (true) or 0 (false)
190             Args - a key or OBO id
191             Function - 1 (true) or 0 (false)
192            
193             =cut
194              
195             sub contains_key {
196 79     79 1 80 my ( $self, $searched_key ) = @_;
197 79 100       198 return ( defined $self->{MAP_BY_ID}->{$searched_key} ) ? 1 : 0;
198             }
199              
200             =head2 contains_value
201              
202             Usage - $map->contains_value($v)
203             Returns - 1 (true) or 0 (false)
204             Args - a value or term
205             Function - 1 (true) or 0 (false)
206            
207             =cut
208              
209             sub contains_value () {
210 81     81 1 71 my ( $self, $searched_value ) = @_;
211 81 100       216 return ( defined $self->{MAP_BY_TERM}->{$searched_value} ) ? 1 : 0;
212             }
213              
214             =head2 equals
215              
216             Usage - $map->equals($other_map)
217             Returns - 1 (true) or 0 (false)
218             Args - another map
219             Function - compares two maps and tells whether they are identical or not
220            
221             =cut
222              
223             sub equals {
224 8     8 1 12 my $self = shift;
225 8         6 my $result = 0;
226 8         6 my $other_map = shift;
227              
228             #
229             # size
230             #
231 8 100       9 return 0 if ($self->size () != $other_map->size());
232            
233             #
234             # get keys and values
235             #
236 6         6 my @keys_set = sort keys( %{ $self->{MAP_BY_ID} } );
  6         32  
237 6         8 my @values_set = sort values( %{ $self->{MAP_BY_ID} } );
  6         21  
238              
239 6         7 foreach my $id (@keys_set) {
240 52         55 my $tmp_name = $self->{MAP_BY_ID}->{$id};
241 52         83 my $tmp_id = $self->{MAP_BY_TERM}->{$tmp_name};
242            
243 52         123 my $other_map_has_key = $other_map->contains_key($tmp_id);
244 52         53 my $other_map_has_value = $other_map->contains_value($tmp_name);
245            
246 52 100 66     128 if ($other_map_has_key && $other_map_has_value) {
247 50 50 33     50 if ($tmp_id eq $other_map->get_id_by_term($tmp_name) &&
248             $tmp_name eq $other_map->get_term_by_id($tmp_id)) {
249 50         61 $result = 1;
250             } else {
251 0         0 $result = 0;
252 0         0 last;
253             }
254             } else {
255 2         1 $result = 0;
256 2         3 last;
257             }
258             }
259 6         29 return $result;
260             }
261              
262             =head2 size
263              
264             Usage - $map->size()
265             Returns - the size of this map
266             Args - none
267             Function - the size of this map
268            
269             =cut
270              
271             sub size {
272 31     31 1 27 my $self = shift;
273 31         57 my @keys = keys( %{ $self->{MAP_BY_ID} } );
  31         110  
274 31         97 return $#keys + 1;
275             }
276              
277             =head2 file
278              
279             Usage - $map->file()
280             Returns - the file of this map
281             Args - none
282             Function - the file of this map
283            
284             =cut
285              
286             sub file {
287 0     0 1 0 my $self = shift;
288 0 0       0 if (@_) { $self->{FILE} = shift }
  0         0  
289 0         0 return $self->{FILE};
290             }
291              
292             =head2 clear
293              
294             Usage - $map->clear()
295             Returns - clears this map
296             Args - none
297             Function - clears this map
298            
299             =cut
300              
301             sub clear {
302 0     0 1 0 my $self = shift;
303 0         0 %{ $self->{MAP_BY_ID} } = ();
  0         0  
304 0         0 %{ $self->{MAP_BY_TERM} } = ();
  0         0  
305             }
306              
307             =head2 is_empty
308              
309             Usage - $map->is_empty()
310             Returns - 1 (true) or 0 (false)
311             Args - none
312             Function - tells if this map is empty
313            
314             =cut
315              
316             sub is_empty {
317 0     0 1 0 my $self = shift;
318 0         0 return ( $self->size() == 0 );
319             }
320              
321             =head2 write_map
322              
323             Usage - $map->write_map()
324             Returns - none
325             Args - none
326             Function - prints the contents of the map to the file associated to this object
327            
328             =cut
329              
330             sub write_map {
331 0     0 1 0 my $self = shift;
332 0 0       0 open( FH, '>'.$self->{FILE} ) || croak "Cannot write map into the file: '$self->{FILE}', $!";
333 0         0 foreach ( sort keys %{ $self->{MAP_BY_ID} } ) {
  0         0  
334 0 0       0 if ($self->{MAP_BY_ID}->{$_}) {
335 0         0 print FH "$_\t$self->{MAP_BY_ID}->{$_}\n";
336             } else {
337 0         0 warn "There is no value in the IDs map for this key: ", $_;
338             }
339             }
340 0         0 close FH;
341             }
342              
343             =head2 remove_by_key
344              
345             Usage - $map->remove_by_key('OBO:B0000001')
346             Returns - the value corresponding to the given key that will be eventually removed
347             Args - the key (OBO ID as string) of the entry to be removed (string)
348             Function - removes one entry from the map
349            
350             =cut
351              
352             sub remove_by_key {
353 2     2 1 4 my ($self, $key) = @_;
354 2         4 my $value = $self->{MAP_BY_ID}{$key};
355 2         4 delete $self->{MAP_BY_ID}{$key};
356 2         4 delete $self->{MAP_BY_TERM}{$value};
357 2         17 delete $self->{KEYS}{MAP}{$key};
358 2         3 return $value;
359             }
360              
361             1;
362              
363             __END__