[Bio] / FigKernelScripts / add_structured_english.pl Repository:
ViewVC logotype

Diff of /FigKernelScripts/add_structured_english.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Mon May 19 18:02:28 2008 UTC revision 1.4, Tue Jun 24 15:15:48 2008 UTC
# Line 4  Line 4 
4    
5  my $fig = new FIG;  my $fig = new FIG;
6    
7    #open (PEGS, "rosspegs");
8    open (PEGS, $ARGV[0]);
9    my %pegs;
10    
11    while (<PEGS>) {
12            $pegs[$_] = 1;
13    }
14    
15    #fig|169963.1.peg.1      NC_003210       318_1673        NP_463534.1     isu,icw(1),ff   dnaA    Chromosomal replication initiator protein dnaA  CDD:pfam00004,CDD:pfam00308,CDD:pfam01695,CDD:smart00382,GeneID:984365,InterPro:IPR001957,InterPro:IPR003593,NCBI_gi:16802049,Pfam:PF00308,SMART:Q8YAW2,SMART:SM00382,UniProtKB:Q8YAW2                  http://www.nmpdr.org/linkin.cgi?id=fig|169963.1.peg.1   MQSIED
16    
17  while (defined($_ = <STDIN>))  while (defined($_ = <STDIN>))
18  {  {
19      chop;      chop;
20      ($peg,$refseq,$seq,undef,$fixed_func,$ecs,undef,undef,undef) = split(/\t/,$_);      ($peg,$contig_refseq,$contig_refseq_coords,$refseq,$ev, $gene, $fixed_func, $dbxref, $kegg, $subsystems, $link, $seq) = split(/\t/,$_);
21      $funcSeed = $fig->function_of($peg,undef,1);      $funcSeed = $fig->function_of($peg,undef,1);
22      my($func1,$ecs1) = &fix_func($funcSeed);      my($func1,$ecs1) = &fix_func($funcSeed);
23      if (($func1 ne $fixed_func) || ($ecs1 ne $ecs))      if (! $pegs[$peg])
24        #if (0)
25        #if (($func1 ne $fixed_func) || ($ecs1 ne $ecs))
26        #if ($func1 ne $fixed_func)
27      {      {
28          print STDERR &Dumper($fixed_func,$func1,$ecs,$ecs1);          print STDERR &Dumper($fixed_func,$func1,$ecs,$ecs1);
29          print STDERR "$_\n";          print STDERR "$_\n";
30      }      }
31      else      else
32      {      {
33          my $structured_english = &to_structured_english($fig,$peg);          my ($evcodes, $subs, $structured_english) = $fig->to_structured_english($peg, 1);
34          my $text = $cgi->unescape($structured_english);          my $text = $cgi->unescape($structured_english);
         if ($structured_english)  
         {  
             print join("\t",($peg,$refseq,$seq,'',$fixed_func,$ecs,$structured_english,'','')),"\n";  
         }  
     }  
 }  
   
 sub to_structured_english {  
     my($fig,$peg) = @_;  
   
     my @ev_codes = &evidence_codes($fig,$peg);  
     my $by_sub = {};  
     foreach my $code (@ev_codes)  
     {  
         if ($code =~ /^isu;(\S.*\S)/)                { $by_sub->{$1}->{'isu'} = 1  }  
         if ($code =~ /^icw\((\d+)\);(\S.*\S)/)       { $by_sub->{$2}->{'icw'} = $1 }  
     }  
   
     my @insubs = grep { $fig->usable_subsystem($_,1) } $fig->peg_to_subsystems($peg,1);  
     my %subs = map { $_ => 1 } @insubs;  
     $funcSeed = $fig->function_of($peg,undef,1);  
     if (@insubs < 1) { return "" }  
   
     my $pieces = [];  
     &add_func_assertion($pieces,$funcSeed);  
     &add_in_subs($pieces,\@insubs);  
     foreach my $sub (@insubs)  
     {  
         &add_clustering_and_dup($pieces,$by_sub->{$sub},$sub);  
     }  
     return &render($pieces);  
 }  
   
 sub render {  
     my($pieces) = @_;  
   
     my @lines = ();  
     my $curr  = "";  
     foreach my $piece (@$pieces)  
     {  
         $piece = "$piece  ";  
         $curr = $curr . $piece;  
35    
36          while (length($curr) > 100)          my $nmpdr_id_text = "nmpdr_id=$peg";
37          {          my $contig_refseq_text= "reference_contig_refseq=$contig_refseq";
38              my($p1,$p2) = &split_piece($curr,100);          my $refseq_coords_text = "reference_contig_refseq_coordinates=$contig_refseq_coords";
39              $p1 =~ s/^\s+//;          my $refseq_id_text= "reference_protein_refseq=$refseq";
40              push(@lines, $p1);          my $evc_text= "evidence_code=$ev";
41              $curr = $p2;          my $gene_symbol_text = "gene_symbol=$gene";
42            my $desc_text = "description=\"$func1\"";
43            #my $desc_text = "description=\"$fixed_func\"";
44            my $dbxref_text = "dbxref=$dbxref";
45            my $kegg_text = "kegg=$kegg";
46            my $subsystem_text = "subsystem=$subs";
47            my $nmpdr_link_text = "nmpdr_web_page=\"$link\"";
48            my $structured_eng_text= "structured_description=\`$structured_english\`";
49            my $seq_text= "protein_sequence=\"$seq\"";
50    
51            if ($structured_english && $seq)
52            {
53                print join("\n",($nmpdr_id_text, $contig_refseq_text, $refseq_coords_text, $refseq_id_text, $evc_text, $gene_symbol_text, $desc_text, $dbxref_text, $subsystem_text, $nmpdr_link_text, $structured_eng_text, $seq_text)), "\n//\n";
54                #print join("\n",($nmpdr_id_text, $contig_refseq_text, $refseq_coords_text, $refseq_id_text, $evc_text, $gene_symbol_text, $desc_text, $dbxref_text, $kegg_text, $subsystem_text, $nmpdr_link_text, $structured_eng_text, $seq_text)), "\n";
55                #print join("\t",($peg,$refseq,$seq,'',$fixed_func,$ecs,$structured_english,'','')),"\n";
56          }          }
57      }      }
     if ($curr)  
     {  
         $curr =~ s/^\s+//;  
         push(@lines,$curr) ;  
     }  
   
     my $encoded = $cgi->escape(join("\n",@lines) . "\n");  
 #    print &Dumper($pieces,$encoded);  
     return $encoded;  
58  }  }
59    
 sub split_piece {  
     my($piece,$n) = @_;  
   
     my $i;  
     for ($i = $n; ($i > 0) && (substr($piece,$i,1) ne " "); $i--) {}  
     if ($i)  
     {  
         return (substr($piece,0,$i+1),substr($piece,$i+1));  
     }  
     else  
     {  
         return ($piece,"");  
     }  
 }  
   
   
 sub add_clustering_and_dup {  
     my($pieces,$by_sub_entry,$sub) = @_;  
   
     if ($by_sub_entry)  
     {  
         if ($by_sub_entry->{isu} || $by_sub_entry->{icw})  
         {  
             my $fixed_sub = &fix_sub_name($sub);  
             push(@$pieces,"In $fixed_sub, " . &isu_and_icw($by_sub_entry->{isu},$by_sub_entry->{icw}));  
         }  
     }  
 }  
   
 sub isu_and_icw {  
     my($isu,$icw) = @_;  
   
     if ($isu && $icw) { return "it appears to play a functional role that we have not associated with any other gene, and it occurs in close proximity on the chromosome with " . (($icw == 1) ? "another gene from the subsystem." : "$icw other genes from the subsystem.") }  
     if ($isu)         { return "it appears to play a functional role that we have not associated with any other gene." }  
     if ($icw)         { "It occurs in close proximity on the chromosome with " . (($icw == 1) ? "another gene from the subsystem." : "$icw other genes from the subsystem.") }  
 }  
   
 sub add_func_assertion {  
     my($pieces,$func) = @_;  
   
     push(@$pieces,"We currently believe that the function of the encoded protein is \"$funcSeed\".");  
     return;  
 }  
   
 sub add_in_subs {  
     my($pieces,$insubs) = @_;  
   
     if (@$insubs > 0)  
     {  
         my $n = @$insubs;  
         if ($n > 0)  
         {  
             my $in_sub_state = "The protein occurs in " .  
                                (($n == 1) ? "1 subsystem" : "$n subsystems") . ': ' . &subs($insubs) . ".";  
             push(@$pieces,$in_sub_state);  
         }  
     }  
 }  
   
 sub subs {  
     my($subs) = @_;  
   
     if (@$subs == 1) { return &fix_sub_name($subs->[0]) }  
     my @subL = map { &fix_sub_name($_) } @$subs;  
     $subL[$#subL] = "and $subL[$#subL]";  
     return join(", ",@subL);  
 }  
   
 sub fix_sub_name {  
     my($x) = @_;  
   
     $x =~ s/_/ /g;  
     return "\"$x\"";  
 }  
   
 sub evidence_codes {  
     my($fig,$peg) = @_;  
   
     if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }  
   
     my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);  
     return map { $_->[2] } @codes;  
 }  
60    
61    
62  sub fix_func {  sub fix_func {

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3