File Coverage

blib/lib/MetaMap/DataStructures/Mapping.pm
Criterion Covered Total %
statement 28 31 90.3
branch 5 8 62.5
condition n/a
subroutine 3 3 100.0
pod 0 3 0.0
total 36 45 80.0


line stmt bran cond sub pod time code
1             # MetaMap::DataStructures::Mapping
2             # (Last Updated $Id: Mapping.pm,v 1.80 2016/01/07 22:49:33 btmcinnes Exp $)
3             #
4             # Perl module that provides a perl interface to the
5             # Unified Medical Language System (UMLS)
6             #
7             # Copyright (c) 2016
8             #
9             # Sam Henry, Virginia Commonwealth University
10             # henryst at vcu.edu
11             #
12             # Bridget T. McInnes, Virginia Commonwealth University
13             # btmcinnes at vcu.edu
14             #
15             # This program is free software; you can redistribute it and/or
16             # modify it under the terms of the GNU General Public License
17             # as published by the Free Software Foundation; either version 2
18             # of the License, or (at your option) any later version.
19             #
20             # This program is distributed in the hope that it will be useful,
21             # but WITHOUT ANY WARRANTY; without even the implied warranty of
22             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23             # GNU General Public License for more details.
24             #
25             # You should have received a copy of the GNU General Public License
26             # along with this program; if not, write to
27             #
28             # The Free Software Foundation, Inc.,
29             # 59 Temple Place - Suite 330,
30             # Boston, MA 02111-1307, USA.
31              
32             package MetaMap::DataStructures::Mapping;
33              
34             #----------------------------------------
35             # constructor
36             #----------------------------------------
37              
38             # constructor method to create a new Mapping object
39             # input : $score <- the MMI of this Mapping
40             # \@concepts <- an ordered list of concept objects of this mapping
41             # output: $self <- a new Mapping object
42             sub new {
43             #create self
44 488     488 0 385 my $class = shift;
45 488         412 my $self = {};
46 488         453 bless $self, $class;
47              
48             #grab the score and associated concepts
49 488         604 $self->{score} = shift;
50 488         375 $self->{concepts} = shift;
51              
52 488         1136 return $self;
53             }
54              
55             #----------------------------------------
56             # methods
57             #----------------------------------------
58              
59             # method compares this mapping to another and returns 1 if the two
60             # contain identical information
61             # input : $other <- the Mapping object to compare against
62             # output: boolean <- 1 if $self and $other are equivalent (have the same score,
63             # and have equivalent concepts)
64             sub equals {
65             #grab input
66 2078     2078 0 1365 my $self = shift;
67 2078         1213 my $other = shift;
68              
69             #compare scores
70 2078 50       2648 if ($self->{score} ne $other->{score}) {
71 0         0 return 0;
72             }
73              
74             #check that the mappings are the same
75             # since mappings are an ordered list
76             # a one-to-one comparison can be made
77 2078 50       1206 if (scalar @{$self->{concepts}} != scalar @{$other->{concepts}}) {
  2078         1590  
  2078         2473  
78 0         0 return 0;
79             }
80              
81             #compare each concept
82 2078         1530 for(my $i = 0; $i < scalar @{$self->{concepts}}; $i++) {
  4776         5952  
83 4594 100       2641 if (!@{$self->{concepts}}[$i]->equals(@{$other->{concepts}}[$i])) {
  4594         3580  
  4594         6482  
84 1896         3607 return 0;
85             }
86             }
87              
88             #all tests passed, mappings are equivalent.
89 182         325 return 1;
90             }
91              
92             # method summarizes this phrase as a string
93             # input : -
94             # output: $string <- a string describing $self
95             sub toString {
96 91     91 0 56 my $self = shift;
97 91         60 my $string = "mapping:\n";
98 91         97 $string .= " $self->{score}\n";
99              
100             #make sure concepts exist([cornea]),inputmatch(['Cornea']),tag(
101 91 50       51 if (scalar @{$self->{concepts}} < 1) {
  91         137  
102 0         0 $string .= "ERROR NO CONCEPTS\n";
103             }
104              
105             #print each concept
106 91         51 foreach $concept(@{$self->{concepts}}) {
  91         107  
107 284         368 $string .= " ".$concept->toString();
108             }
109              
110 91         216 return $string;
111             }
112              
113             1;
114              
115             __END__