line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# @File DataAccess.pm |
4
|
|
|
|
|
|
|
# @Author andriy |
5
|
|
|
|
|
|
|
# @Created Jun 27, 2016 3:27:32 PM |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package DataAccess; |
9
|
1
|
|
|
1
|
|
301
|
use DBI; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use UMLS::Association; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $errorhandling = ""; |
16
|
|
|
|
|
|
|
my $association = ""; |
17
|
|
|
|
|
|
|
my $dbh = ""; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# method to create a new SemRep::Interface object |
20
|
|
|
|
|
|
|
# input : $SemMedLoginParams <- reference to hash containing SemMed login parameter |
21
|
|
|
|
|
|
|
# $AssociationLoginParams <- reference to hash containing the UMLS::Association login parameters |
22
|
|
|
|
|
|
|
# output: |
23
|
|
|
|
|
|
|
sub new { |
24
|
|
|
|
|
|
|
$class = shift; |
25
|
|
|
|
|
|
|
my $self = {}; |
26
|
|
|
|
|
|
|
my $SemMedLoginParams = shift; #hash containing the SemMed login parameters |
27
|
|
|
|
|
|
|
my $AssociationLoginParams = shift; #hash containing the UMLS::Association login parameters |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $database = $SemMedLoginParams->{'database'}; |
30
|
|
|
|
|
|
|
my $hostname = $SemMedLoginParams->{'hostname'}; |
31
|
|
|
|
|
|
|
my $port = $SemMedLoginParams->{'port'}; |
32
|
|
|
|
|
|
|
my $userid = $SemMedLoginParams->{'username'}; |
33
|
|
|
|
|
|
|
my $password = $SemMedLoginParams->{'password'}; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port"; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
if($association){ |
38
|
|
|
|
|
|
|
$association = new UMLS::Association($AssociationLoginParams); |
39
|
|
|
|
|
|
|
$errorhandling = UMLS::Association::ErrorHandler->new(); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
$dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr; |
45
|
|
|
|
|
|
|
$dbh->{InactiveDestroy} = 1; #allows forking of threads containing this DB connect |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
bless $self, $class; |
48
|
|
|
|
|
|
|
return $self; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#given a CUI, this method will return all Predicate-CUI connections leading from the given CUI |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
#INPUT: SOURCE_CUI_OBJECT, WEIGHT_STATISTICAL_MEASURE(string) or 1 |
55
|
|
|
|
|
|
|
#OPTIONAL INPUT: , List of predicates to only include, List of Predicates to Ignore |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
#OUTPUT: ARRAY OF PREDICATE objects whos source is SOURCE_CUI_OBJECT and destination is what was matched in DB. |
58
|
|
|
|
|
|
|
sub getPredicateConnections { |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
if(not $association){ |
61
|
|
|
|
|
|
|
print "Error: UMLS::Association not loaded"; |
62
|
|
|
|
|
|
|
exit; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $self = shift; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $cui = shift; |
68
|
|
|
|
|
|
|
my $measure = shift; |
69
|
|
|
|
|
|
|
my $includedPredicates = shift; |
70
|
|
|
|
|
|
|
my $excludedPredicates = shift; |
71
|
|
|
|
|
|
|
unless($measure){ #default to tscore |
72
|
|
|
|
|
|
|
$measure = "tscore"; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $cuiid = $cui->getId(); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
my $queryString = |
78
|
|
|
|
|
|
|
"SELECT s_cui, s_name, o_cui, o_name, predicate, $measure FROM SemMedDB.DISTINCT_PREDICATION_AGGREGATE |
79
|
|
|
|
|
|
|
WHERE s_cui = '$cuiid'"; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
### Will add in query parameters for removing certain predicate types |
83
|
|
|
|
|
|
|
if($includedPredicates){ |
84
|
|
|
|
|
|
|
my $perm = " AND ("; |
85
|
|
|
|
|
|
|
foreach $pred ( @$includedPredicates){ |
86
|
|
|
|
|
|
|
$perm .= "predicate = '$pred' OR "; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
substr($perm, -4) = ""; #remove extra OR |
89
|
|
|
|
|
|
|
$perm .= ")"; |
90
|
|
|
|
|
|
|
$queryString .= $perm; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
if($excludedPredicates){ |
94
|
|
|
|
|
|
|
my $perm = " AND NOT ("; |
95
|
|
|
|
|
|
|
foreach $pred ( @$excludedPredicates){ |
96
|
|
|
|
|
|
|
$perm .= "predicate = '$pred' OR "; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
substr($perm, -4) = ""; |
99
|
|
|
|
|
|
|
$perm .= ")"; |
100
|
|
|
|
|
|
|
$queryString .= $perm; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
#print $queryString."\n"; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
my $sth = $dbh->prepare($queryString); |
108
|
|
|
|
|
|
|
$sth->execute() or die $DBI::errstr; |
109
|
|
|
|
|
|
|
my @edges = (); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
while (my @row = $sth->fetchrow_array()) { |
113
|
|
|
|
|
|
|
my $source = new CUI($row[0], $row[1]); #create source vertex |
114
|
|
|
|
|
|
|
my $destination = new CUI($row[2], $row[3]); #create dest vertext |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $weight; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $validConcepts = $errorhandling->_validCui($row[0]) && $errorhandling->_validCui($row[2]); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
if($measure == 1){ #no stats needed, we are just running a BFS |
121
|
|
|
|
|
|
|
$weight = 1; |
122
|
|
|
|
|
|
|
}else{ |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#if value is cached in db, use it |
125
|
|
|
|
|
|
|
if($row[5]){ |
126
|
|
|
|
|
|
|
$weight = $row[5]; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
}else{ |
129
|
|
|
|
|
|
|
#obtain value from UMLS, then cache it |
130
|
|
|
|
|
|
|
if($validConcepts){ |
131
|
|
|
|
|
|
|
# print "calculating stats $row[1] $row[3] \n"; |
132
|
|
|
|
|
|
|
$weight = $association->calculateStatistic($source->getId(), $destination->getId(), $measure); |
133
|
|
|
|
|
|
|
}else{ |
134
|
|
|
|
|
|
|
$weight = -1; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $updateString = "UPDATE SemMedDB.DISTINCT_PREDICATION_AGGREGATE SET $measure = $weight WHERE s_cui = '$row[0]' AND predicate = '$row[4]' AND o_cui = '$row[2]' LIMIT 1;"; |
139
|
|
|
|
|
|
|
my $update = $dbh->prepare($updateString); |
140
|
|
|
|
|
|
|
$update->execute() or die $DBI::errstr; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
#we need to calculate an edge weight, use the measure given to do so from UMLS::Association package |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
if($weight == -1){next;}#if no information was found, ignore this edge |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
#The weight is now a statistic, a value further from 0 will indicate that the two words are highly associated |
151
|
|
|
|
|
|
|
#Take the multiplicative reciprical of this so that highly associated words will correspond to lower edge weights |
152
|
|
|
|
|
|
|
if($weight){ #make sure its not zero |
153
|
|
|
|
|
|
|
$weight = abs(1/$weight); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my $predicate = new Predicate($source, $row[4], $destination, $weight); #create edge |
158
|
|
|
|
|
|
|
push @edges, $predicate; #push to main array holding all edges |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
$sth->finish(); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
return @edges; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# |
166
|
|
|
|
|
|
|
#OBTAIN CUI FROM CUI ID |
167
|
|
|
|
|
|
|
#INPUT: CUI | PREFERRED NAME |
168
|
|
|
|
|
|
|
#OUTPUT: CUI_OBJECT with fields complete. |
169
|
|
|
|
|
|
|
sub getCUI{ |
170
|
|
|
|
|
|
|
my($self, $cui) = @_; |
171
|
|
|
|
|
|
|
my $sth = $dbh->prepare("SELECT CUI, PREFERRED_NAME FROM CONCEPT |
172
|
|
|
|
|
|
|
WHERE CUI = '$cui' OR PREFERRED_NAME = '$cui' |
173
|
|
|
|
|
|
|
LIMIT 1"); |
174
|
|
|
|
|
|
|
$sth->execute() or die $DBI::errstr; |
175
|
|
|
|
|
|
|
my @row = $sth->fetchrow_array(); |
176
|
|
|
|
|
|
|
return new CUI($row[0], $row[1]); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#Gets outgoing predicates from inputed concept |
182
|
|
|
|
|
|
|
#INPUT: CUI |
183
|
|
|
|
|
|
|
#OUTPUT: Array holding predicate's and destination_cui's (predicate, destination_cui) |
184
|
|
|
|
|
|
|
sub getConnections { |
185
|
|
|
|
|
|
|
my $self = shift; |
186
|
|
|
|
|
|
|
my $concept = shift; |
187
|
|
|
|
|
|
|
my $includedPredicates = shift; |
188
|
|
|
|
|
|
|
my $query = "SELECT predicate, o_cui FROM DISTINCT_PREDICATION_AGGREGATE WHERE s_cui = '$concept'"; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
if($includedPredicates){ |
191
|
|
|
|
|
|
|
my $perm = " AND ("; |
192
|
|
|
|
|
|
|
foreach $pred ( @$includedPredicates){ |
193
|
|
|
|
|
|
|
$perm .= "predicate = '$pred' OR "; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
substr($perm, -4) = ""; #remove extra OR |
196
|
|
|
|
|
|
|
$perm .= ")"; |
197
|
|
|
|
|
|
|
$query .= $perm; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $sth = $dbh->prepare($query); |
201
|
|
|
|
|
|
|
$sth->execute() or die $DBI::errstr; |
202
|
|
|
|
|
|
|
$rows = $sth->fetchall_arrayref(); |
203
|
|
|
|
|
|
|
return $rows; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub getBidirectionalConnections{ |
207
|
|
|
|
|
|
|
my $self = shift; |
208
|
|
|
|
|
|
|
my $concept = shift; |
209
|
|
|
|
|
|
|
my $includedPredicates = shift; |
210
|
|
|
|
|
|
|
my $query = "SELECT s_cui, o_cui FROM DISTINCT_PREDICATION_AGGREGATE WHERE s_cui = '$concept' OR o_cui = '$concept'"; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
if($includedPredicates){ |
213
|
|
|
|
|
|
|
my $perm = " AND ("; |
214
|
|
|
|
|
|
|
foreach $pred ( @$includedPredicates){ |
215
|
|
|
|
|
|
|
$perm .= "predicate = '$pred' OR "; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
substr($perm, -4) = ""; #remove extra OR |
218
|
|
|
|
|
|
|
$perm .= ")"; |
219
|
|
|
|
|
|
|
$query .= $perm; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
my $sth = $dbh->prepare($query); |
223
|
|
|
|
|
|
|
$sth->execute() or die $DBI::errstr; |
224
|
|
|
|
|
|
|
$rows = $sth->fetchall_arrayref(); |
225
|
|
|
|
|
|
|
return $rows; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# |
232
|
|
|
|
|
|
|
# OBTAIN SEMTYPE FROM CUI ID |
233
|
|
|
|
|
|
|
#INPUT: CUI | PREFERRED NAME |
234
|
|
|
|
|
|
|
#OUTPUT: Semantic Type Associated with that CUI or Term. |
235
|
|
|
|
|
|
|
sub getSemtype { |
236
|
|
|
|
|
|
|
my($self, $cui) = @_; |
237
|
|
|
|
|
|
|
my $sth = $dbh->prepare( |
238
|
|
|
|
|
|
|
"SELECT CS.SEMTYPE FROM CONCEPT C |
239
|
|
|
|
|
|
|
JOIN CONCEPT_SEMTYPE CS ON (C.CONCEPT_ID = CS.CONCEPT_ID) |
240
|
|
|
|
|
|
|
WHERE C.CUI = '$cui' OR C.PREFERRED_NAME LIKE '$cui' |
241
|
|
|
|
|
|
|
LIMIT 1" |
242
|
|
|
|
|
|
|
); |
243
|
|
|
|
|
|
|
$sth->execute() or die $DBI::errstr; |
244
|
|
|
|
|
|
|
return ($sth->fetchrow_array())[0]; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
1; |