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

Diff of /FigKernelPackages/FIGO.pm

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

revision 1.12, Tue Feb 27 08:31:50 2007 UTC revision 1.19, Mon Mar 19 19:49:25 2007 UTC
# Line 49  Line 49 
49  or other more complex relationships that do not naturally fit into any heirarchy ---  or other more complex relationships that do not naturally fit into any heirarchy ---
50  which would get us into the whole quagmire of "multiple inheritance."  which would get us into the whole quagmire of "multiple inheritance."
51    
52  We have chosen to sidestep the entire issue of inheritance via an I<ad hoc> mechanism:  We have chosen to in many cases sidestep the entire issue of inheritance
53    via an I<ad hoc> mechanism:
54  If a "child" object needs access to its "ancestors'" methods,  If a "child" object needs access to its "ancestors'" methods,
55  we pass it references to its "ancestors" using subroutine arguments.  we pass it references to its "ancestors" using subroutine arguments.
56  This is admittedly ugly, clumsy, and potentially error-prone ---  This is admittedly ugly, clumsy, and potentially error-prone ---
# Line 311  Line 312 
312      }      }
313  }  }
314    
315    =head3 figfam
316    
317    =over 4
318    
319    =item USAGE:
320    
321    C<< my $fam = $figO->figfam($family_id); >>
322    
323    =item $family_id;
324    
325        A FigFam ID
326    
327    =item RETURNS:
328    
329          $fam:  A FIGfam Object.
330    
331    =back
332    
333    =cut
334    
335    sub figfam {
336        my($self,$fam_id) = @_;
337    
338        return &FigFamO::new('FigFamO',$self,$fam_id);
339    }
340    
341    
342  ########################################################################  ########################################################################
343  package GenomeO;  package GenomeO;
# Line 321  Line 348 
348    
349  =cut  =cut
350    
351    
352  =head3 new  =head3 new
353    
354  Constructor of GenomeO objects.  Constructor of GenomeO objects.
# Line 663  Line 691 
691      return map { new FeatureO($figO,$_) } @$features;      return map { new FeatureO($figO,$_) } @$features;
692  }  }
693    
694    
695    
696  ########################################################################  ########################################################################
697  package FeatureO;  package FeatureO;
698  ########################################################################  ########################################################################
# Line 674  Line 704 
704    
705  =cut  =cut
706    
707    
708  =head3 new  =head3 new
709    
710  Constructor of "FeatureO" objects  Constructor of "FeatureO" objects
711    
712    =over 4
713    
714    =item USAGE:
715    
716    C<< my $feature = FeatureO->new( $figO, $fid ); >>
717    
718    =item C<$figO>:
719    
720    "Base" FIGO object.
721    
722    =item C<$fid>:
723    
724    Feature-ID for new feature
725    
726    =item RETURNS:
727    
728    A newly created "FeatureO" object.
729    
730    =back
731    
732  =cut  =cut
733    
734  sub new {  sub new {
# Line 691  Line 742 
742  }  }
743    
744    
745    
746  =head3 id  =head3 id
747    
748    =over 4
749    
750    =item USAGE:
751    
752    C<< my $fid = $feature->id(); >>
753    
754    =item RETURNS:
755    
756    The FID (Feature ID) of a "FeatureO" object.
757    
758    =back
759    
760  =cut  =cut
761    
762  sub id {  sub id {
# Line 705  Line 769 
769    
770  =head3 genome  =head3 genome
771    
772    =over 4
773    
774    =item USAGE:
775    
776    C<< my $taxid = $feature->genome(); >>
777    
778    =item RETURNS:
779    
780    The TAxon-ID for the "GenomeO" object containg the feature.
781    
782    =back
783    
784  =cut  =cut
785    
786  sub genome {  sub genome {
# Line 718  Line 794 
794    
795  =head3 type  =head3 type
796    
797    =over 4
798    
799    =item USAGE:
800    
801    C<< my $feature_type = $feature->type(); >>
802    
803    =item RETURNS:
804    
805    The feature object's "type" (e.g., "peg," "rna," etc.)
806    
807    =back
808    
809  =cut  =cut
810    
811  sub type {  sub type {
# Line 729  Line 817 
817    
818    
819    
   
820  =head3 location  =head3 location
821    
822    =over 4
823    
824    =item USAGE:
825    
826    C<< my $loc = $feature->location(); >>
827    
828    =item RETURNS:
829    
830    A string representing the feature object's location on the genome's DNA,
831    in SEED "tbl format" (i.e., "contig_beging_end").
832    
833    =back
834    
835  =cut  =cut
836    
837  sub location {  sub location {
# Line 741  Line 841 
841      return scalar $fig->feature_location($self->id);      return scalar $fig->feature_location($self->id);
842  }  }
843    
844    
845    =head3 contig
846    
847    =over 4
848    
849    =item USAGE:
850    
851    C<< my $contig = $feature->contig(); >>
852    
853    =item RETURNS:
854    
855    A "ContigO" object to access the contig data
856    for the contig the feature is on.
857    
858    =back
859    
860    =cut
861    
862  sub contig {  sub contig {
863      my($self) = @_;      my($self) = @_;
864    
# Line 750  Line 868 
868      return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;      return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;
869  }  }
870    
871    
872    
873    =head3 begin
874    
875    =over 4
876    
877    =item USAGE:
878    
879    C<< my $beg = $feature->begin(); >>
880    
881    =item RETURNS:
882    
883    The numerical coordinate of the first base of the feature.
884    
885    =back
886    
887    =cut
888    
889  sub begin {  sub begin {
890      my($self) = @_;      my($self) = @_;
891    
# Line 757  Line 893 
893      return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;      return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
894  }  }
895    
896    
897    
898    =head3 end
899    
900    =over 4
901    
902    =item USAGE:
903    
904    C<< my $end = $feature->end(); >>
905    
906    =item RETURNS:
907    
908    The numerical coordinate of the last base of the feature.
909    
910    =back
911    
912    =cut
913    
914  sub end {  sub end {
915      my($self) = @_;      my($self) = @_;
916    
# Line 764  Line 918 
918      return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;      return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
919  }  }
920    
921    
922    
923  =head3 dna_seq  =head3 dna_seq
924    
925    =over 4
926    
927    =item USAGE:
928    
929    C<< my $dna_seq = $feature->dna_seq(); >>
930    
931    =item RETURNS:
932    
933    A string contining the DNA subsequence of the contig
934    running from the first to the last base of the feature.
935    
936    If ($beg > $end), the reverse complement subsequence is returned.
937    
938    =back
939    
940  =cut  =cut
941    
942  sub dna_seq {  sub dna_seq {
# Line 781  Line 952 
952    
953  =head3 prot_seq  =head3 prot_seq
954    
955    =over 4
956    
957    =item USAGE:
958    
959    C<< my $dna_seq = $feature->prot_seq(); >>
960    
961    =item RETURNS:
962    
963    A string contining the protein translation of the feature (if it exists),
964    or the "undef" value if the feature does not exist or is not a PEG.
965    
966    =back
967    
968  =cut  =cut
969    
970  sub prot_seq {  sub prot_seq {
# Line 796  Line 980 
980    
981  =head3 function_of  =head3 function_of
982    
983    =over 4
984    
985    =item USAGE:
986    
987    C<< my $func = $feature->function_of(); >>
988    
989    =item RETURNS:
990    
991    A string containing the function assigned to the feature,
992    or the "undef" value if no function has been assigned.
993    
994    =back
995    
996  =cut  =cut
997    
998  sub function_of {  sub function_of {
# Line 810  Line 1007 
1007    
1008  =head3 coupled_to  =head3 coupled_to
1009    
1010    =over 4
1011    
1012    =item USAGE:
1013    
1014    C<< my @coupled_features = $feature->coupled_to(); >>
1015    
1016    =item RETURNS:
1017    
1018    A list of L<CouplingO> objects describing the evidence for functional coupling
1019    between this feature and other nearby features.
1020    
1021    =back
1022    
1023  =cut  =cut
1024    
1025  sub coupled_to {  sub coupled_to {
1026      my($self) = @_;      my($self) = @_;
1027    
1028      ($self->type eq "peg") || return undef;      ($self->type eq "peg") || return ();
1029      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1030      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1031      my $peg1 = $self->id;      my $peg1 = $self->id;
# Line 832  Line 1042 
1042    
1043  =head3 annotations  =head3 annotations
1044    
1045    =over 4
1046    
1047    =item USAGE:
1048    
1049    C<< my @annot_list = $feature->annotations(); >>
1050    
1051    =item RETURNS:
1052    
1053    A list of L<AnnotationO> objects allowing access to the annotations for this feature.
1054    
1055    =back
1056    
1057  =cut  =cut
1058    
1059  sub annotations {  sub annotations {
# Line 843  Line 1065 
1065      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
1066  }  }
1067    
1068    
1069    =head3 in_subsystems
1070    
1071    =over 4
1072    
1073    =item USAGE:
1074    
1075    C<< my @subsys_list = $feature->in_subsystems(); >>
1076    
1077    =item RETURNS:
1078    
1079    A list of L<SubsystemO> objects allowing access to the subsystems
1080    that this feature particupates in.
1081    
1082    =back
1083    
1084    =cut
1085    
1086  sub in_subsystems {  sub in_subsystems {
1087      my($self) = @_;      my($self) = @_;
1088      my $figO = $self->{_figO};      my $figO = $self->{_figO};
# Line 854  Line 1094 
1094    
1095  =head3 possibly_truncated  =head3 possibly_truncated
1096    
1097    =over 4
1098    
1099    =item USAGE:
1100    
1101    C<< my $trunc = $feature->possibly_truncated(); >>
1102    
1103    =item RETURNS:
1104    
1105    Boolean C<TRUE> if the feature may be truncated;
1106    boolean C<FALSE> otherwise.
1107    
1108    =back
1109    
1110  =cut  =cut
1111    
1112  sub possibly_truncated {  sub possibly_truncated {
# Line 868  Line 1121 
1121    
1122  =head3 possible_frameshift  =head3 possible_frameshift
1123    
1124    =over 4
1125    
1126    =item USAGE:
1127    
1128    C<< my $fs = $feature->possible_frameshift(); >>
1129    
1130    =item RETURNS:
1131    
1132    Boolean C<TRUE> if the feature may be a frameshifted fragment;
1133    boolean C<FALSE> otherwise.
1134    
1135    (NOTE: This is a crude prototype implementation,
1136    and is mostly as an example of how to code using FIGO.)
1137    
1138    =back
1139    
1140  =cut  =cut
1141    
1142  sub possible_frameshift {  sub possible_frameshift {
# Line 919  Line 1188 
1188                                       @{$db_seq_out->[6]};                                       @{$db_seq_out->[6]};
1189                      my @prot = map { [$_->[0],$_->[1]] } @hsps;                      my @prot = map { [$_->[0],$_->[1]] } @hsps;
1190                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;
1191                      if (&covers(\@prot,length($prot),3) && &covers(\@dna,3*length($prot),9))                      if (&covers(\@prot,length($prot),3,0) && &covers(\@dna,3*length($prot),9,1))
1192                      {                      {
1193                          return 1;                          return 1;
1194                      }                      }
# Line 934  Line 1203 
1203    
1204  =head3 run  =head3 run
1205    
1206  =sub  (Note: This function should be considered "PRIVATE")
1207    
1208    =over 4
1209    
1210  cut run {  =item FUNCTION:
1211    
1212    Passes a string containing a command to be execture by the "system" shell command.
1213    
1214    =item USAGE:
1215    
1216    C<< $feature->run($cmd); >>
1217    
1218    =item RETURNS:
1219    
1220    Nil if the execution of C<$cmd> was successful;
1221    aborts with traceback if C<$cmd> fails.
1222    
1223    =back
1224    
1225    =cut
1226    
1227    sub run {
1228      my($cmd) = @_;      my($cmd) = @_;
1229      (system($cmd) == 0) || Confess("FAILED: $cmd");      (system($cmd) == 0) || Confess("FAILED: $cmd");
1230  }  }
# Line 945  Line 1233 
1233    
1234  =head3 max  =head3 max
1235    
1236    (Note: This function should be considered "PRIVATE")
1237    
1238    =over 4
1239    
1240    =item USAGE:
1241    
1242    C<< my $max = $feature->max($x, $y); >>
1243    
1244    =item C<$x>
1245    
1246    Numerical value.
1247    
1248    =item C<$y>
1249    
1250    Numerical value.
1251    
1252    =items RETURNS:
1253    
1254    The larger of the two numerical values C<$x> and C<$y>.
1255    
1256    =back
1257    
1258  =cut  =cut
1259    
1260  sub max {  sub max {
# Line 956  Line 1266 
1266    
1267  =head3 min  =head3 min
1268    
1269    (Note: This function should be considered "PRIVATE")
1270    
1271    =over 4
1272    
1273    =item USAGE:
1274    
1275    C<< my $min = $feature->min($x, $y); >>
1276    
1277    =item C<$x>
1278    
1279    Numerical value.
1280    
1281    =item C<$y>
1282    
1283    Numerical value.
1284    
1285    =item RETURNS:
1286    
1287    The smaller of the two numerical values C<$x> and C<$y>.
1288    
1289    =back
1290    
1291  =cut  =cut
1292    
1293  sub min {  sub min {
# Line 967  Line 1299 
1299    
1300  =head3 covers  =head3 covers
1301    
1302    (Question: Should this function be considered "PRIVATE" ???)
1303    
1304    USAGE:
1305        C<< if (&covers(\@hits, $len, $diff, $must_shift)) { #...Do stuff } >>
1306    
1307    Returns boolean C<TRUE> if a set of BLAST HSPs "cover" more than 90%
1308    of the database sequence(?).
1309    
1310  =cut  =cut
1311    
1312  sub covers {  sub covers {
1313      my($hsps,$ln,$diff) = @_;      my($hsps,$ln,$diff,$must_shift) = @_;
1314    
1315      my $hsp1 = shift @$hsps;      my $hsp1 = shift @$hsps;
1316      my $hsp2;      my $hsp2;
1317      while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}      my $merged = 0;
1318      return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));      while ($hsp1 && ($hsp2 = shift @$hsps) &&
1319               ($must_shift ? &diff_frames($hsp1,$hsp2) : 1) &&
1320               ($hsp1 = &merge($hsp1,$hsp2,$diff))) { $merged = 1 }
1321        return ($merged && $hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
1322    }
1323    
1324    sub diff_frames {
1325        my($hsp1,$hsp2) = @_;
1326        return (($hsp1->[0] % 3) != ($hsp2->[0] % 3));
1327  }  }
1328    
1329    
1330    
1331  =head3 merge  =head3 merge
1332    
1333    Merge two HSPs unless their overlap or separation is too large.
1334    
1335    RETURNS: Merged boundaries if merger succeeds, and C<undef> if merger fails.
1336    
1337  =cut  =cut
1338    
1339  sub merge {  sub merge {
# Line 996  Line 1348 
1348    
1349  =head3 sims  =head3 sims
1350    
1351    =over 4
1352    
1353    =item FUNCTION:
1354    
1355    Returns precomputed "Sim.pm" objects from the SEED.
1356    
1357    =item USAGE:
1358    
1359    C<< my @sims = $pegO->sims( -all, -cutoff => 1.0e-10); >>
1360    
1361    C<< my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10); >>
1362    
1363    =item RETURNS: List of sim objects.
1364    
1365    =back
1366    
1367  =cut  =cut
1368    
1369  use Sim;  use Sim;
# Line 1016  Line 1384 
1384    
1385  =head3 bbhs  =head3 bbhs
1386    
1387    =over 4
1388    
1389    =item FUNCTION:
1390    
1391    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1392    corresponding to the pre-computed BBHs for that PEG.
1393    
1394    =item USAGE:
1395    
1396    C<< my @bbhs = $pegO->bbhs(); >>
1397    
1398    =item List of BBHO objects.
1399    
1400    =back
1401    
1402  =cut  =cut
1403    
1404  sub bbhs {  sub bbhs {
# Line 1035  Line 1418 
1418    
1419  =head3 display  =head3 display
1420    
1421    Prints info about a "FeatureO" object to STDOUT.
1422    
1423    USAGE:
1424    
1425    C<< $pegO->display(); >>
1426    
1427  =cut  =cut
1428    
1429  sub display {  sub display {
# Line 1053  Line 1442 
1442    
1443  =head1 BBHO  =head1 BBHO
1444    
1445    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1446    
1447  =cut  =cut
1448    
1449    
1450  =head3 new  =head3 new
1451    
1452    Constructor of BBHO objects.
1453    
1454    (NOTE: The "average user" should never need to invoke this method.)
1455    
1456  =cut  =cut
1457    
1458  sub new {  sub new {
# Line 1073  Line 1468 
1468  }  }
1469    
1470    
1471    
1472  =head3 peg1  =head3 peg1
1473    
1474    =over 4
1475    
1476    =item USAGE:
1477    
1478    C<< my $peg1 = $bbh->peg1(); >>
1479    
1480    =item RETURNS:
1481    
1482    A "FeatureO" object corresponding to the "query" sequence
1483    in a BBH pair.
1484    
1485    =back
1486    
1487  =cut  =cut
1488    
1489  sub peg1 {  sub peg1 {
# Line 1086  Line 1495 
1495    
1496  =head3 peg2  =head3 peg2
1497    
1498    =over 4
1499    
1500    =item USAGE:
1501    
1502    C<< my $peg2 = $bbh->peg2(); >>
1503    
1504    =item RETURNS:
1505    
1506    A "FeatureO" object corresponding to the "database" sequence
1507    in a BBH pair.
1508    
1509    =back
1510    
1511  =cut  =cut
1512    
1513  sub peg2 {  sub peg2 {
# Line 1099  Line 1521 
1521    
1522  =head3 psc  =head3 psc
1523    
1524    =over 4
1525    
1526    =item USAGE:
1527    
1528    C<< my $psc = $bbh->psc(); >>
1529    
1530    =item RETURNS:
1531    
1532    The numerical value of the BLAST E-value for the pair.
1533    
1534    =back
1535    
1536  =cut  =cut
1537    
1538  sub psc {  sub psc {
# Line 1111  Line 1545 
1545    
1546  =head3 norm_bitscore  =head3 norm_bitscore
1547    
1548    
1549    =over 4
1550    
1551    =item USAGE:
1552    
1553    C<< my $bsc = $bbh->norm_bitscore(); >>
1554    
1555    =item RETURNS:
1556    
1557    The "BLAST bit-score per aligned character" for the pair.
1558    
1559    =back
1560    
1561  =cut  =cut
1562    
1563  sub norm_bitscore {  sub norm_bitscore {
# Line 1127  Line 1574 
1574    
1575  =head1 AnnotationO  =head1 AnnotationO
1576    
1577    Methods for accessing SEED annotations.
1578    
1579  =cut  =cut
1580    
1581    
# Line 1222  Line 1671 
1671  ########################################################################  ########################################################################
1672  use Data::Dumper;  use Data::Dumper;
1673    
1674    =head1 CouplingO
1675    
1676    Methods for accessing the "Functional coupling scores"
1677    of PEGs in close physical proximity to each other.
1678    
1679    =cut
1680    
1681    
1682    
1683  =head3 new  =head3 new
1684    
1685  =cut  =cut
# Line 1289  Line 1747 
1747      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1748      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1749      my @ev = ();      my @ev = ();
1750      foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))      foreach my $tuple ($fig->coupling_evidence($self->peg1->id,$self->peg2->id))
1751      {      {
1752          my($peg3,$peg4,$rep) = @$tuple;          my($peg3,$peg4,$rep) = @$tuple;
1753          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
# Line 1355  Line 1813 
1813    
1814  =head3 usable  =head3 usable
1815    
1816    
1817  =cut  =cut
1818    
1819  sub usable {  sub usable {
# Line 1553  Line 2012 
2012      my $famO = $self->{_famO};      my $famO = $self->{_famO};
2013      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2014    
2015      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2016  }  }
2017    
   
   
2018  =head3 rep_seqs  =head3 rep_seqs
2019    
2020  =cut  =cut

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.19

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3