source: lib/ProccesAllicVariants.pm @ 7

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

added rewriting of insertions and deletions

File size: 7.9 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 = 0;
191                foreach my $ref (@refs) {
192                        $counter = $counter + 1;
193                        my $auth = $ref->authors();
194                        if ( $auth =~ m/^$authAV/ ) {
195                                my $authY = $ref->location();
196                                if ( $authY =~ m/$yearAV/ ) {
197
198                                        $result .=
199                                          $self->{Omim2Pubmed}->getpubmed( $numb, $counter );
200                                }
201                        }
202                }
203        }
204
205        return ($result);
206}
207
208sub fomatYears {
209        my ($yearsUnformated) = shift;
210        my @years = ();
211        if ( $yearsUnformated =~ /^(\d{4})$/ ) {
212                push( @years, $1 );
213        }
214        else {
215                my @catch = ();
216                if ( @catch = ( $yearsUnformated =~ /\d{4}/g ) ) {
217                        push( @years, @catch );
218
219                        #$yearsUnformated =~ s/\d{4}//g;
220                }
221        }
222        if ( scalar(@years) == 0 ) {
223                carp( " No years found in formatYears in string: \n"
224                          . Dumper($yearsUnformated) );
225        }
226
227        return ( \@years );
228
229}
230
231sub formatAuthors {
232        my ($authref) = shift;
233        my @authorsAndYears = @$authref;
234        my @formatedAuth = ();
235
236        for ( my $i = 0 ; $i < scalar(@authorsAndYears) ; $i = $i + 2 ) {
237                my $years = fomatYears( $authorsAndYears[ $i + 1 ] );
238                foreach my $year (@$years) {
239                        push( @formatedAuth, $authorsAndYears[$i], $year );
240                }
241        }
242        return ( \@formatedAuth );
243}
244
245sub getDeceaseID {
246        my ($text) = shift;
247        my $deceaseID = "";
248
249        if ( $text =~ /\(([\W\;\S]{0,15}\d{6})\)/g ) {
250                $deceaseID = $1;
251                $deceaseID =~ s/^see //i;
252        }
253        else {
254                $deceaseID = "decease ID not found";
255        }
256        return ($deceaseID);
257}
258
259#sub formatAAMutation {
260#       my $mutation = @_;
261#       #additional_mutations
262#       ##TODO determ mutation is deletion, substitution of insertion.
263#       if  (! $mutation =~ /\w{3}\d{1,4}\w{w}/ ) {
264#               carp("non mutation\t".$mutation);
265#       }
266#       return ($mutation);
267#}
268
269sub formatInDelMutation{
270                my $mutation = shift;
271                print("'".$mutation."'");
272                my $formatMutation="";
273                if  ( $mutation =~ /^1-BP\s*?(DEL)\,\s*?(\d{1,5})([A-Z])/i ) {
274                       
275                        $formatMutation=$2.lc($1).$3;
276                }elsif($mutation =~ /^(\d{1,5})-BP\s*?(DEL|INS)\,[\sNT]*?(\d{1,5})([A-Z]*.?)/i){
277                        #correction for calculating deletions
278                        my $cor_del=1;
279                        if(lc($2)eq"ins"){
280                                $cor_del=0;
281                        }
282                        $formatMutation=$3."_".($3+$1-$cor_del).lc($2).$4;
283                }elsif($mutation =~ /^(\d{1,5})([A-Z]*?)\s*?(DEL)/i){
284                        $formatMutation=$1.lc($3).$2;
285                }else{
286                        $formatMutation=$mutation;
287                }
288               
289               
290                return ($formatMutation);
291}
292
293sub createAuthorsOutput {
294        my ( $self, $refsref, $authref, $numb ) = @_;
295        my $result      = "";
296        my @authAndYear = @$authref;
297        my ( $author, $year, $pubmedid ) = "";
298        for ( my $i = 0 ; $i < scalar(@authAndYear) ; $i = $i + 2 ) {
299                $author   = $authAndYear[$i];
300                $year     = $authAndYear[ $i + 1 ];
301                $pubmedid = $self->getPubmedID( $refsref, $author, $year, $numb );
302                $result .= "{PMID" . $pubmedid . ": " . $author . " (" . $year . ")}";
303        }
304
305        return ($result);
306}
307
308sub proccesAllicVariants {
309        my ( $self, $avsref, $refsref, $numb ) = @_;
310
311        my @avs    = @$avsref;
312        my $result = "";
313        foreach my $av (@avs) {
314#print($av->number() . "\t");
315                my $mutation        = getMutation( $av );
316               
317                my $authorsAndYears = getAuthor( $av->description() );
318                $authorsAndYears = formatAuthors($authorsAndYears);
319                my $articles =
320                  $self->createAuthorsOutput( $refsref, $authorsAndYears, $numb );
321                 
322                #lool up allelic variant in dbsnp and return accesionnumber 
323                my $dbsnp = $self->{Omim2DBsnp}->getdbsnp( $numb, $av->number() );
324                               
325                #print(Dumper($authorsAndYears));
326               
327               
328                my $desc = $av->description();
329               
330                $desc =~ tr/\n/ /;
331                if ( length($desc) < 60 ) {
332
333                        my $pubmedid = "test";
334
335                        # $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
336                        $result .=
337                            $numb . "\t"
338                          . $av->number() . "\t"
339                          . $av->title() . "\t"
340                          . $mutation . "\t"
341                          . $desc
342                          . $articles . "\n";
343                }
344                else {
345
346                        my $deceaseID = getDeceaseID($desc);
347
348                        my $nucleotidemutation =
349                          extractnuclitdemutation( $desc, $av->position() );
350
351                        $result .=
352                            $numb . "\t"
353                          . $av->number() . "\t"
354                          . $av->title() . "\t"
355                          . $deceaseID . "\t"
356                          . $mutation . "\t"
357                          . $dbsnp. "\t"
358                          . $articles . "\t"
359
360
361                          . $nucleotidemutation . "\n";
362                }
363
364        }
365
366        return ($result);
367}
3681;
Note: See TracBrowser for help on using the repository browser.