Changeset 2


Ignore:
Timestamp:
Mar 31, 2010, 5:23:54 PM (9 years ago)
Author:
maarten
Message:

second round of updates

Files:
2 added
3 edited

Legend:

Unmodified
Added
Removed
  • lib/Omim2Pubmed.pm

    r1 r2  
    11        package Omim2Pubmed;
    2         use strict;
     2        use strict;
    33        use warnings;
    44        use Carp;
    5     ##################################################
    6     ## the object constructor (simplistic version)  ##
    7     ##################################################
    8     sub new {
    9         my $self  = {};
    10         $self->{O2P}   = {};
    11        
    12         bless($self);           # but see below
    13         return $self;
    14     }
     5        ##################################################
     6        ## the object constructor (simplistic version)  ##
     7        ##################################################
     8        sub new {
     9                my $self = {};
     10                $self->{O2P} = {};
    1511
    16     ##############################################
    17     ## methods to access per-object data        ##
    18     ##                                          ##
    19     ## With args, they set the value.  Without  ##
    20     ## any, they only retrieve it/them.         ##
    21     ##############################################
     12                bless($self);    # but see below
     13                return $self;
     14        }
    2215
    23     sub loadpubmed_cited {
    24         my ($self,$filename) =@_ ;
    25         open (FILE, "<".$filename) or die $!;
    26         print($filename);
    27         while (<FILE>) {
    28                  my($omim,$ref,$pubmed)=split(/\t/, $_);
    29                 $self->{O2P}{$omim}{$ref}=$pubmed;
    30          
     16        ##############################################
     17        ## methods to access per-object data        ##
     18        ##                                          ##
     19        ## With args, they set the value.  Without  ##
     20        ## any, they only retrieve it/them.         ##
     21        ##############################################
     22
     23        sub loadpubmed_cited {
     24                my ( $self, $filename ) = @_;
     25                open( FILE, "<" . $filename ) or die $!;
     26                print($filename);
     27                while (<FILE>) {
     28                        my ( $omim, $ref, $pubmed ) = split( /\t/, $_ );
     29                        $pubmed =~ s/\s+$//;
     30                        $self->{O2P}{$omim}{$ref} = $pubmed;
     31
     32                }
     33                return ("size of hash:  .\n");
    3134        }
    32         return ("size of hash:  .\n");
    33     }
    3435
    35     sub getpubmed {
    36         my ($self,$omim,$ref) = @_;
    37     my $pubmed="";
    38     if(exists($self->{O2P}->{$omim}->{$ref})){ 
    39        $pubmed=$self->{O2P}->{$omim}->{$ref};
    40       }else{
    41         $pubmed="non found";
    42         carp("omimid:".$omim," numberref:",$ref, " value does not exist/n");
    43       }
    44         return ($pubmed);
    45     }
     36        sub getpubmed {
     37                my ( $self, $omim, $ref ) = @_;
     38                my $pubmed = "";
     39                if ( exists( $self->{O2P}->{$omim}->{$ref} ) ) {
     40                        $pubmed = $self->{O2P}->{$omim}->{$ref};
     41                }
     42                else {
     43                        $pubmed = "non found";
     44                        carp( "omimid:" . $omim,
     45                                " numberref:", $ref, " value does not exist/n" );
     46                }
    4647
    47     1;  # so the require or use succeeds
     48                return ($pubmed);
     49        }
     50
     51        1;    # so the require or use succeeds
  • lib/ProccesAllicVariants.pm

    r1 r2  
    11package ProccesAllicVariants;
    2         use strict;
    3         use warnings;
    4         use Carp;
    5         use Data::Dumper;
     2use strict;
     3use warnings;
     4use Carp;
     5use Data::Dumper;
    66
    7     sub new {
    8         my $pubmedlocation=$_;
    9         my $self  = {};
    10            $self->{Omim2Pubmed}="";
    11        
    12         bless($self);           # but see below
    13         return $self;
    14     }
     7sub new {
     8        my $pubmedlocation = $_;
     9        my $self           = {};
     10        $self->{Omim2Pubmed} = "";
    1511
     12        bless($self);                # but see below
     13        return $self;
     14}
    1615
    17 sub getMutation{
    18   my $av=shift;
     16sub getMutation {
     17        my $av = shift;
    1918
    20 
    21    my $mutation=$av->aa_ori().$av->position().$av->aa_mut();
    22   if (length($mutation)==0){
    23        $mutation=$av->additional_mutations();
    24   }
    25    return($mutation);
     19        my $mutation = $av->aa_ori() . $av->position() . $av->aa_mut();
     20        if ( length($mutation) == 0 ) {
     21                $mutation = $av->additional_mutations();
     22        }
     23        return ($mutation);
    2624
    2725}
    28 sub addOmim2pubmed{
    29         my($self,$o2p)=@_;
    30         $self->{Omim2Pubmed}=$o2p;
    31        
     26
     27sub addOmim2pubmed {
     28        my ( $self, $o2p ) = @_;
     29        $self->{Omim2Pubmed} = $o2p;
     30
    3231}
    3332
    34 sub getAuthor{
    35    
    36             my $desc =shift;
     33sub extractwithposition {
     34        my ( $desc, $aapos ) = @_;
     35        my $result = "";
    3736
    38            
    39             $desc=~tr/\n/ /;
    40             $desc=~/([\w-]*.)\set al.\s*?\((\d{4})\)/;
    41                 my $authAV=$1;
    42                 my $yearAV=$2;
    43         #TODO :add regexp for authors with  "And" between names
    44        
    45         #TODO: add solution for mulitple authors (author 2009; auth3 2002 ,etc )
    46         if (!defined($authAV)||length($authAV)<2){
    47                 carp("No Author found in getAuthor found in :\n\n".$desc."\n\n");
    48             }
    49             if (!defined($yearAV)||length($yearAV)<2){
    50                 carp("No year in getAuthor found in :\n\n".$desc."\n\n");
    51             }
    52            
    53             return($authAV,$yearAV);
     37        #110G-T transversion
     38        #110G-A transition
     39
     40        if ( $desc =~ /(($aapos)[ACTG]-[ACTG] trans[a-z]{4,9})/i ) {
     41
     42                $result = $1;
     43                print($result);
     44        }
     45        print("emn.$aapos\n");
     46        return ($result);
    5447}
    5548
    56 sub proccesAllicVariants{
    57          my ($self,$avsref,$refsref,$numb)=@_;
    58                 my @avs=@$avsref;
    59                 my @refs=@$refsref;     
    60                 my $result="";
    61                 foreach my $av (@avs){
    62                         #print Dumper($av);
    63                         my $desc=$av->description();
    64                         $desc=~tr/\n/ /;
    65                         #print $desc."\n";
    66                         $desc=~/\(([\W\;\S]{0,15}\d{6})\)/g;
    67                         my $deceaseID="";
    68                         if(defined($_)){
    69                             $deceaseID=$_;
    70                           }else{
    71                           $deceaseID="not found";
    72                         }
    73                         #print($1,"\n\n");
    74                
    75                         my $mutation=getMutation($av);
    76                         my ($authAV,$yearAV)=getAuthor($av->description());
    77                         #print $numb."\t".$av->number()."\t".$av->title()." ".$deceaseID."\t".$mutation."\n";
    78                         $result.= $numb."\t".$av->number()."\t".$av->title()." ".$deceaseID."\t".$mutation;
    79                        
    80                         $result.= "\t".$authAV."et al. (".$yearAV.") ";
    81                         # print("\n".$authAV.$yearAV);
    82                         my $counter=0;
    83                         foreach my $ref(@refs){
    84                                 $counter=$counter+1;
    85                                  my $auth=$ref->authors();
    86                                  
    87                                 if ( $auth=~ m/^$authAV/){
    88                                         my $authY=$ref->location();
    89                                         if ( $authY=~ m/$yearAV/){
    90                                
    91                                                 $result.=$self->{Omim2Pubmed}->getpubmed($numb,$counter)."\n";
    92                                         }
    93                           }                     
     49sub extractnuclitdemutation {
     50        my ( $desc, $aapos ) = @_;
     51        my $result = "";
     52
     53        #check corresponding nucl position from aa pos
     54        if ( $aapos =~ /[0-9]{1,6}/i ) {
     55
     56                my $nuclposition = "";
     57                $nuclposition = ( $aapos * 3 ) . "|";
     58                $nuclposition .= ( ( $aapos * 3 ) - 1 ) . "|" . ( ( $aapos * 3 ) - 2 );
     59                if ( $desc =~ /($nuclposition)/ ) {
     60
     61                        $result = extractwithposition( $desc, $nuclposition );
    9462                }
     63        }
     64        if ( length($result) == 0 ) {
     65
     66                #heterozygous A-to-G transition in exon 3
     67                #heterozygous G-to-C transversion in exon 2
     68                # T-to-C transition in exon 3
     69                if ( $desc =~
     70/(([a-z]{3,9}gous)? [ATCG]-to-[ATCG] trans[a-z]{5,8} in exon [0-9]{1,2})/i
     71                  )
     72                {
     73                        $result = $1;
     74                }
     75                elsif ( $desc =~ /(codon [a-z])/i ) {
     76
     77                        #codon 163 was changed from GTG (val) to CTG (leu)
     78                }
     79
     80        }
     81        return ($result);
    9582}
    9683
    97 return($result);
     84sub getAuthor {
     85
     86        my $desc = shift;
     87
     88        $desc =~ tr/\n/ /;
     89        $desc =~ /([\w-]*.)\set al.\s*?\((\d{4})\)/;
     90        my $authAV = $1;
     91        my $yearAV = $2;
     92
     93        #TODO :add regexp for authors with  "And" between names
     94
     95        #TODO: add solution for mulitple authors (author 2009; auth3 2002 ,etc )
     96        if ( !defined($authAV) || length($authAV) < 2 ) {
     97                carp( "No Author found in getAuthor found in :\n\n" . $desc . "\n\n" );
     98        }
     99        if ( !defined($yearAV) || length($yearAV) < 2 ) {
     100                carp( "No year in getAuthor found in :\n\n" . $desc . "\n\n" );
     101        }
     102
     103        return ( $authAV, $yearAV );
     104}
     105
     106sub getPubmedID {
     107
     108        my ( $self, $refsref, $authAV, $yearAV, $numb ) = @_;
     109
     110        my $result  = "";
     111        my @refs    = @$refsref;
     112        my $counter = 0;
     113        foreach my $ref (@refs) {
     114                $counter = $counter + 1;
     115                my $auth = $ref->authors();
     116
     117                if ( $auth =~ m/^$authAV/ ) {
     118                        my $authY = $ref->location();
     119                        if ( $authY =~ m/$yearAV/ ) {
     120
     121                                $result .= $self->{Omim2Pubmed}->getpubmed( $numb, $counter );
     122                        }
     123                }
     124        }
     125
     126        return ($result);
     127}
     128
     129sub getDeceaseID {
     130        my ($text) = shift;
     131        my $deceaseID = "";
     132
     133        if ( $text =~ /\(([\W\;\S]{0,15}\d{6})\)/g ) {
     134                $deceaseID = $1;
     135                $deceaseID =~ s/^see //i;
     136        }
     137        else {
     138                $deceaseID = "decease ID not found";
     139        }
     140        return ($deceaseID);
     141}
     142
     143sub proccesAllicVariants {
     144        my ( $self, $avsref, $refsref, $numb ) = @_;
     145
     146        my @avs    = @$avsref;
     147        my $result = "";
     148        foreach my $av (@avs) {
     149
     150                #print Dumper($av);
     151
     152                my $mutation = getMutation($av);
     153                my ( $authAV, $yearAV ) = getAuthor( $av->description() );
     154                my $desc = $av->description();
     155                $desc =~ tr/\n/ /;
     156                if ( length($desc) < 60 ) {
     157                        my ( $authAV, $yearAV ) = getAuthor( $av->description() );
     158                        my $pubmedid =
     159                          $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
     160                        $result .=
     161                            $numb . "\t"
     162                          . $av->number() . "\t"
     163                          . $av->title() . "\t"
     164                          . $mutation . "\t"
     165                          . $desc
     166                          . $pubmedid . "\n";
     167                }
     168                else {
     169
     170                        my $deceaseID = getDeceaseID($desc);
     171
     172                        my $nucleotidemutation =
     173                          extractnuclitdemutation( $desc, $av->position() );
     174                        my $pubmedid =
     175                          $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
     176                        $result .=
     177                            $numb . "\t"
     178                          . $av->number() . "\t"
     179                          . $av->title() . " "
     180                          . $deceaseID . "\t"
     181                          . $mutation . "\t"
     182                          . $authAV . "("
     183                          . $yearAV . ") "
     184                          . $pubmedid . "\t"
     185                          . $nucleotidemutation . "\n";
     186                }
     187
     188        }
     189
     190        return ($result);
    98191}
    991921;
  • omimparser.pl

    r1 r2  
     1
     2
     3use lib "/home/maarten/programs/BioPerl-1.6.1-patched";
     4
    15use Bio::Phenotype::OMIM::OMIMparser;
    26use strict;
    37use warnings;
    4 use Omim2Pubmed;
     8use lib::Omim2Pubmed;
    59use Data::Dumper;
    6 use ProccesAllicVariants;
     10use lib::ProccesAllicVariants;
    711
    812        use Carp;
     
    4448
    4549my $filename=$ARGV[0];
     50
     51if (! -e($filename)){
     52  die("\nfile $filename not found");
     53  }
    4654  # The OMIM database is available as textfile at:
    4755  # ftp://ncbi.nlm.nih.gov/repository/OMIM/omim.txt.Z
     
    5159#   $omim_parser = Bio::Phenotype::OMIM::OMIMparser->new( -genemap  => "/path/to/genemap",
    5260#                                                         -omimtext => "/path/to/omim.txt" );
    53 my $pubmedcited="pubmed_cited";
     61my $pubmedcited="data/pubmed_cited";
    5462my $omim2pubmed=Omim2Pubmed->new();
    5563$omim2pubmed->loadpubmed_cited($pubmedcited);
     
    6977    my $title = $omim_entry->title();                          # *FIELD* TI - first line
    7078    my $alt   = $omim_entry->alternative_titles_and_symbols(); # *FIELD* TI - additional lines
    71     my $mtt   = $omim_entry->more_than_two_genes();            # "#" before title
    72     my $sep   = $omim_entry->is_separate();                    # "*" before title
    73     my $desc  = $omim_entry->description();                    # *FIELD* TX
    74     my $mm    = $omim_entry->mapping_method();                 # from genemap
    75     my $gs    = $omim_entry->gene_status();                    # from genemap
    76     my $cr    = $omim_entry->created();                        # *FIELD* CD
    77     my $cont  = $omim_entry->contributors();                   # *FIELD* CN
    78     my $ed    = $omim_entry->edited();                         # *FIELD* ED
    79     my $sa    = $omim_entry->additional_references();          # *FIELD* SA
    80     my $cs    = $omim_entry->clinical_symptoms_raw();              # *FIELD* CS
    81     my $comm  = $omim_entry->comment();                        # from genemap
     79#     my $mtt   = $omim_entry->more_than_two_genes();            # "#" before title
     80#     my $sep   = $omim_entry->is_separate();                    # "*" before title
     81#     my $desc  = $omim_entry->description();                    # *FIELD* TX
     82#     my $mm    = $omim_entry->mapping_method();                 # from genemap
     83#     my $gs    = $omim_entry->gene_status();                    # from genemap
     84#     my $cr    = $omim_entry->created();                        # *FIELD* CD
     85#     my $cont  = $omim_entry->contributors();                   # *FIELD* CN
     86#     my $ed    = $omim_entry->edited();                         # *FIELD* ED
     87#     my $sa    = $omim_entry->additional_references();          # *FIELD* SA
     88#     my $cs    = $omim_entry->clinical_symptoms_raw();              # *FIELD* CS
     89#     my $comm  = $omim_entry->comment();                        # from genemap
    8290
    8391#       print($title."\n".$alt."\n".$mtt."\n".$sep);
Note: See TracChangeset for help on using the changeset viewer.