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

Annotation of /FigKernelScripts/add_structured_english.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : disz 1.1 use CGI;
2 :     my $cgi = new CGI;
3 :     use FIG;
4 :    
5 :     my $fig = new FIG;
6 :    
7 :     while (defined($_ = <STDIN>))
8 :     {
9 :     chop;
10 :     ($peg,$refseq,$seq,undef,$fixed_func,$ecs,undef,undef,undef) = split(/\t/,$_);
11 :     $funcSeed = $fig->function_of($peg,undef,1);
12 :     my($func1,$ecs1) = &fix_func($funcSeed);
13 :     if (($func1 ne $fixed_func) || ($ecs1 ne $ecs))
14 :     {
15 :     print STDERR &Dumper($fixed_func,$func1,$ecs,$ecs1);
16 :     print STDERR "$_\n";
17 :     }
18 :     else
19 :     {
20 :     my $structured_english = &to_structured_english($fig,$peg);
21 :     my $text = $cgi->unescape($structured_english);
22 :     if ($structured_english)
23 :     {
24 :     print join("\t",($peg,$refseq,$seq,'',$fixed_func,$ecs,$structured_english,'','')),"\n";
25 :     }
26 :     }
27 :     }
28 :    
29 :     sub to_structured_english {
30 :     my($fig,$peg) = @_;
31 :    
32 :     my @ev_codes = &evidence_codes($fig,$peg);
33 :     my $by_sub = {};
34 :     foreach my $code (@ev_codes)
35 :     {
36 :     if ($code =~ /^isu;(\S.*\S)/) { $by_sub->{$1}->{'isu'} = 1 }
37 :     if ($code =~ /^icw\((\d+)\);(\S.*\S)/) { $by_sub->{$2}->{'icw'} = $1 }
38 :     }
39 :    
40 :     my @insubs = grep { $fig->usable_subsystem($_,1) } $fig->peg_to_subsystems($peg,1);
41 :     my %subs = map { $_ => 1 } @insubs;
42 :     $funcSeed = $fig->function_of($peg,undef,1);
43 :     if (@insubs < 1) { return "" }
44 :    
45 :     my $pieces = [];
46 :     &add_func_assertion($pieces,$funcSeed);
47 :     &add_in_subs($pieces,\@insubs);
48 :     foreach my $sub (@insubs)
49 :     {
50 :     &add_clustering_and_dup($pieces,$by_sub->{$sub},$sub);
51 :     }
52 :     return &render($pieces);
53 :     }
54 :    
55 :     sub render {
56 :     my($pieces) = @_;
57 :    
58 :     my @lines = ();
59 :     my $curr = "";
60 :     foreach my $piece (@$pieces)
61 :     {
62 :     $piece = "$piece ";
63 :     $curr = $curr . $piece;
64 :    
65 :     while (length($curr) > 100)
66 :     {
67 :     my($p1,$p2) = &split_piece($curr,100);
68 :     $p1 =~ s/^\s+//;
69 :     push(@lines, $p1);
70 :     $curr = $p2;
71 :     }
72 :     }
73 :     if ($curr)
74 :     {
75 :     $curr =~ s/^\s+//;
76 :     push(@lines,$curr) ;
77 :     }
78 :    
79 :     my $encoded = $cgi->escape(join("\n",@lines) . "\n");
80 :     # print &Dumper($pieces,$encoded);
81 :     return $encoded;
82 :     }
83 :    
84 :     sub split_piece {
85 :     my($piece,$n) = @_;
86 :    
87 :     my $i;
88 :     for ($i = $n; ($i > 0) && (substr($piece,$i,1) ne " "); $i--) {}
89 :     if ($i)
90 :     {
91 :     return (substr($piece,0,$i+1),substr($piece,$i+1));
92 :     }
93 :     else
94 :     {
95 :     return ($piece,"");
96 :     }
97 :     }
98 :    
99 :    
100 :     sub add_clustering_and_dup {
101 :     my($pieces,$by_sub_entry,$sub) = @_;
102 :    
103 :     if ($by_sub_entry)
104 :     {
105 :     if ($by_sub_entry->{isu} || $by_sub_entry->{icw})
106 :     {
107 :     my $fixed_sub = &fix_sub_name($sub);
108 :     push(@$pieces,"In $fixed_sub, " . &isu_and_icw($by_sub_entry->{isu},$by_sub_entry->{icw}));
109 :     }
110 :     }
111 :     }
112 :    
113 :     sub isu_and_icw {
114 :     my($isu,$icw) = @_;
115 :    
116 :     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.") }
117 :     if ($isu) { return "it appears to play a functional role that we have not associated with any other gene." }
118 :     if ($icw) { "It occurs in close proximity on the chromosome with " . (($icw == 1) ? "another gene from the subsystem." : "$icw other genes from the subsystem.") }
119 :     }
120 :    
121 :     sub add_func_assertion {
122 :     my($pieces,$func) = @_;
123 :    
124 :     push(@$pieces,"We currently believe that the function of the encoded protein is \"$funcSeed\".");
125 :     return;
126 :     }
127 :    
128 :     sub add_in_subs {
129 :     my($pieces,$insubs) = @_;
130 :    
131 :     if (@$insubs > 0)
132 :     {
133 :     my $n = @$insubs;
134 :     if ($n > 0)
135 :     {
136 :     my $in_sub_state = "The protein occurs in " .
137 :     (($n == 1) ? "1 subsystem" : "$n subsystems") . ': ' . &subs($insubs) . ".";
138 :     push(@$pieces,$in_sub_state);
139 :     }
140 :     }
141 :     }
142 :    
143 :     sub subs {
144 :     my($subs) = @_;
145 :    
146 :     if (@$subs == 1) { return &fix_sub_name($subs->[0]) }
147 :     my @subL = map { &fix_sub_name($_) } @$subs;
148 :     $subL[$#subL] = "and $subL[$#subL]";
149 :     return join(", ",@subL);
150 :     }
151 :    
152 :     sub fix_sub_name {
153 :     my($x) = @_;
154 :    
155 :     $x =~ s/_/ /g;
156 :     return "\"$x\"";
157 :     }
158 :    
159 :     sub evidence_codes {
160 :     my($fig,$peg) = @_;
161 :    
162 :     if ($peg !~ /^fig\|\d+\.\d+\.peg\.\d+$/) { return "" }
163 :    
164 :     my @codes = grep { $_->[1] =~ /^evidence_code/i } $fig->get_attributes($peg);
165 :     return map { $_->[2] } @codes;
166 :     }
167 :    
168 :    
169 :     sub fix_func {
170 :     my($func) = @_;
171 :     my($ecs);
172 :    
173 :     $ecs = {};
174 :     while ($func =~ /^(.*\S)\s*\(EC ([^\)]+)\)(.*)$/)
175 :     {
176 :     $ecs->{$2} = 1;
177 :     $func = $3 ? $1 . $3 : $1;
178 :     }
179 :     $func =~ s/\s+\@\s+/ AND /g;
180 :     $func =~ s/;\s+/ AND\/OR /g;
181 :     return ($func,join(";",sort keys(%$ecs)));
182 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3