source: lib/ProccesAllicVariants.pm @ 8

Last change on this file since 8 was 8, checked in by maarten, 9 years ago

removed some output bugs

File size: 8.4 KB
Line 
1package ProccesAllicVariants;
2use strict;
3use warnings;
4use Carp;
5use Data::Dumper;
6
7sub new {
8        my $pubmedlocation = $_;
9        my $self           = {};
10        $self->{Omim2Pubmed} = "";
11        $self->{Omim2DBsnp}  = "";
12
13        bless($self);    # but see below
14        return $self;
15}
16
17sub trim($) {
18        my $string = shift;
19        $string =~ s/^\s+//;
20        $string =~ s/\s+$//;
21        return $string;
22}
23
24sub getMutation {
25        my $av = shift;
26
27        my $mutation = $av->aa_ori() . $av->position() . $av->aa_mut();
28        if ( length($mutation) == 0 ) {
29                $mutation = formatInDelMutation($av->additional_mutations());
30               
31        }
32        return ($mutation);
33
34}
35
36sub addOmim2pubmed {
37        my ( $self, $o2p ) = @_;
38        $self->{Omim2Pubmed} = $o2p;
39
40}
41
42sub addOmim2dbsnp {
43        my ( $self, $o2dbsnp ) = @_;
44        $self->{Omim2DBsnp} = $o2dbsnp;
45
46}
47
48sub extractwithposition {
49        my ( $desc, $aapos ) = @_;
50        my $result = "";
51
52        #110G-T transversion
53        #110G-A transition
54
55        if ( $desc =~ /(($aapos)[ACTG]-[ACTG] trans[a-z]{4,9})/i ) {
56
57                $result = $1;
58
59                #print($result);
60        }
61
62        return ($result);
63}
64
65sub extractnuclitdemutation {
66        my ( $desc, $aapos ) = @_;
67        my $result = "";
68
69        #check corresponding nucl position from aa pos
70        if ( $aapos =~ /[0-9]{1,6}/i ) {
71
72                my $nuclposition = "";
73                $nuclposition = ( $aapos * 3 ) . "|";
74                $nuclposition .= ( ( $aapos * 3 ) - 1 ) . "|" . ( ( $aapos * 3 ) - 2 );
75                if ( $desc =~ /($nuclposition)/ ) {
76
77                        $result = extractwithposition( $desc, $nuclposition );
78                }
79        }
80        if ( length($result) == 0 ) {
81
82                #heterozygous A-to-G transition in exon 3
83                #heterozygous G-to-C transversion in exon 2
84                # T-to-C transition in exon 3
85                if ( $desc =~
86/(([a-z]{3,9}gous)? [ATCG]-to-[ATCG] trans[a-z]{5,8} in exon [0-9]{1,2})/i
87                  )
88                {
89                        $result = $1;
90                }
91                #n A-to-G transition at nucleotide 1730 in exon 13, resulting in
92                elsif ( $desc =~ /([ACTG]-to-[ACTG] trans[a-z]{4,9})[\w\s\-\.]{0,10}(nucleotide \d{1,5})[\w\s\-\.]{0,90}((exon|intron)\s\d{1,3})/i ) {
93                        $result = $1." at ".$2." in ".$3;
94                       
95
96                        #print($result);
97                       
98                        #T-to-C transition BLABLA in exon 30
99                }
100                elsif ( $desc =~ /(codon [a-z])/i ) {
101
102                        #codon 163 was changed from GTG (val) to CTG (leu)
103                        #find 1110A-C transversion with wrong number (!= AA*3)
104                        #ACTA1 .0009
105                }
106                elsif ( $desc =~ /([0-9]{1,5}[ACTG]-[ACTG] trans[a-z]{4,9})/i ) {
107                        $result = $1;
108                        $result = $1;
109
110                        #print($result);
111                       
112                        #T-to-C transition BLABLA in exon 30
113                }elsif($desc =~ /([ACTG]-to-[ACTG] trans[a-z]{4,9})[\w\s\-\.]{0,90}((exon|intron)\s\d{1,3})/i){
114                        $result=$1." in ".$2;
115                }
116                elsif ( $desc =~ /([ACTG]{3} to [ACTG]{3})/ ) {
117                        $result = $1;
118                }
119
120        }
121        return ($result);
122}
123
124sub getAuthor {
125
126        my $desc   = shift;
127        my $authAV = "";
128        my $yearAV = "";
129        $desc =~ tr/\n/ /;
130        $desc = trim($desc);
131
132        my @regexp = ();
133
134        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?\\(([\\d\\s,]{4,17})\\)" );
135
136        # add regexp for authors with  And between names
137
138        push( @regexp, "\\b([A-Za-z\\-]*.[^\\)\\,]\\sand\\s[\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
139
140        #TODO: add solution for mulitple authors (author 2009; auth3 2002 ,etc )
141
142        #Bradley et al., 1975;
143        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?([\\d]{4})" );
144
145        #See Brennan (1985)
146
147        push( @regexp, "([\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
148
149        #Tiller et al. (1993, 1995)
150        push( @regexp, "([\\w-]*.)\\set al.\\s*?([\\d\\s,]{4,17})\\)" );
151
152        #de Vries and de Wet (1986, 1987)
153        push( @regexp,
154                "\\b([A-Za-z\\-]{3,11}\\sand\\s[\\w\\s-]{3,11})\\s*.\\(([\\d\\s,]{4,17})\\)" );
155
156        #See 123456.1234
157        push( @regexp, "See\\s(\\d{6}).(\\d{4})" );
158
159        my $reg         = "";
160        my @returnarray = ();
161        my @srcs        = ();
162        foreach $reg (@regexp) {
163
164                if ( @srcs = ( $desc =~ /$reg/g ) ) {
165                        #print($reg);
166                        push( @returnarray, @srcs );
167                        $desc =~ s/$reg//g;
168                }
169        }
170
171        #check if return has a author and year
172        if ( scalar(@returnarray) % 2 ) {
173                carp( " length of authors is not a multiple from 2 possible error\n"
174                          . Dumper(@returnarray) );
175        }
176        if ( scalar(@returnarray) == 0 ) {
177                carp( "No authors found in:\n\n" . $desc . "\n" );
178        }
179
180        return ( \@returnarray );
181}
182
183sub getPubmedID {
184
185        my ( $self, $refsref, $authAV, $yearAV, $numb ) = @_;
186        my $result = "";
187        if ( length($authAV) != 0 ) {
188
189                my @refs    = @$refsref;
190                my $counter = 1;
191                foreach my $ref (@refs) {
192                        my $auth = $ref->authors();
193                        if ( $auth =~ m/^$authAV/ ) {
194                                my $authY = $ref->location();
195                                my $tempresult="";
196                                if ( $authY =~ m/$yearAV/ ) {
197                                       
198                                        $tempresult =
199                                          $self->{Omim2Pubmed}->getpubmed( $numb, $counter );
200                                          if ($tempresult ne ""){
201                                                print($counter." ".$numb."\n");
202                                                $result.=$tempresult;
203                                          }else{
204                                                $result.=$authAV."(".$yearAV.") ".$ref->location();
205                                               
206                                          }
207                                }
208                        }
209                        $counter = $counter + 1;
210                }
211        }
212
213        return ($result);
214}
215
216sub fomatYears {
217        my ($yearsUnformated) = shift;
218        my @years = ();
219        if ( $yearsUnformated =~ /^(\d{4})$/ ) {
220                push( @years, $1 );
221        }
222        else {
223                my @catch = ();
224                if ( @catch = ( $yearsUnformated =~ /\d{4}/g ) ) {
225                        push( @years, @catch );
226
227                        #$yearsUnformated =~ s/\d{4}//g;
228                }
229        }
230        if ( scalar(@years) == 0 ) {
231                carp( " No years found in formatYears in string: \n"
232                          . Dumper($yearsUnformated) );
233        }
234
235        return ( \@years );
236
237}
238
239sub formatAuthors {
240        my ($authref) = shift;
241        my @authorsAndYears = @$authref;
242        my @formatedAuth = ();
243
244        for ( my $i = 0 ; $i < scalar(@authorsAndYears) ; $i = $i + 2 ) {
245                my $years = fomatYears( $authorsAndYears[ $i + 1 ] );
246                foreach my $year (@$years) {
247                        push( @formatedAuth, $authorsAndYears[$i], $year );
248                }
249        }
250        return ( \@formatedAuth );
251}
252
253sub getDeceaseID {
254        my ($text) = shift;
255        my $deceaseID = "";
256
257        if ( $text =~ /\(([\W\;\S]{0,15}\d{6})\)/g ) {
258                $deceaseID = $1;
259                $deceaseID =~ s/^see //i;
260        }
261        else {
262                $deceaseID = "decease ID not found";
263        }
264        return ($deceaseID);
265}
266
267#sub formatAAMutation {
268#       my $mutation = @_;
269#       #additional_mutations
270#       ##TODO determ mutation is deletion, substitution of insertion.
271#       if  (! $mutation =~ /\w{3}\d{1,4}\w{w}/ ) {
272#               carp("non mutation\t".$mutation);
273#       }
274#       return ($mutation);
275#}
276
277sub formatInDelMutation{
278                my $mutation = shift;
279#               print("'".$mutation."'");
280                my $formatMutation="";
281                if  ( $mutation =~ /^1-BP\s*?(DEL)\,\s*?(\d{1,5})([A-Z])/i ) {
282                       
283                        $formatMutation=$2.lc($1).$3;
284                }elsif($mutation =~ /^(\d{1,5})-BP\s*?(DEL|INS)\,[\sNT]*?(\d{1,5})([A-Z]*.?)/i){
285                        #correction for calculating deletions
286                        my $cor_del=1;
287                        if(lc($2)eq"ins"){
288                                $cor_del=0;
289                        }
290                        $formatMutation=$3."_".($3+$1-$cor_del).lc($2).$4;
291                }elsif($mutation =~ /^(\d{1,5})([A-Z]*?)\s*?(DEL)/i){
292                        $formatMutation=$1.lc($3).$2;
293                }elsif($mutation =~/(INT(\d{0,3})-(\d{0,3}) (DEL))/i){
294               
295                        $formatMutation="IVS".$2."+?_IVS".$3."+?".lc($4);
296                        $mutation =~ s/INT\d{0,3}-\d{0,3} DEL//;
297                        if(length($mutation)>5){
298                                $formatMutation.=",".formatInDelMutation($mutation);
299                        }
300                }
301                else{
302                        $formatMutation=$mutation;
303                }
304               
305               
306                return ($formatMutation);
307}
308
309sub createAuthorsOutput {
310        my ( $self, $refsref, $authref, $numb ) = @_;
311        my $result      = "";
312        my @authAndYear = @$authref;
313        my ( $author, $year, $pubmedid ) = "";
314        for ( my $i = 0 ; $i < scalar(@authAndYear) ; $i = $i + 2 ) {
315                $author   = $authAndYear[$i];
316                $year     = $authAndYear[ $i + 1 ];
317                $pubmedid = $self->getPubmedID( $refsref, $author, $year, $numb );
318                $result .= "{PMID" . $pubmedid . ":" . $author . " (" . $year . ")}";
319        }
320
321        return ($result);
322}
323
324sub proccesAllicVariants {
325        my ( $self, $avsref, $refsref, $numb ) = @_;
326        my @avs    = @$avsref;
327        my $result = "";
328        foreach my $av (@avs) {
329#print($av->number() . "\t");
330if ($av->title() ne "REMOVED FROM DATABASE"){
331                my $mutation        = getMutation( $av );
332               
333                my $authorsAndYears = getAuthor( $av->description() );
334                $authorsAndYears = formatAuthors($authorsAndYears);
335                my $articles =
336                  $self->createAuthorsOutput( $refsref, $authorsAndYears, $numb );
337       
338                #lool up allelic variant in dbsnp and return accesionnumber 
339                my $dbsnp = $self->{Omim2DBsnp}->getdbsnp( $numb, $av->number() );
340                               
341                #print(Dumper($authorsAndYears));
342               
343                my $desc = $av->description();
344               
345                $desc =~ tr/\n/ /;
346                if ( length($desc) < 60 ) {
347
348                        my $pubmedid = "test";
349
350                        # $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
351                        $result .=
352                            $numb . "\t"
353                          . $av->number() . "\t"
354                          . $av->title() . "\t"
355                          . $mutation . "\t"
356                          . $desc
357                          . $articles . "\n";
358                }
359                else {
360
361                        my $deceaseID = getDeceaseID($desc);
362
363                        my $nucleotidemutation =
364                          extractnuclitdemutation( $desc, $av->position() );
365
366                        $result .=
367                            $numb . "\t"
368                          . $av->number() . "\t"
369                          . $av->title() . "\t"
370                          . $deceaseID . "\t"
371                          . $mutation . "\t"
372                          . $dbsnp. "\t"
373                          . $articles . "\t"
374
375
376                          . $nucleotidemutation . "\n";
377                }
378}
379        }
380
381        return ($result);
382}
3831;
Note: See TracBrowser for help on using the repository browser.