File Coverage

blib/lib/Lingua/NegEx.pm
Criterion Covered Total %
statement 60 68 88.2
branch 15 24 62.5
condition 3 3 100.0
subroutine 7 7 100.0
pod 0 3 0.0
total 85 105 80.9


line stmt bran cond sub pod time code
1             package Lingua::NegEx;
2              
3 1     1   30815 use 5.008008;
  1         4  
  1         32  
4 1     1   5 use strict;
  1         1  
  1         27  
5 1     1   4 use warnings;
  1         7  
  1         93  
6              
7             require Exporter;
8              
9             our (@ISA,@EXPORT_OK,$VERSION,$phrase);
10             BEGIN {
11 1     1   13 @ISA = qw(Exporter);
12 1         1 $VERSION = '0.10';
13 1         935 @EXPORT_OK = qw(
14             negation_scope
15             );
16             }
17              
18             ####################################################################################
19              
20             sub negation_scope {
21 1     1 0 8 my $text = lc shift;
22 1         6 $text =~ s/\s+/ /xms;
23 1         2 my @string;
24 1         6 foreach ( split /\s/xms, $text ) {
25 4         5 s/\W//gxms;
26 4         6 push @string, $_;
27             }
28 1         5 return word_iterator( \@string, 0 );
29             }
30              
31             ####################################################################################
32              
33             sub word_iterator {
34 1     1 0 1 my ($string,$index) = @_;
35 1         2 my $word_count = scalar @{$string};
  1         1  
36 1 50       4 if ( $index < $word_count ) {
37 1         1 foreach my $i ( $index .. $#{$string} ) {
  1         3  
38 3         10 my $pseudo_index = contains_at_index( $string, $phrase->{pseudo}, $i );
39 3 50       7 if ( $pseudo_index ) {
40 0         0 return word_iterator( $string, $pseudo_index );
41             } else {
42 3         5 my $negation_index = contains_at_index( $string, $phrase->{negation}, $i );
43 3 100       8 if ( $negation_index ) {
44 1         20 my $conjunction_index = 0;
45 1         3 foreach my $j ( $negation_index .. $#{$string} ) {
  1         4  
46 1         19 $conjunction_index = contains_at_index( $string, $phrase->{conjunctions}, $j );
47 1 50       6 last if $conjunction_index;
48             }
49 1 50       6 if ( $conjunction_index ) {
    50          
50 0         0 return [ $negation_index, $conjunction_index ];
51             } elsif ( $negation_index >= $word_count - 1 ) {
52 1         10 return [ 0, ( $word_count - 1 ) ];
53             } else {
54 0         0 return [ $negation_index, ( $word_count - 1 ) ];
55             }
56             } else {
57 2         5 my $post_index = contains_at_index( $string, $phrase->{post}, $i );
58 2 50       5 if ( $post_index ) {
59 0         0 return [ 0, $post_index ];
60             }
61             }
62             }
63             }
64             }
65 0         0 return 0;
66             }
67              
68             sub contains_at_index {
69 9     9 0 12 my ($string, $phrase_list, $index) = @_;
70 9         9 my $word_count = scalar @{$string};
  9         11  
71 9         9 foreach my $phrase ( @{$phrase_list} ) {
  9         13  
72 443         331 my @words;
73 443         1160 foreach ( split /\s/xms, $phrase ) {
74 1490         1539 s/\W//xms;
75 1490         1823 push @words, $_;
76             }
77 443 100       740 if ( scalar @words == 1 ) {
78 43 100       44 if ( ${$string}[$index] eq $words[0] ) {
  43         117  
79 1         5 return $index + 1;
80             }
81             } else {
82 400 100 100     1002 if ( ($word_count - $index) >= scalar @words
  202         659  
83             and ${$string}[$index] eq $words[0]
84             ) {
85 3         5 my $counts++;
86 3         8 foreach my $i ( 1 .. $#words ) {
87 3 50       4 if ( ${$string}[$index + $i] eq $words[$i] ) {
  3         8  
88 0         0 $counts++;
89             } else {
90 3         5 $counts = 0;
91 3         10 last;
92             }
93 0 0       0 if ( $counts == scalar @words ) {
94 0         0 return $index + $i + 1;
95             }
96             }
97             }
98             }
99             }
100 8         18 return 0;
101             }
102              
103             ####################################################################################
104              
105             $phrase = {
106             pseudo => [
107             'no increase',
108             'no change',
109             'no suspicious change',
110             'no significant change',
111             'no interval change',
112             'no definite change',
113             'not extend',
114             'not cause',
115             'not drain',
116             'not significant interval change',
117             'not certain if',
118             'not certain whether',
119             'gram negative',
120             'without difficulty',
121             'not necessarily',
122             'not only',
123             ],
124             post => [
125             'should be ruled out for',
126             'ought to be ruled out for',
127             'may be ruled out for',
128             'might be ruled out for',
129             'could be ruled out for',
130             'will be ruled out for',
131             'can be ruled out for',
132             'must be ruled out for',
133             'is to be ruled out for',
134             'be ruled out for',
135             'unlikely',
136             'free',
137             'was ruled out',
138             'is ruled out',
139             'are ruled out',
140             'have been ruled out',
141             'has been ruled out',
142             'being ruled out',
143             'should be ruled out',
144             'ought to be ruled out',
145             'may be ruled out',
146             'might be ruled out',
147             'could be ruled out',
148             'will be ruled out',
149             'can be ruled out',
150             'must be ruled out',
151             'is to be ruled out',
152             'be ruled out',
153             ],
154             conjunctions => [
155             'but',
156             'however',
157             'nevertheless',
158             'yet',
159             'though',
160             'although',
161             'still',
162             'aside from',
163             'except',
164             'apart from',
165             'secondary to',
166             'as the cause of',
167             'as the source of',
168             'as the reason of',
169             'as the etiology of',
170             'as the origin of',
171             'as the cause for',
172             'as the source for',
173             'as the reason for',
174             'as the etiology for',
175             'as the origin for',
176             'as the secondary cause of',
177             'as the secondary source of',
178             'as the secondary reason of',
179             'as the secondary etiology of',
180             'as the secondary origin of',
181             'as the secondary cause for',
182             'as the secondary source for',
183             'as the secondary reason for',
184             'as the secondary etiology for',
185             'as the secondary origin for',
186             'as a cause of',
187             'as a source of',
188             'as a reason of',
189             'as a etiology of',
190             'as a cause for',
191             'as a source for',
192             'as a reason for',
193             'as a etiology for',
194             'as a secondary cause of',
195             'as a secondary source of',
196             'as a secondary reason of',
197             'as a secondary etiology of',
198             'as a secondary origin of',
199             'as a secondary cause for',
200             'as a secondary source for',
201             'as a secondary reason for',
202             'as a secondary etiology for',
203             'as a secondary origin for',
204             'cause of',
205             'cause for',
206             'causes of',
207             'causes for',
208             'source of',
209             'source for',
210             'sources of',
211             'sources for',
212             'reason of',
213             'reason for',
214             'reasons of',
215             'reasons for',
216             'etiology of',
217             'etiology for',
218             'trigger event for',
219             'origin of',
220             'origin for',
221             'origins of',
222             'origins for',
223             'other possibilities of',
224             ],
225             negation => [
226             'absence of',
227             'cannot see',
228             'cannot',
229             'checked for',
230             'declined',
231             'declines',
232             'denied',
233             'denies',
234             'denying',
235             'evaluate for',
236             'fails to reveal',
237             'free of',
238             'negative for',
239             'never developed',
240             'never had',
241             'no',
242             'no abnormal',
243             'no cause of',
244             'no complaints of',
245             'no evidence',
246             'no new evidence',
247             'no other evidence',
248             'no evidence to suggest',
249             'no findings of',
250             'no findings to indicate',
251             'no mammographic evidence of',
252             'no new',
253             'no radiographic evidence of',
254             'no sign of',
255             'no significant',
256             'no signs of',
257             'no suggestion of',
258             'no suspicious',
259             'not',
260             'not appear',
261             'not appreciate',
262             'not associated with',
263             'not complain of',
264             'not demonstrate',
265             'not exhibit',
266             'not feel',
267             'not had',
268             'not have',
269             'not know of',
270             'not known to have',
271             'not reveal',
272             'not see',
273             'not to be',
274             'patient was not',
275             'rather than',
276             'resolved',
277             'test for',
278             'to exclude',
279             'unremarkable for',
280             'with no',
281             'without any evidence of',
282             'without evidence',
283             'without indication of',
284             'without sign of',
285             'without',
286             'rule out for',
287             'rule him out for',
288             'rule her out for',
289             'rule the patient out for',
290             'rule him out',
291             'rule her out',
292             'rule out',
293             'r/o',
294             'ro',
295             'rule the patient out',
296             'rules out',
297             'rules him out',
298             'rules her out',
299             'ruled the patient out for',
300             'rules the patient out',
301             'ruled him out against',
302             'ruled her out against',
303             'ruled him out',
304             'ruled her out',
305             'ruled out against',
306             'ruled the patient out against',
307             'did rule out for',
308             'did rule out against',
309             'did rule out',
310             'did rule him out for',
311             'did rule him out against',
312             'did rule him out',
313             'did rule her out for',
314             'did rule her out against',
315             'did rule her out',
316             'did rule the patient out against',
317             'did rule the patient out for',
318             'did rule the patient out',
319             'can rule out for',
320             'can rule out against',
321             'can rule out',
322             'can rule him out for',
323             'can rule him out against',
324             'can rule him out',
325             'can rule her out for',
326             'can rule her out against',
327             'can rule her out',
328             'can rule the patient out for',
329             'can rule the patient out against',
330             'can rule the patient out',
331             'adequate to rule out for',
332             'adequate to rule out',
333             'adequate to rule him out for',
334             'adequate to rule him out',
335             'adequate to rule her out for',
336             'adequate to rule her out',
337             'adequate to rule the patient out for',
338             'adequate to rule the patient out against',
339             'adequate to rule the patient out',
340             'sufficient to rule out for',
341             'sufficient to rule out against',
342             'sufficient to rule out',
343             'sufficient to rule him out for',
344             'sufficient to rule him out against',
345             'sufficient to rule him out',
346             'sufficient to rule her out for',
347             'sufficient to rule her out against',
348             'sufficient to rule her out',
349             'sufficient to rule the patient out for',
350             'sufficient to rule the patient out against',
351             'sufficient to rule the patient out',
352             'what must be ruled out is',
353             ],
354             };
355              
356              
357             1;
358             __END__