Changeset 5 for lib


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

auther rewriten

File:
1 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                }
Note: See TracChangeset for help on using the changeset viewer.