[Bio] / WebApplication / WebComponent / GrowthData.pm Repository:
ViewVC logotype

Annotation of /WebApplication/WebComponent/GrowthData.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : devoid 1.1 package WebComponent::GrowthData;
2 :    
3 :     use strict;
4 :     use warnings;
5 :    
6 :     use base qw( WebComponent );
7 :    
8 :     use FIGMODEL;
9 :     use WebColors;
10 :    
11 :     1;
12 :    
13 :     =pod
14 :    
15 :     =head1 NAME
16 :    
17 :     Growth Data
18 :     =head1 DESCRIPTION
19 :    
20 :     Print growth information for intervals on different media conditions.
21 :    
22 :     =head1 METHODS
23 :    
24 :     =over 4
25 :    
26 :     =item * B<new> ()
27 :    
28 :     Called when the object is initialized. Expands SUPER::new.
29 :    
30 :     =cut
31 :    
32 :     sub new {
33 :    
34 :     my $self = shift->SUPER::new(@_);
35 :     return $self;
36 :     }
37 :    
38 :     =item * B<output> ()
39 :     Takes: $self, $ID - either an interval or a strain ID
40 :     Returns the html output of the ModelSelect component.
41 :    
42 :     =cut
43 :    
44 :     sub output {
45 :     my ($self, $ID) = @_;
46 :     my $MPAList = $self->getMediaPredictedActual($ID);
47 :     my $html = "";
48 :     $html .= "<table>";
49 :     foreach my $MPA (@{$MPAList}) {
50 :     my $Media = $MPA->{'MEDIA'};
51 :     my $Predicted = $MPA->{'PREDICTED'};
52 :     my $Actual = $MPA->{'ACTUAL'};
53 : chenry 1.2
54 : devoid 1.1 my $Acolor = $self->colorLookup($Actual);
55 :     my $Pcolor = $self->colorLookup($Predicted);
56 :     my $PrintPredicted;
57 :     my $PrintActual;
58 :    
59 : chenry 1.2 $html .= "<tr>";
60 : devoid 1.1 $html .= "<td>" . $Media . ":</td>";
61 :     # Format Predicted value as unknown or x.xx float string
62 :     if( $Predicted == -1 ) { $PrintPredicted = "Unknown";}
63 :     else { $PrintPredicted = sprintf("%1.2f", $Predicted); }
64 : chenry 1.2
65 : devoid 1.1 # Format Actual value as unknown ?.?? or x.xx float string
66 : chenry 1.2 if( $Actual == -1 ) { $PrintActual = "Unknown"; }
67 : devoid 1.1 else { $PrintActual = sprintf("%1.2f", $Actual); }
68 : chenry 1.2
69 : devoid 1.1 $html .= "<td style='color:" . $Acolor . "; font-weight: bold;'>" .
70 :     "<span title='Actual Growth'>" . $PrintActual . "</span></td>";
71 : chenry 1.2 $html .= "<td style='color:" . $Pcolor . "; font-weight: bold;'>" .
72 :     "<span title='Predicted Growth'>" . $PrintPredicted . "</span></td>";
73 : devoid 1.1 $html .= "</tr>";
74 :     }
75 : chenry 1.2 $html .= "</table>";
76 : devoid 1.1 return $html;
77 :     }
78 :    
79 :     sub colorLookup {
80 :     my ($self, $growth) = @_;
81 :     my $color = [127, 127, 127];
82 :     if ( $growth < 0 ) { $color = [127, 127, 127]; }
83 :     elsif( $growth > 0.5 ) {
84 :     $growth = 2 * ($growth - 0.5); # rescale
85 :     $color = [204 - ($growth * 204), 204, 51];
86 :     } elsif ( $growth < 0.5 ) {
87 :     $growth = 2 * $growth;
88 :     $color = [204, (204 * $growth), 51];
89 :     } else { $color = [204, 204, 51]; }
90 :     return $self->toHex($color);
91 :     # if ( $growth == -1 ) {$color = "grey"}
92 :     # elsif ( $growth <= 0.1 ) {$color = "red" }
93 :     # elsif ( $growth <= 0.4 ) {$color = "#FFA824" }
94 :     # elsif ( $growth < 0.8 ) {$color = "#AADD00" }
95 :     # elsif ( $growth >= 0.8 ) {$color = "#006400"}
96 :     }
97 :    
98 :     sub ColorType {
99 :     my ($self, $color, $type, $shift) = @_;
100 :     unless(defined($shift)) { $shift = 1; }
101 :     my $array = { blue => [ 61,72,139 ],
102 :     green => [ 27,133,52 ],
103 :     orange => [ 224,133,15 ],
104 :     purple => [ 160,15,250 ],
105 :     red => [ 204,0,52 ],
106 :     grey => [ 95,100,100 ]};
107 :    
108 :     my $colors = $array->{$color};
109 :     if($shift != 1) {
110 :     $colors = WebColors::rgb_to_hsl($colors);
111 :     $colors->[2] += $shift/100;
112 :     $colors = WebColors::hsl_to_rgb($colors);
113 :     }
114 :     if($type eq 'hex') { return $self->toHex($colors); }
115 :     else { return $colors; }
116 :     }
117 :    
118 :     sub toHex {
119 :     my ($self, $RGBarray) = @_;
120 :     my $hexstr = "#";
121 :     foreach my $value (@{$RGBarray}) {
122 :     $value = $value % 256; # scale to 8-bit values
123 :     $hexstr .= sprintf('%02x', $value);
124 :     }
125 :     return $hexstr;
126 :     }
127 :    
128 :     sub MPAColorType {
129 :     my ($self, $Predicted, $Actual) = @_;
130 : chenry 1.2 if($Actual >= 0.01) {
131 : devoid 1.1 # True Positive
132 :     if($Predicted >= 0.01) { return "blue"; }
133 :     # False Negative
134 :     elsif($Predicted <= 0.01) { return "green"; }
135 :     }
136 : chenry 1.2 elsif($Actual <= 0.01) {
137 : devoid 1.1 # False Positive
138 :     if($Predicted >= 0.01) { return "orange"; }
139 :     # True Negative
140 :     elsif($Predicted <= 0.01) { return "purple"; }
141 :     # None Found
142 :     } else { return "grey" }
143 :     }
144 :    
145 :     sub conflictCount {
146 :     my ($self, $ID) = @_;
147 : chenry 1.2 my $count = 0;
148 : devoid 1.1 my $model = $self->application()->data_handle('FIGMODEL');
149 : chenry 1.2 my $StrainTable = $model->database()->GetDBTable('STRAIN TABLE');
150 :     my $IntervalTable = $model->database()->GetDBTable('INTERVAL TABLE');
151 :     my $GrowthTable = $model->database()->GetDBTable('STRAIN SIMULATIONS');
152 : devoid 1.1 my $type;
153 : chenry 1.2 my $StrainOrIntervalRow;
154 : devoid 1.1 # Sainity Checking on ID
155 :     my $StrainRow = $StrainTable->get_row_by_key($ID, 'ID');
156 :     my $IntervalRow = $IntervalTable->get_row_by_key($ID, 'ID');
157 :     # There can only be ONE.
158 :     if(defined($StrainRow) && !defined($IntervalRow)) {
159 :     # Found a strain
160 :     $type = 'strain';
161 : chenry 1.2 $StrainOrIntervalRow = \%{$StrainRow};
162 : devoid 1.1 } elsif (!defined($StrainRow) && defined($IntervalRow)) {
163 :     # Found an interval
164 :     $type = 'interval';
165 : chenry 1.2 $StrainOrIntervalRow = \%{$IntervalRow};
166 : devoid 1.1 } else {
167 :     return " ";
168 :     }
169 : chenry 1.2
170 : devoid 1.1 # Get Growth Data, sorted by date
171 :     $GrowthTable->sort_rows('TIME');
172 :     my $GrowthRow = $GrowthTable->get_row_by_key($ID, 'ID');
173 :     unless(defined($GrowthRow)) {
174 :     return " ";
175 :     }
176 :     my $GrowthArray = $GrowthRow->{'MEDIA'};
177 :     for(my $i=0; $i < @{$GrowthArray}; $i++) {
178 :     my $Media = $GrowthRow->{'MEDIA'}->[$i];
179 :     my $Actual = undef;
180 :     my $Predicted = $GrowthRow->{'GROWTH'}->[$i];
181 : chenry 1.2
182 : devoid 1.1 my $growth_array = $StrainOrIntervalRow->{'GROWTH'};
183 :     foreach my $growth_str (@{$growth_array}) {
184 : chenry 1.2 my @data_array = split(':', $growth_str);
185 : devoid 1.1 if($data_array[0] eq $Media) {
186 :     $Actual = $data_array[1];
187 :     last;
188 :     }
189 :     }
190 :     unless(defined($Actual)) { next; }
191 :     if( $Actual > 0 && $Predicted == 0) {
192 :     $count += 1;
193 :     } elsif( $Actual == 0 && $Predicted > 0) {
194 :     $count += 1;
195 :     } else {
196 :     }
197 :     }
198 :     return $count;
199 : chenry 1.2 }
200 : devoid 1.1 sub treeNodeColor {
201 :     my ($self, $ID) = @_;
202 :     my $MPAList = $self->getMediaPredictedActual($ID);
203 :     my $color = "grey";
204 :     unless(defined($MPAList)) {
205 :     return $color;
206 :     }
207 :     foreach my $MPA (@{$MPAList}) {
208 :     my $Media = $MPA->{'MEDIA'};
209 :     my $Predicted = $MPA->{'PREDICTED'};
210 :     my $Actual = $MPA->{'ACTUAL'};
211 :     if($Media eq 'ArgonneLBMedia') {
212 :     $color = $self->MPAColorType($Predicted, $Actual);
213 :     $color = $self->ColorType($color, 'hex');
214 :     return $color;
215 : chenry 1.2 }
216 : devoid 1.1 }
217 :     return $color;
218 :     }
219 :    
220 :     sub intervalNodeColor {
221 :     my ($self, $ID) = @_;
222 :     my $MPAList = $self->getMediaPredictedActual($ID);
223 :     my $color = [ 95,100,100 ];
224 :     unless(defined($MPAList)) { return $color; }
225 :     foreach my $MPA (@{$MPAList}) {
226 :     my $Media = $MPA->{'MEDIA'};
227 :     my $Predicted = $MPA->{'PREDICTED'};
228 :     my $Actual = $MPA->{'ACTUAL'};
229 :     if($Media eq 'ArgonneLBMedia') {
230 :     $color = $self->MPAColorType($Predicted, $Actual);
231 :     $color = $self->ColorType($color, 'array');
232 :     return $color;
233 : chenry 1.2 }
234 : devoid 1.1 }
235 :     return $color;
236 :     }
237 :    
238 :     sub keyNodeColor {
239 :     my ($self) = @_;
240 :     my $html = "<table>";
241 :     my $colorBox = sub {
242 :     my ($color) = @_;
243 :     return "<div style='width: 10px; height: 10px; padding: 1px; background-color: $color'/>";
244 :     };
245 :     my @colors = ('blue', 'green', 'orange', 'purple', 'grey', 'red');
246 : chenry 1.2 my @descriptions = ('Correctly predicted growth', 'Failed to predict growth',
247 : devoid 1.1 'Failed to predict no growth', 'Correctly predicted no growth', 'No observations',
248 :     'Currently Selected Strain or Interval');
249 :     for(my $i=0; $i<@colors; $i++) {
250 :     my $hex = $self->ColorType($colors[$i], 'hex');
251 :     $html .= "<tr><td>".$hex->$colorBox."</td><td>".$descriptions[$i]."</td></tr>";
252 :     }
253 :     return $html . "</table>";
254 :     }
255 : chenry 1.2
256 : devoid 1.1 sub getMediaPredictedActual {
257 :     my ($self, $ID) = @_;
258 :     my @MediaPredictedActualList;
259 :     my $model = $self->application()->data_handle('FIGMODEL');
260 : chenry 1.2 my $StrainTable = $model->database()->GetDBTable('STRAIN TABLE');
261 :     my $IntervalTable = $model->database()->GetDBTable('INTERVAL TABLE');
262 :     my $GrowthTable = $model->database()->GetDBTable('STRAIN SIMULATIONS');
263 :    
264 : devoid 1.1 my $type;
265 : chenry 1.2 my $StrainOrIntervalRow;
266 : devoid 1.1 # Sainity Checking on ID
267 :     my $StrainRow = $StrainTable->get_row_by_key($ID, 'ID');
268 :     my $IntervalRow = $IntervalTable->get_row_by_key($ID, 'ID');
269 :     # There can only be ONE.
270 :     if(defined($StrainRow) && !defined($IntervalRow)) {
271 :     # Found a strain
272 :     $type = 'strain';
273 : chenry 1.2 $StrainOrIntervalRow = \%{$StrainRow};
274 : devoid 1.1 } elsif (!defined($StrainRow) && defined($IntervalRow)) {
275 :     # Found an interval
276 :     $type = 'interval';
277 : chenry 1.2 $StrainOrIntervalRow = \%{$IntervalRow};
278 : devoid 1.1 } else { return undef; } # Could not find $ID, fail.
279 :    
280 :     # Get Growth Data, sorted by date
281 :     $GrowthTable->sort_rows('TIME');
282 :     my $GrowthRow = $GrowthTable->get_row_by_key($ID, 'ID');
283 :     unless(defined($GrowthRow)) {
284 :     return undef;
285 :     }
286 :     my @GrowthNames = ('Unknown', 'No Growth', 'Very Slow', 'Slow', 'Normal', 'Fast');
287 :     my $GrowthArray = $GrowthRow->{'MEDIA'};
288 :     for(my $i=0; $i < @{$GrowthArray}; $i++) {
289 :     my $Media = $GrowthRow->{'MEDIA'}->[$i];
290 :     my $Predicted = $GrowthRow->{'GROWTH'}->[$i];
291 : chenry 1.2
292 : devoid 1.1 my $Actual = undef;
293 :     my $growth_array = $StrainOrIntervalRow->{'GROWTH'};
294 :     foreach my $growth_str (@{$growth_array}) {
295 : chenry 1.2 my @data_array = split(':', $growth_str);
296 : devoid 1.1 if($data_array[0] eq $Media) {
297 :     $Actual = $data_array[1];
298 :     last;
299 :     }
300 :     }
301 :     unless(defined($Actual)) { $Actual = -1; }
302 : chenry 1.2 push(@MediaPredictedActualList, {'MEDIA' => $Media, 'PREDICTED' => $Predicted, 'ACTUAL' => $Actual});
303 : devoid 1.1 }
304 :     return \@MediaPredictedActualList;
305 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3