Changeset 5


Ignore:
Timestamp:
Apr 13, 2010, 11:06:28 AM (10 years ago)
Author:
maarten
Message:

auther rewriten

Files:
3 edited

Legend:

Unmodified
Added
Removed
  • lib/ProccesAllicVariants.pm

    r4 r5  
    1414}
    1515
    16 sub trim($)
    17 {
     16sub trim($) {
    1817        my $string = shift;
    1918        $string =~ s/^\s+//;
     
    108107        my $yearAV = "";
    109108        $desc =~ tr/\n/ /;
    110         $desc=trim($desc);
    111         if (length($desc)>=1){
    112         if ( $desc =~ /([\w-]*.)\set al.[,\s]*?\(([\d\s,]{4,14})\)/ ) {
    113                 $authAV = $1;
    114                 $yearAV = $2;
    115         }
    116 
    117         # add regexp for authors with  "And" between names
    118         if ( length($authAV) == 0 ) {
    119                 if ( $desc =~ /([\w-]*.\sand\s[\w-]*.)\s*.\(([\d]{4})\)/ ) {
    120                         $authAV = $1;
    121                         $yearAV = $2;
    122                 }
    123         }
     109        $desc = trim($desc);
     110
     111        my @regexp = ();
     112
     113        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?\\(([\\d\\s,]{4,14})\\)" );
     114
     115        # add regexp for authors with  And between names
     116
     117        push( @regexp, "([\\w-]*.\\sand\\s[\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
    124118
    125119        #TODO: add solution for mulitple authors (author 2009; auth3 2002 ,etc )
    126         #Bradley et al., 1975;
    127         if ( length($authAV) == 0 ) {
    128                 if ( $desc =~ /([\w-]*.)\set al.[,\s]*?([\d]{4})/i){
    129                         $authAV = $1;
    130                         $yearAV = $2;
    131                 }
    132         }
     120
     121        #Bradley et al., 1975;
     122        push( @regexp, "([\\w-]*.)\\set al.[,\\s]*?([\\d]{4})" );
     123
    133124        #See Brennan (1985)
    134         if ( length($authAV) == 0 ) {
    135                 if ( $desc =~ /([\w-]*.)\s*.\(([\d]{4})\)/i ) {
    136                         $authAV = $1;
    137                         $yearAV = $2;
    138                 }
    139         }
    140         #Tiller et al. (1993, 1995)
    141         if ( length($authAV) == 0 ) {
    142                 if ( $desc =~ /\(([\w-]*.)\set al.\s*?([\d\s,]{4,14})\)/i ) {
    143                         $authAV = $1;
    144                         $yearAV = $2;
    145                 }
    146         }
     125
     126        push( @regexp, "([\\w-]*.)\\s*.\\(([\\d]{4})\\)" );
     127
     128        #Tiller et al. (1993, 1995)
     129        push( @regexp, "([\\w-]*.)\\set al.\\s*?([\\d\\s,]{4,14})\\)" );
     130
    147131        #de Vries and de Wet (1986, 1987)
    148         if ( length($authAV) == 0 ) {
    149                 if ( $desc =~ /([\w-]*.\sand\s[\w\s-]{3,11})\s*.\(([\d\s,]{4,14})/i ) {
    150                         $authAV = $1;
    151                         $yearAV = $2;
    152                 }
    153         }
    154         #
     132        push( @regexp,
     133                "([\\w-]*.\\sand\\s[\\w\\s-]{3,11})\\s*.\\(([\\d\\s,]{4,14})" );
     134
    155135        #See 123456.1234
    156         if ( length($authAV) == 0 ) {
    157                 if ( $desc =~ /See\s(\d{6}).(\d{4})/i ) {
    158                         $authAV = $1;
    159                         $yearAV = $2;
    160                 }
    161         }
    162         if ( !defined($authAV) || length($authAV) < 2 ) {
    163                 carp( "No Author found in getAuthor found in :\n".length($desc)."\n" . $desc . "\n\n" );
    164         }
    165 
    166         if ( !defined($yearAV) || length($yearAV) < 2 ) {
    167                 carp( "No year in getAuthor found in :\n\n" . $desc . "\n\n" );
    168         }
    169 
    170         #Tiller et al. (1993, 1995) demonstrated that cartilage f
    171         if ( length($yearAV) != 4 ) {
    172                 if ( $yearAV =~ /([\d]{4})$/ ) {
    173                         $yearAV = $1;
    174                 }
    175         }
    176         }
    177 
    178         return ( $authAV, $yearAV );
     136        push( @regexp, "See\\s(\\d{6}).(\\d{4})" );
     137
     138        my $reg         = "";
     139        my @returnarray = ();
     140        my @srcs        = ();
     141        foreach $reg (@regexp) {
     142
     143                if ( @srcs = ( $desc =~ /$reg/g ) ) {
     144                        push( @returnarray, @srcs );
     145                        $desc =~ s/$reg//g;
     146                }
     147        }
     148
     149        #check if return has a author and year
     150        if ( scalar(@returnarray) % 2 ) {
     151                carp( " length of authors is not a multiple from 2 possible error\n"
     152                          . Dumper(@returnarray) );
     153        }
     154        if ( scalar(@returnarray) == 0 ) {
     155                carp( "No authors found in:\n\n" . $desc . "\n" );
     156        }
     157
     158        return (\@returnarray);
    179159}
    180160
     
    205185}
    206186
     187sub fomatYears {
     188        my ($yearsUnformated) = shift;
     189        my @years = ();
     190        if ( $yearsUnformated =~ /^(\d{4})$/ ) {
     191                        push( @years, $1 );
     192        }
     193        else {
     194                my @catch = ();
     195                if ( @catch = ( $yearsUnformated =~ /\d{4}/g ) ) {
     196                        push( @years, @catch );
     197
     198                        #$yearsUnformated =~ s/\d{4}//g;
     199                }
     200        }
     201        if ( scalar(@years) == 0 ) {
     202                carp( " No years found in formatYears in string: \n"
     203                          . Dumper($yearsUnformated) );
     204        }
     205
     206        return (\@years);
     207
     208}
     209
     210sub formatAuthors {
     211        my ($authref)       = shift;
     212        my @authorsAndYears = @$authref;
     213        print (scalar(@authorsAndYears));
     214        my @formatedAuth    = ();
     215
     216        for ( my $i = 0 ; $i < scalar(@authorsAndYears) ; $i =$i +2 ) {
     217                my $years = fomatYears( $authorsAndYears[ $i + 1 ] );
     218                foreach my $year (@$years) {
     219                        push( @formatedAuth, $authorsAndYears[$i], $year );
     220                }
     221        }
     222        return(\@formatedAuth);
     223}
     224
    207225sub getDeceaseID {
    208226        my ($text) = shift;
     
    219237}
    220238
     239sub createAuthorsOutput {
     240        my ( $self, $refsref, $authref, $numb ) = @_;
     241        my $result      = "";
     242        my @authAndYear = @$authref;
     243        my ( $author, $year, $pubmedid ) = "";
     244        for ( my $i = 0 ; $i < scalar(@authAndYear) ; $i =$i +2 ) {
     245                $author   = $authAndYear[$i];
     246                $year     = $authAndYear[ $i + 1 ];
     247                $pubmedid = $self->getPubmedID( $refsref, $author, $year, $numb );
     248                $result .= "{PMID" . $pubmedid . ": " . $author . " (" . $year . ")}";
     249        }
     250
     251        return ($result);
     252}
     253
    221254sub proccesAllicVariants {
    222255        my ( $self, $avsref, $refsref, $numb ) = @_;
     
    226259        foreach my $av (@avs) {
    227260
    228                 #print Dumper($av);
    229 
    230                 my $mutation = getMutation($av);
    231                 my ( $authAV, $yearAV ) = getAuthor( $av->description() );
     261                my $mutation        = getMutation($av);
     262                my $authorsAndYears = getAuthor( $av->description() );
     263                $authorsAndYears = formatAuthors($authorsAndYears);
     264                my $articles=$self->createAuthorsOutput( $refsref,$authorsAndYears, $numb );
    232265                my $desc = $av->description();
    233266                $desc =~ tr/\n/ /;
    234267                if ( length($desc) < 60 ) {
    235                         my ( $authAV, $yearAV ) = getAuthor( $av->description() );
    236                         my $pubmedid =
    237                           $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
     268
     269                        my $pubmedid = "test";
     270                         # $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
    238271                        $result .=
    239272                            $numb . "\t"
     
    242275                          . $mutation . "\t"
    243276                          . $desc
    244                           . $pubmedid . "\n";
     277                          . $articles . "\n";
    245278                }
    246279                else {
     
    250283                        my $nucleotidemutation =
    251284                          extractnuclitdemutation( $desc, $av->position() );
    252                         my $pubmedid =
    253                           $self->getPubmedID( $refsref, $authAV, $yearAV, $numb );
     285       
    254286                        $result .=
    255287                            $numb . "\t"
     
    258290                          . $deceaseID . "\t"
    259291                          . $mutation . "\t"
    260                           . $authAV . "("
    261                           . $yearAV . ") "
    262                           . $pubmedid . "\t"
     292                          .$articles."\t"
     293                        #  . $authAV . "("
     294                        #  . $yearAV . ") "
     295                         
    263296                          . $nucleotidemutation . "\n";
    264297                }
  • omimparser.pl

    r3 r5  
    8989#     my $comm  = $omim_entry->comment();                        # from genemap
    9090
    91 #       print($title."\n".$alt."\n".$mtt."\n".$sep);
     91        print($numb);
    9292       
    9393        #$title=~/(\S*.)$/;
     
    127127        if (scalar(@avs)>0){
    128128              my $geneid=getfilename($title,$alt);
    129               open (FILE, ">output/".$geneid.".txt") or die $!;
     129              open (FILE, ">output/".$geneid.".txt") or die $!;
     130         
    130131              print FILE ($PAV->proccesAllicVariants(\@avs,\@refs,$numb));
    131132              close (FILE);
  • test/test.pl

    r4 r5  
    99use Omim2Pubmed;
    1010use Bio::Phenotype::OMIM::OMIMparser;
    11 use Test::More tests => 26;
     11use Test::More tests => 33;
    1212
    1313#lib "../lib";
     
    2424"Ilkovski et al. (2001) identified a heterozygous ile136-to-met (I136M) substitution in the ACTA1 gene in a 45-year-old man with nemaline myopathy (161800). Although he had infantile-onset and delayed motor development, his weakness was nonprogressive, and he was physically active as an adult and regularly engaged in long-distance competitive cycling. He had a weak cough and frequent respiratory infections. Echocardiography was normal.";
    2525
    26 my @getauthor = ProccesAllicVariants::getAuthor($string);
    27 is( $getauthor[0], "Ilkovski", "get author" );
    28 is( $getauthor[1], "2001",     "get author year" );
     26my $years=ProccesAllicVariants::fomatYears("1999");
     27is( @$years[0], "1999", "formatyears" );
     28
     29 $years=ProccesAllicVariants::fomatYears("1999 ,2000");
     30is( @$years[0], "1999", "formatyears multiple" );
     31is( @$years[1], "2000", "formatyears multiple" );
     32my $getauthor = ProccesAllicVariants::getAuthor($string);
     33
     34
     35
     36is( @$getauthor[0], "Ilkovski", "get author" );
     37is( @$getauthor[1], "2001",     "get author year" );
     38
    2939is( ProccesAllicVariants::getDeceaseID($string), "161800", "get decease id" );
    3040
    31 @getauthor = ProccesAllicVariants::getAuthor(
     41$getauthor = ProccesAllicVariants::getAuthor(
    3242        "Tiller et al. (1993, 1995) demonstrated that cartilage f");
    33 is( $getauthor[0], "Tiller", "get author" );
    34 is( $getauthor[1], "1995",   "get author year" );
     43is( @$getauthor[0], "Tiller", "get author" );
     44is( @$getauthor[1], "1993, 1995",   "get author year" );
     45
     46my $authorsAndYears = ProccesAllicVariants::formatAuthors($getauthor);
     47is( @$authorsAndYears[0], "Tiller", "format author" );
     48is( @$authorsAndYears[1], "1993", "format author year" );
     49is( @$authorsAndYears[2], "Tiller", "format author" );
     50is( @$authorsAndYears[3], "1995", "format author year " );
     51
     52 my $authandyear=[
     53          'Nowak',
     54          '1999',
     55          'Ilkovski',
     56          '2001'
     57        ];
     58
     59$authorsAndYears = ProccesAllicVariants::formatAuthors($authandyear);
    3560
    3661
    37 @getauthor = ProccesAllicVariants::getAuthor(
     62$getauthor = ProccesAllicVariants::getAuthor(
    3863        "(Bradley et al., 1975; faf)");
    39 is( $getauthor[0], "Bradley", "get author" );
    40 is( $getauthor[1], "1975",   "get author year" );
     64is( @$getauthor[0], "Bradley", "get author" );
     65is( @$getauthor[1], "1975",   "get author year" );
    4166
    4267
    43 @getauthor = ProccesAllicVariants::getAuthor(
     68$getauthor = ProccesAllicVariants::getAuthor(
    4469        "See Brennan (1985).");
    45 is( $getauthor[0], "Brennan", "get author" );
    46 is( $getauthor[1], "1985",   "get author year" );
     70is( @$getauthor[0], "Brennan", "get author" );
     71is( @$getauthor[1], "1985",   "get author year" );
    4772
    48 @getauthor = ProccesAllicVariants::getAuthor(
     73$getauthor = ProccesAllicVariants::getAuthor(
    4974        " (Takahashi et al., 1987) ");
    50 is( $getauthor[0], "Takahashi", "get author" );
    51 is( $getauthor[1], "1987",   "get author year" );
     75is( @$getauthor[0], "Takahashi", "get author" );
     76is( @$getauthor[1], "1987",   "get author year" );
    5277
    53 @getauthor = ProccesAllicVariants::getAuthor(
     78$getauthor = ProccesAllicVariants::getAuthor(
    5479        "Brennan and Fellowes (1993) that cartilage f");
    55         is( $getauthor[0], "Brennan and Fellowes", "get author" );
    56 is( $getauthor[1], "1993",   "get author year" );
     80        is( @$getauthor[0], "Brennan and Fellowes", "get author" );
     81is( @$getauthor[1], "1993",   "get author year" );
    5782       
    58         @getauthor = ProccesAllicVariants::getAuthor("McIntosh et al., (1994)");
    59         is( $getauthor[0], "McIntosh", "get author" );
    60         is( $getauthor[1], "1994",   "get author year" );
     83        $getauthor = ProccesAllicVariants::getAuthor("McIntosh et al., (1994)");
     84        is( @$getauthor[0], "McIntosh", "get author" );
     85        is( @$getauthor[1], "1994",   "get author year" );
    6186       
    62                 @getauthor = ProccesAllicVariants::getAuthor("  de Vries and de Wet (1986, 1987)
     87                $getauthor = ProccesAllicVariants::getAuthor("  de Vries and de Wet (1986, 1987)
    6388");
    64         is( $getauthor[0], "Vries and de Wet", "get author" );
    65         is( $getauthor[1], "1987",   "get author year" );
     89        is( @$getauthor[0], "Vries and de Wet", "get author" );
     90        is( @$getauthor[1], "1986, 1987",   "get author year" );
    6691       
    6792$string =
     
    79104$string =~ tr/\n/ /;
    80105
    81 @getauthor = ProccesAllicVariants::getAuthor($string);
    82 is( $getauthor[0],                               "Goebel", "get author" );
    83 is( $getauthor[1],                               "1997",   "get author year" );
     106$getauthor = ProccesAllicVariants::getAuthor($string);
     107is( @$getauthor[0],                               "Goebel", "get author" );
     108is( @$getauthor[1],                               "1997",   "get author year" );
    84109is( ProccesAllicVariants::getDeceaseID($string), "161800", "get decease id" );
    85110is(
     
    158183is( ( $PAV->getPubmedID( \@refs, "Ilkovski", "2001", $numb ) ),
    159184        "11333380", "get omim record " );
     185        #               $self->createAuthorsOutput( $refsref,$authorsAndYears, $numb  );
     186         $authandyear=["Ilkovski", "2001"];
     187is($PAV->createAuthorsOutput( \@refs, $authandyear, $numb ),"{PMID11333380: Ilkovski (2001)}","testing layout of authors");
     188
Note: See TracChangeset for help on using the changeset viewer.