source: lib/ProccesAllicVariants.pm @ 9

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

Fixed file names and parsing indels

File size: 10.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        if ( length($string) > 0 ) {
20                $string =~ s/^\s+//;
21                $string =~ s/\s+$//;
22        }
23        return $string;
24}
25
26sub getfilename {
27        my ( $title, $alt ) = @_;
28        my $protein = "";
29
30        if ( $title =~ m/\;/ ) {
31                if ( $title =~ /([\w\-]{2,10})\s{0,1}$/ ) {
32                        $protein = $1;
33
34                }
35        }
36
37        if ( $protein eq "" ) {
38
39                my $titlelong = $title . ";" . $alt . ";";
40
41                #remove breaks
42                $titlelong =~ s/\r\n|\n|\r/;/g;
43
44                if ( $protein eq "") {
45
46                        if ( $alt =~ /^(\w{2,10})$/ ) {
47                                $protein = $alt;
48
49                        }
50
51                        else {
52                                if ( $titlelong =~ /[\;\:][ ]*?([\w\-]{3,10})[ ]*?\;/ ) {
53                                        $protein = $1;
54                                }
55                        }
56                }
57        }
58        return ( trim $protein);
59}
60
61sub getMutation {
62        my $av = shift;
63
64        my $mutation = $av->aa_ori() . $av->position() . $av->aa_mut();
65        if ( length($mutation) == 0 ) {
66                $mutation = formatInDelMutation( $av->additional_mutations() );
67
68        }
69        return ($mutation);
70
71}
72
73sub addOmim2pubmed {
74        my ( $self, $o2p ) = @_;
75        $self->{Omim2Pubmed} = $o2p;
76
77}
78
79sub addOmim2dbsnp {
80        my ( $self, $o2dbsnp ) = @_;
81        $self->{Omim2DBsnp} = $o2dbsnp;
82
83}
84
85sub extractwithposition {
86        my ( $desc, $aapos ) = @_;
87        my $result = "";
88
89        #110G-T transversion
90        #110G-A transition
91
92        if ( $desc =~ /(($aapos)[ACTG]-[ACTG] trans[a-z]{4,9})/i ) {
93
94                $result = $1;
95
96                #print($result);
97        }
98
99        return ($result);
100}
101
102sub extractnuclitdemutation {
103        my ( $desc, $aapos ) = @_;
104        my $result = "";
105
106        #check corresponding nucl position from aa pos
107        if ( $aapos =~ /[0-9]{1,6}/i ) {
108
109                my $nuclposition = "";
110                $nuclposition = ( $aapos * 3 ) . "|";
111                $nuclposition .= ( ( $aapos * 3 ) - 1 ) . "|" . ( ( $aapos * 3 ) - 2 );
112                if ( $desc =~ /($nuclposition)/ ) {
113
114                        $result = extractwithposition( $desc, $nuclposition );
115                }
116        }
117        if ( length($result) == 0 ) {
118
119                #heterozygous A-to-G transition in exon 3
120                #heterozygous G-to-C transversion in exon 2
121                # T-to-C transition in exon 3
122                if ( $desc =~
123/(([a-z]{3,9}gous)? [ATCG]-to-[ATCG] trans[a-z]{5,8} in exon [0-9]{1,2})/i
124                  )
125                {
126                        $result = $1;
127                }
128
129                #n A-to-G transition at nucleotide 1730 in exon 13, resulting in
130                elsif ( $desc =~
131/([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
132                  )
133                {
134                        $result = $1 . " at " . $2 . " in " . $3;
135
136                        #print($result);
137
138                        #T-to-C transition BLABLA in exon 30
139                }
140                elsif ( $desc =~ /(codon [a-z])/i ) {
141
142                        #codon 163 was changed from GTG (val) to CTG (leu)
143                        #find 1110A-C transversion with wrong number (!= AA*3)
144                        #ACTA1 .0009
145                }
146                elsif ( $desc =~ /([0-9]{1,5}[ACTG]-[ACTG] trans[a-z]{4,9})/i ) {
147                        $result = $1;
148
149                        #print($result);
150
151                        #T-to-C transition BLABLA in exon 30
152                }
153                elsif ( $desc =~ /([ACTG]{3}-to-[ACTG]{3})/i ) {
154                        $result = $1;
155
156                        #print($result);
157
158                        #T-to-C transition BLABLA in exon 30
159                }
160
161                elsif ( $desc =~
162/([ACTG]-to-[ACTG] trans[a-z]{4,9})[\w\s\-\.]{0,90}((exon|intron)\s\d{1,3})/i
163                  )
164                {
165                        $result = $1 . " in " . $2;
166                }
167                elsif ( $desc =~ /([ACTG]{3} to [ACTG]{3})/ ) {
168                        $result = $1;
169                }
170                else {
171
172                        $result = "\t";
173                }
174
175        }
176        return ($result);
177}
178
179sub getAuthor {
180
181        my $desc   = shift;
182        my $authAV = "";
183        my $yearAV = "";
184        $desc =~ tr/\n/ /;
185        $desc = trim($desc);
186
187        my @regexp = ();
188
189        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?\\(([\\d\\s,]{4,17})\\)" );
190
191        # add regexp for authors with  And between names
192
193        push( @regexp,
194                "\\b([A-Za-z\\-]*.[^\\)\\,]\\sand\\s[\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
195
196        #TODO: add solution for mulitple authors (author 2009; auth3 2002 ,etc )
197
198        #Bradley et al., 1975;
199        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?([\\d]{4})" );
200
201        #See Brennan (1985)
202
203        push( @regexp, "([\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
204
205        #Tiller et al. (1993, 1995)
206        push( @regexp, "([\\w-]*.)\\set al.\\s*?([\\d\\s,]{4,17})\\)" );
207
208        #de Vries and de Wet (1986, 1987)
209        push( @regexp,
210"\\b([A-Za-z\\-]{3,11}\\sand\\s[\\w\\s-]{3,11})\\s*.\\(([\\d\\s,]{4,17})\\)"
211        );
212
213        #See 123456.1234
214        push( @regexp, "See\\s(\\d{6}).(\\d{4})" );
215
216        my $reg         = "";
217        my @returnarray = ();
218        my @srcs        = ();
219        foreach $reg (@regexp) {
220
221                if ( @srcs = ( $desc =~ /$reg/g ) ) {
222
223                        #print($reg);
224                        push( @returnarray, @srcs );
225                        $desc =~ s/$reg//g;
226                }
227        }
228
229        #check if return has a author and year
230        if ( scalar(@returnarray) % 2 ) {
231                carp( " length of authors is not a multiple from 2 possible error\n"
232                          . Dumper(@returnarray) );
233        }
234        if ( scalar(@returnarray) == 0 ) {
235                carp( "No authors found in:\n\n" . $desc . "\n" );
236        }
237
238        return ( \@returnarray );
239}
240
241sub getPubmedID {
242
243        my ( $self, $refsref, $authAV, $yearAV, $numb ) = @_;
244        my $result = "";
245        if ( length($authAV) != 0 ) {
246
247                my @refs    = @$refsref;
248                my $counter = 1;
249                foreach my $ref (@refs) {
250                        my $auth = $ref->authors();
251                        if ( $auth =~ m/^$authAV/ ) {
252                                my $authY      = $ref->location();
253                                my $tempresult = "";
254                                if ( $authY =~ m/$yearAV/ ) {
255
256                                        $tempresult =
257                                          $self->{Omim2Pubmed}->getpubmed( $numb, $counter );
258                                        if ( $tempresult ne "" ) {
259                                                $result .= "{PMID"
260                                                  . $tempresult . ":"
261                                                  . $authAV . " ("
262                                                  . $yearAV . ")}";
263                                        }
264                                        else {
265                                                $result .=
266                                                  $authAV . "(" . $yearAV . ") " . $ref->location();
267
268                                        }
269                                }
270                        }
271                        $counter = $counter + 1;
272                }
273        }
274
275        return ($result);
276}
277
278sub fomatYears {
279        my ($yearsUnformated) = shift;
280        my @years = ();
281        if ( $yearsUnformated =~ /^(\d{4})$/ ) {
282                push( @years, $1 );
283        }
284        else {
285                my @catch = ();
286                if ( @catch = ( $yearsUnformated =~ /\d{4}/g ) ) {
287                        push( @years, @catch );
288
289                        #$yearsUnformated =~ s/\d{4}//g;
290                }
291        }
292        if ( scalar(@years) == 0 ) {
293                carp( " No years found in formatYears in string: \n"
294                          . Dumper($yearsUnformated) );
295        }
296
297        return ( \@years );
298
299}
300
301sub formatAuthors {
302        my ($authref)       = shift;
303        my @authorsAndYears = @$authref;
304        my @formatedAuth    = ();
305
306        for ( my $i = 0 ; $i < scalar(@authorsAndYears) ; $i = $i + 2 ) {
307                my $years = fomatYears( $authorsAndYears[ $i + 1 ] );
308                foreach my $year (@$years) {
309                        push( @formatedAuth, $authorsAndYears[$i], $year );
310                }
311        }
312        return ( \@formatedAuth );
313}
314
315sub getDeceaseID {
316        my ($text) = shift;
317        my $deceaseID = "";
318
319        if ( $text =~ /\(([\W\;\S]{0,15}\d{6})\)/g ) {
320                $deceaseID = $1;
321                $deceaseID =~ s/^see //i;
322        }
323        else {
324                $deceaseID = "\t";
325        }
326        return ($deceaseID);
327}
328
329#sub formatAAMutation {
330#       my $mutation = @_;
331#       #additional_mutations
332#       ##TODO determ mutation is deletion, substitution of insertion.
333#       if  (! $mutation =~ /\w{3}\d{1,4}\w{w}/ ) {
334#               carp("non mutation\t".$mutation);
335#       }
336#       return ($mutation);
337#}
338
339sub formatInDelMutation {
340        my ($mutation,$desc) = @_;
341        #create return vraiable
342        my $formatMutation = "";
343        #check a postion is availble
344        if (! ($mutation =~ /,/)) {
345                #carp("no postion\n $mutation \n");
346                 if($desc =~ /loss of nucleotide(s | )(\d{1,5})/i ){
347                        $mutation= $mutation.",".$2;
348                 }
349        }
350        #codon check
351        if ( $mutation =~ /,[\w ]*?(\d+)/){
352                my $codonnumber =$1;
353#               carp("test 1 \n");
354                if ( $desc =~ /codon $codonnumber/){
355#                       carp("test 2 \n");
356                        my $nuclitdenumber=($codonnumber*3)-2;
357                        $mutation=~s/$codonnumber/$nuclitdenumber/;
358       
359                }
360        }
361        #check indels
362        if ( $mutation =~ /(DEL|INS).*(DEL|INS)/){
363#               carp("INDEL 2 \n");
364                my $indelregex="(\\d{1,5})-BP\\s*?(DEL|INS)\\/(\\d{1,5})-BP\\s*?(DEL|INS)";
365                if($mutation=~/$indelregex/){
366#                               carp("INDEL 3 \n");
367                       
368                        my $del=0;
369                        my $ins=0;
370                        #derm length of del en ins and asign to right variable
371                        if ($2 eq "DEL"){
372                         $del=$1;
373                                $ins=$3;
374                        }else{
375                                 $del=$3;
376                                 $ins=$1;
377                        }
378                        my $mutationclean=$mutation;
379                        $mutationclean=~s/$indelregex/ /;
380#                       carp("\n\n $mutationclean \n\n");
381                        if ( my @results=$mutationclean =~ /([ACTGN]*)(\d{1,5})([ACTGN]*)/i ) {
382#                                               carp("INDEL 4 \n");
383                                $formatMutation=$results[1]."_".(($results[1])+($del-1))."del".$results[0]."ins".$results[2];
384                        }
385                }
386        }
387        #               print("'".$mutation."'");
388       
389        if ( $mutation =~ /^1-BP\s*?(DEL)\,\s*?(\d{1,5})([A-Z])/i ) {
390
391                $formatMutation = $2 . lc($1) . $3;
392        }
393        elsif ( $mutation =~
394                /^(\d{1,5})-BP\s*?(DEL|INS)\,[\sNT]*?(\d{1,5})([A-Z]*.?)/i )
395        {
396
397                #correction for calculating deletions
398                my $cor_del = 1;
399                if ( lc($2) eq "ins" ) {
400                        $cor_del = 0;
401                }
402                $formatMutation = $3 . "_" . ( $3 + $1 - $cor_del ) . lc($2) . $4;
403        }
404        elsif ( $mutation =~ /^(\d{1,5})([A-Z]*?)\s*?(DEL)/i ) {
405                $formatMutation = $1 . lc($3) . $2;
406        }
407        elsif ( $mutation =~ /(INT(\d{0,3})-(\d{0,3}) (DEL))/i ) {
408
409                $formatMutation = "IVS" . $2 . "+?_IVS" . $3 . "+?" . lc($4);
410                $mutation =~ s/INT\d{0,3}-\d{0,3} DEL//;
411                if ( length($mutation) > 5 ) {
412                        $formatMutation .= "," . formatInDelMutation($mutation);
413                }
414        }
415        elsif($formatMutation eq "") {
416                $formatMutation = $mutation;
417        }
418
419        return ($formatMutation);
420}
421
422sub createAuthorsOutput {
423        my ( $self, $refsref, $authref, $numb ) = @_;
424        my $result      = "";
425        my @authAndYear = @$authref;
426        my ( $author, $year, $pubmedidref ) = "";
427        for ( my $i = 0 ; $i < scalar(@authAndYear) ; $i = $i + 2 ) {
428                $author = $authAndYear[$i];
429                $year   = $authAndYear[ $i + 1 ];
430                $result .= $self->getPubmedID( $refsref, $author, $year, $numb );
431
432        }
433        if ( $result eq "" ) {
434                $result = "\t";
435        }
436
437        return ($result);
438}
439
440sub proccesAllicVariants {
441        my ( $self, $avsref, $refsref, $numb ) = @_;
442        my @avs    = @$avsref;
443        my $result = "";
444        foreach my $av (@avs) {
445
446                #print($av->number() . "\t");
447                if ( $av->title() ne "REMOVED FROM DATABASE" ) {
448                        my $mutation = getMutation($av);
449
450                        my $authorsAndYears = getAuthor( $av->description() );
451                        $authorsAndYears = formatAuthors($authorsAndYears);
452                        my $articles =
453                          $self->createAuthorsOutput( $refsref, $authorsAndYears, $numb );
454
455                        #lool up allelic variant in dbsnp and return accesionnumber
456                        my $dbsnp = $self->{Omim2DBsnp}->getdbsnp( $numb, $av->number() );
457
458                        #print(Dumper($authorsAndYears));
459
460                        my $desc = $av->description();
461
462                        $desc =~ tr/\n/ /;
463
464                        #                       if ( length($desc) < 60 ) {
465                        #
466                        #                               my $pubmedid = "test";
467                        #
468                        #                               # $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
469                        #                               $result .=
470                        #                                   $numb . "\t"
471                        #                                 . $av->number() . "\t"
472                        #                                 . $av->title() . "\t"
473                        #                                 . $mutation . "\t"
474                        #                                 . $desc
475                        #                                 . $articles . "\n";
476                        #                       }
477                        #                       else {
478
479                        my $deceaseID = getDeceaseID($desc);
480
481                        my $nucleotidemutation =
482                          extractnuclitdemutation( $desc, $av->position() );
483
484                        $result .=
485                            $numb . "\t"
486                          . $av->number() . "\t"
487                          . $av->title() . "\t"
488                          . $deceaseID . "\t"
489                          . $mutation . "\t"
490                          . $dbsnp . "\t"
491                          . $articles . "\t"
492
493                          . $nucleotidemutation . "\n";
494
495                        #                       }
496                }
497        }
498
499        return ($result);
500}
5011;
Note: See TracBrowser for help on using the repository browser.