[Bio] / FigKernelPackages / FIGMODELTable.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FIGMODELTable.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : chenry 1.1 # -*- perl -*-
2 :     ########################################################################
3 :     #
4 :     # Table object for the model database interaction module
5 :     # Initiating author: Christopher Henry
6 :     # Initiating author email: chrisshenry@gmail.com
7 :     # Initiating author affiliation: Mathematics and Computer Science Division, Argonne National Lab
8 :     # Date of module creation: 2/1/2008
9 :     ########################################################################
10 :    
11 :     use strict;
12 :     use FIGMODEL;
13 :    
14 :     package FIGMODELTable;
15 :    
16 :     =head1 Table object for the model database interaction module
17 :    
18 :     =head2 Public Methods
19 :    
20 :     =head3 new
21 :     Definition:
22 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
23 :     Description:
24 :     Creates an empty table object which may be filled using the add row function.
25 :     The $heading_list_ref and $filename are required, but all remaining arguments are optional.
26 :     Example:
27 :     my $TableObj = FIGMODELTable->new($heading_list_ref,$filename,$hash_heading_list_ref,$delimiter,$itemdelimiter,$prefix);
28 :     =cut
29 :    
30 :     sub new {
31 :     my ($ObjectType,$headings,$filename,$hash_headings,$delimiter,$itemdelimiter,$prefix) = @_;
32 :    
33 :     my $self;
34 :     if (!defined($filename) || !defined($headings)) {
35 :     print STDERR "FIGMODELTable:new: cannot create table without a list of headings and a filename\n";
36 :     return undef;
37 :     }
38 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
39 :     $self->{"file IO settings"}->{"orderedkeys"} = $headings;
40 :     #Dealing with optional arguments
41 :     if (defined($hash_headings)) {
42 :     for (my $i=0; $i < @{$hash_headings}; $i++) {
43 :     $self->{"hash columns"}->{$hash_headings->[$i]} = {};
44 :     }
45 :     }
46 :     if (!defined($delimiter)) {
47 :     $delimiter = ";";
48 :     }
49 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
50 :     if (!defined($itemdelimiter)) {
51 :     $itemdelimiter = "|";
52 :     }
53 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
54 :     if (!defined($prefix)) {
55 :     $prefix = "";
56 :     }
57 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
58 :    
59 :     return bless $self;
60 :     }
61 :    
62 :     =head2 TABLE Methods
63 :    
64 :     =head3 size
65 :     Definition:
66 :     my $tablesize = $TableObj->size();
67 :     Description:
68 :     This returns the number of rows in the table
69 :     Example:
70 :     my $tablesize = $TableObj->size();
71 :     =cut
72 :    
73 :     sub size {
74 :     my ($self) = @_;
75 :     my $TableSize = 0;
76 :     if (defined($self->{"array"})) {
77 :     $TableSize = @{$self->{"array"}};
78 :     }
79 :     return $TableSize;
80 :     }
81 :    
82 :     =head3 get_row
83 :     Definition:
84 :     my $RowObject = $TableObj->get_row($Row_index);
85 :     Description:
86 :     Returns a hash reference for the specified row in the table. Returns undef if the row does not exist.
87 :     Example:
88 :     my $RowObject = $TableObj->get_row(1);
89 :     =cut
90 :    
91 :     sub get_row {
92 :     my ($self,$RowNumber) = @_;
93 :     return $self->{"array"}->[$RowNumber];
94 :     }
95 :    
96 :     =head3 filename
97 :     Definition:
98 :     my $filename = $TableObj->filename();
99 :     Description:
100 :     Returns the filename for the table.
101 :     Example:
102 :     my $filename = $TableObj->filename();
103 :     =cut
104 :    
105 :     sub filename {
106 :     my ($self,$NewFilename) = @_;
107 :    
108 :     if (defined($NewFilename)) {
109 :     $self->{"file IO settings"}->{"filename"}->[0] = $NewFilename;
110 :     }
111 :    
112 :     return $self->{"file IO settings"}->{"filename"}->[0];
113 :     }
114 :    
115 :     =head3 delimiter
116 :     Definition:
117 :     my $delimiter = $TableObj->delimiter();
118 :     Description:
119 :     Returns the delimiter for the table.
120 :     Example:
121 :     my $delimiter = $TableObj->delimiter();
122 :     =cut
123 :    
124 :     sub delimiter {
125 :     my ($self,$NewDelimiter) = @_;
126 :    
127 :     if (defined($NewDelimiter)) {
128 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $NewDelimiter;
129 :     }
130 :    
131 :     return $self->{"file IO settings"}->{"delimiter"}->[0];
132 :     }
133 :    
134 :     =head3 item_delimiter
135 :     Definition:
136 :     my $item_delimiter = $TableObj->item_delimiter();
137 :     Description:
138 :     Returns the item delimiter for the table.
139 :     Example:
140 :     my $item_delimiter = $TableObj->item_delimiter();
141 :     =cut
142 :    
143 :     sub item_delimiter {
144 :     my ($self,$ItemDelimiter) = @_;
145 :    
146 :     if (defined($ItemDelimiter)) {
147 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $ItemDelimiter;
148 :     }
149 :    
150 :     return $self->{"file IO settings"}->{"item delimiter"}->[0];
151 :     }
152 :    
153 :     =head3 headings
154 :     Definition:
155 :     my @Headings = $TableObj->headings();
156 :     Description:
157 :     Returns an array containing the headings for the table.
158 :     Example:
159 :     my @Headings = $TableObj->headings();
160 :     =cut
161 :    
162 :     sub headings {
163 :     my ($self) = @_;
164 :     return @{$self->{"file IO settings"}->{"orderedkeys"}};
165 :     }
166 :    
167 :     =head3 get_table_hash_headings
168 :     Definition:
169 :     my @hash_headings = $TableObj->get_table_hash_headings();
170 :     Description:
171 :     Returns an array containing the headings that have also been added to the hash key for the table.
172 :     Example:
173 :     my @hash_headings = $TableObj->get_table_hash_headings();
174 :     =cut
175 :    
176 :     sub hash_headings {
177 :     my ($self) = @_;
178 :     return keys(%{$self->{"hash columns"}});
179 :     }
180 :    
181 :     =head3 get_row_by_key
182 :     Definition:
183 :     my $RowObject = $TableObj->get_row_by_key($Key);
184 :     Description:
185 :     Returns the row object for the firt row that matches the input key. Return undef if nothing matches the input key.
186 :     Example:
187 :     my $RowObject = $TableObj->get_row_by_key("rxn00001");
188 :     =cut
189 :    
190 :     sub get_row_by_key {
191 :     my ($self,$Key,$HashColumn) = @_;
192 :     if (defined($self->{"hash columns"}->{$HashColumn}->{$Key}->[0])) {
193 :     return $self->{"hash columns"}->{$HashColumn}->{$Key}->[0];
194 :     }
195 :     return undef;
196 :     }
197 :    
198 :     =head3 get_rows_by_key
199 :     Definition:
200 :     my @RowObjects = $TableObj->get_rows_by_key($Key);
201 :     Description:
202 :     Returns the list of row objects that match the input key. Returns an empty list if nothing matches the input key.
203 :     Example:
204 :     my @RowObjects = $TableObj->get_rows_by_key("rxn00001");
205 :     =cut
206 :    
207 :     sub get_rows_by_key {
208 :     my ($self,$Key,$HashColumn) = @_;
209 :     if (defined($self->{"hash columns"}->{$HashColumn}->{$Key})) {
210 :     return @{$self->{"hash columns"}->{$HashColumn}->{$Key}};
211 :     }
212 :     return ();
213 :     }
214 :    
215 :     =head3 get_hash_column_keys
216 :     Definition:
217 :     my @HashKeys = $TableObj->get_hash_column_keys($HashColumn);
218 :     Description:
219 :     Returns the list of the keys stored in the hash of the values in the column labeled $HashColumn.
220 :     Example:
221 :     my @HashKeys = $TableObj->get_hash_column_keys("Media");
222 :     =cut
223 :    
224 :     sub get_hash_column_keys {
225 :     my ($self,$HashColumn) = @_;
226 :     if (defined($self->{"hash columns"}->{$HashColumn})) {
227 :     return keys(%{$self->{"hash columns"}->{$HashColumn}});
228 :     }
229 :     return ();
230 :     }
231 :    
232 :     =head3 add_row
233 :     Definition:
234 :     $TableObj->add_row($row_object);
235 :     Description:
236 :     Adds a row to the table.
237 :     Example:
238 :     $TableObj->add_row({"COLUMN 1" => ["A"],"COLUMN 2" => ["B"]});
239 :     =cut
240 :    
241 :     sub add_row {
242 :     my ($self,$RowObject) = @_;
243 :     push(@{$self->{"array"}},$RowObject);
244 :     my @HashHeadings = $self->hash_headings();
245 :     foreach my $HashHeading (@HashHeadings) {
246 :     if (defined($RowObject->{$HashHeading})) {
247 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
248 :     push(@{$self->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
249 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$RowObject);
250 :     }
251 :     }
252 :     }
253 :     return ();
254 :     }
255 :    
256 :     =head3 add_data
257 :     Definition:
258 :     $TableObj->add_data($Row,"TEST",1,1);
259 :     Description:
260 :     Deletes a row from the table.
261 :     Example:
262 :     $TableObj->delete_row(1);
263 :     =cut
264 :    
265 :     sub add_data {
266 :     my ($self,$RowObject,$Heading,$Data,$Unique) = @_;
267 :    
268 :     #First checking that the input row exists
269 :     if (!defined($RowObject)) {
270 :     return 0;
271 :     }
272 :    
273 :     #Now checking if the heading exists in the row
274 :     if (defined($Unique) && $Unique == 1 && defined($RowObject->{$Heading})) {
275 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
276 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
277 :     return 0;
278 :     }
279 :     }
280 :     }
281 :    
282 :     #Adding the data
283 :     push(@{$RowObject->{$Heading}},$Data);
284 :     my @HashHeadings = $self->hash_headings();
285 :     foreach my $HashHeading (@HashHeadings) {
286 :     if ($HashHeading eq $Heading) {
287 :     push(@{$self->{$Data}},$RowObject);
288 :     push(@{$self->{"hash columns"}->{$HashHeading}->{$Data}},$RowObject);
289 :     last;
290 :     }
291 :     }
292 :     return 1;
293 :     }
294 :    
295 : chenry 1.2 =head3 remove_data
296 :     Definition:
297 :     $TableObj->remove_data($Row,"HEADING","TEST");
298 :     Description:
299 :     Deletes a element of data from the input row
300 :     Example:
301 :     $TableObj->remove_data(1);
302 :     =cut
303 :    
304 :     sub remove_data {
305 :     my ($self,$RowObject,$Heading,$Data) = @_;
306 :    
307 :     #First checking that the input row exists
308 :     if (!defined($RowObject)) {
309 :     return 0;
310 :     }
311 :    
312 :     #Now checking if the heading exists in the row
313 :     if (defined($RowObject->{$Heading})) {
314 :     for (my $i=0; $i < @{$RowObject->{$Heading}}; $i++) {
315 :     if ($RowObject->{$Heading}->[$i] eq $Data) {
316 :     splice(@{$RowObject->{$Heading}},$i,1);
317 :     $i--;
318 :     }
319 :     }
320 :     if (defined($self->{"hash columns"}->{$Heading}) && defined($self->{"hash columns"}->{$Heading}->{$Data})) {
321 :     if (@{$self->{"hash columns"}->{$Heading}->{$Data}} == 1) {
322 :     delete $self->{"hash columns"}->{$Heading}->{$Data};
323 :     } else {
324 :     for (my $j=0; $j < @{$self->{"hash columns"}->{$Heading}->{$Data}}; $j++) {
325 :     if ($self->{"hash columns"}->{$Heading}->{$Data}->[$j] eq $RowObject) {
326 :     splice(@{$self->{"hash columns"}->{$Heading}->{$Data}},$j,1);
327 :     $j--;
328 :     }
329 :     }
330 :     }
331 :     }
332 :     }
333 :    
334 :     return 1;
335 :     }
336 :    
337 : chenry 1.1 =head3 row_index
338 :     Definition:
339 :     $TableObj->row_index($Row);
340 :     Description:
341 :     Returns the index in the table where the input row is stored.
342 :     This only works if the input $Row object was pulled from the table using one of the get_row functions.
343 :     Returns undef if the row could not be found.
344 :     Example:
345 :     $TableObj->row_index($Row);
346 :     =cut
347 :    
348 :     sub row_index {
349 :     my ($self,$Row) = @_;
350 :    
351 :     for (my $i=0; $i < $self->size(); $i++) {
352 :     if ($self->get_row($i) == $Row) {
353 :     return $i;
354 :     }
355 :     }
356 :    
357 :     return undef;
358 :     }
359 :    
360 :     =head3 delete_row_by_key
361 :     Definition:
362 :     $TableObj->delete_row_by_key($Key,$Heading);
363 :     Description:
364 :     Deletes a row from the table based on the input key and heading that the key will be stored under.
365 :     Returns 1 if a row was found and deleted. Returns 0 if no row was found.
366 :     Example:
367 :     $TableObj->delete_row_by_key("Core83333.1","Model ID");
368 :     =cut
369 :    
370 :     sub delete_row_by_key {
371 :     my ($self,$Key,$Heading) = @_;
372 :    
373 :     my $Row = $self->get_row_by_key($Key,$Heading);
374 :     if (defined($Row)) {
375 :     $self->delete_row($self->row_index($Row));
376 :     return 1;
377 :     }
378 :     return 0;
379 :     }
380 :    
381 :     =head3 delete_row
382 :     Definition:
383 :     $TableObj->delete_row($i);
384 :     Description:
385 :     Deletes a row from the table.
386 :     Example:
387 :     $TableObj->delete_row(1);
388 :     =cut
389 :    
390 :     sub delete_row {
391 :     my ($self,$RowIndex) = @_;
392 :     my @HashHeadings = $self->hash_headings();
393 :     foreach my $HashHeading (@HashHeadings) {
394 :     my $RowObject = $self->get_row($RowIndex);
395 :     if (defined($RowObject->{$HashHeading})) {
396 :     for (my $i=0; $i < @{$RowObject->{$HashHeading}}; $i++) {
397 :     if (defined($self->{$RowObject->{$HashHeading}->[$i]})) {
398 :     for (my $j =0; $j < @{$self->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
399 :     if ($self->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
400 :     if ($j == 0 && @{$self->{$RowObject->{$HashHeading}->[$i]}} == 1) {
401 :     delete $self->{$RowObject->{$HashHeading}->[$i]};
402 :     last;
403 :     } else {
404 :     splice(@{$self->{$RowObject->{$HashHeading}->[$i]}},$j,1);
405 :     $j--;
406 :     }
407 :     }
408 :     }
409 :     }
410 :     if (defined($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]})) {
411 :     for (my $j =0; $j < @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}}; $j++) {
412 :     if ($self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}->[$j] eq $RowObject) {
413 :     if ($j == 0 && @{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}} == 1) {
414 :     delete $self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]};
415 :     last;
416 :     } else {
417 :     splice(@{$self->{"hash columns"}->{$HashHeading}->{$RowObject->{$HashHeading}->[$i]}},$j,1);
418 :     $j--;
419 :     }
420 :     }
421 :     }
422 :     }
423 :     }
424 :     }
425 :     }
426 :     splice(@{$self->{"array"}},$RowIndex,1);
427 :     }
428 :    
429 :     =head3 add_headings
430 :     Definition:
431 :     $TableObj->add_headings(@Headings);
432 :     Description:
433 :     Adds new headings to the table. This is needed to get the table to print the data under the new heading.
434 :     Example:
435 :     $TableObj->add_headings("Notes");
436 :     =cut
437 :    
438 :     sub add_headings {
439 :     my ($self,@Headings) = @_;
440 :    
441 :     foreach my $Heading (@Headings) {
442 :     #First check if the heading already exists
443 :     foreach my $ExistingHeading ($self->headings()) {
444 :     if ($Heading eq $ExistingHeading) {
445 :     $Heading = "";
446 :     last;
447 :     }
448 :     }
449 :     if ($Heading ne "") {
450 :     push(@{$self->{"file IO settings"}->{"orderedkeys"}},$Heading);
451 :     }
452 :     }
453 :     }
454 :    
455 :     =head3 save
456 :     Definition:
457 :     $TableObj->save($filename,$delimiter,$itemdelimiter,$prefix);
458 :     Description:
459 :     Saves the table to the specified filename with the specified column delimiter and subcolumn delimiter, and file prefix (lines that appear before the table heading in the file).
460 :     All arguments are optional. If arguments are not supplied, the values used to read the table from file will be used.
461 :     Example:
462 :     $TableObj->save("/vol/Table.txt",";","|","REACTIONS");
463 :     =cut
464 :    
465 :     sub save {
466 :     my ($self,$filename,$delimiter,$itemdelimiter,$prefix) = @_;
467 :     if (defined($filename)) {
468 :     $self->{"file IO settings"}->{"filename"}->[0] = $filename;
469 :     }
470 :     if (defined($delimiter)) {
471 :     $self->{"file IO settings"}->{"delimiter"}->[0] = $delimiter;
472 :     }
473 :     if (defined($itemdelimiter)) {
474 :     $self->{"file IO settings"}->{"item delimiter"}->[0] = $itemdelimiter;
475 :     }
476 :     if (defined($prefix)) {
477 :     $self->{"file IO settings"}->{"file prefix"}->[0] = $prefix;
478 :     }
479 :     FIGMODEL::SaveTable($self);
480 :     }
481 :    
482 :     =head3 load
483 :     Definition:
484 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
485 :     Description:
486 :    
487 :     Example:
488 :     my $Table = load_table($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns);
489 :     =cut
490 :    
491 :     sub load_table {
492 :     my ($Filename,$Delimiter,$ItemDelimiter,$HeadingLine,$HashColumns) = @_;
493 :    
494 :     #Checking that the table file exists
495 :     if (!-e $Filename) {
496 :     return undef;
497 :     }
498 :    
499 :     #Sanity checking input values
500 :     if (!defined($HeadingLine) || $HeadingLine eq "") {
501 :     $HeadingLine = 0;
502 :     }
503 :     if (!defined($Delimiter) || $Delimiter eq "") {
504 :     $Delimiter = ";";
505 :     }
506 :     if ($Delimiter eq "|") {
507 :     $Delimiter = "\\|";
508 :     }
509 :     if (!defined($ItemDelimiter) || $ItemDelimiter eq "") {
510 :     $ItemDelimiter = "";
511 :     } elsif ($ItemDelimiter eq "|") {
512 :     $ItemDelimiter = "\\|";
513 :     }
514 :    
515 :     #Loading the data table
516 :     my $Prefix;
517 :     my @Headings;
518 :     if (!open (TABLEINPUT, "<$Filename")) {
519 :     return undef;
520 :     }
521 :     my $Line = <TABLEINPUT>;
522 :     for (my $i=0; $i < $HeadingLine; $i++) {
523 :     $Prefix .= $Line;
524 :     $Line = <TABLEINPUT>;
525 :     }
526 :     chomp($Line);
527 :     @Headings = split(/$Delimiter/,$Line);
528 :     my $HeadingRef;
529 :     push(@{$HeadingRef},@Headings);
530 :     my $Table = new FIGMODELTable($HeadingRef,$Filename,$HashColumns,$Delimiter,$ItemDelimiter,$Prefix);
531 :    
532 :     while ($Line = <TABLEINPUT>) {
533 :     chomp($Line);
534 :     my @Data = split(/$Delimiter/,$Line);
535 :     my $ArrayRefHashRef;
536 :     for (my $i=0; $i < @Headings; $i++) {
537 :     if (defined($Data[$i]) && length($Data[$i]) > 0) {
538 :     if (defined($ItemDelimiter) && length($ItemDelimiter) > 0) {
539 :     my @TempArray = split(/$ItemDelimiter/,$Data[$i]);
540 :     foreach my $Item (@TempArray) {
541 :     push(@{$ArrayRefHashRef->{$Headings[$i]}},$Item);
542 :     }
543 :     } else {
544 :     $ArrayRefHashRef->{$Headings[$i]}->[0] = $Data[$i];
545 :     }
546 :     }
547 :     }
548 :     $Table->add_row($ArrayRefHashRef);
549 :     }
550 :     close(TABLEINPUT);
551 :    
552 :     return $Table;
553 :     }
554 :    
555 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3