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

Annotation of /FigKernelScripts/svr_tips_of_tree.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : overbeek 1.1 ########################################################################
2 :     #! /usr/bin/perl -w
3 :     #
4 :     # svr_tips_of_tree -- Extracts the tips from a file containing trees
5 :     #
6 :    
7 :    
8 :     use strict;
9 :     use Data::Dumper;
10 :     use gjonewicklib;
11 :    
12 :    
13 :    
14 :     =head1 svr_tips_of_tree
15 :    
16 :     =head2 Introduction
17 :    
18 :     svr_tips_of_tree < tree(s) > tips
19 :    
20 :     Reads a file of one or more trees in Newick format and returns the tips.
21 :    
22 : overbeek 1.2 =head2 Command-Line Options
23 :    
24 :     =over 4
25 :    
26 :     =item -c=Table
27 :    
28 :     A correspondence table in which the first two columns contain pairs of IDs,
29 :     one of which must be a FIG ID.
30 :    
31 :     =back
32 :    
33 : overbeek 1.1 =head3 Output Format
34 :    
35 :     The generated HTML document is written to STDOUT.
36 :    
37 :     =cut
38 :    
39 : overbeek 1.2 use Getopt::Long;
40 :     my $corr;
41 :    
42 :     my $rc = GetOptions("-c=s",\$corr);
43 : overbeek 1.1
44 : overbeek 1.2 my %corrH;
45 :     if ($corr)
46 :     {
47 :     if (-s $corr)
48 :     {
49 :     open(CORR,"<$corr") || die "could not open $corr";
50 :     while ($_ = <CORR>)
51 :     {
52 :     if ($_ =~ /^(\S+)\s+(\S+)/)
53 :     {
54 :     my $id1 = $1;
55 :     my $id2 = $2;
56 :     if ($id1 =~ /^fig\|\d+\.\d+\.peg\.\d+/)
57 :     {
58 :     $corrH{$id2} = $id1;
59 :     }
60 :     elsif ($id2 =~ /^fig\|\d+\.\d+\.peg\.\d+/)
61 :     {
62 :     $corrH{$id1} = $id2;
63 :     }
64 :     }
65 :     else
66 :     {
67 :     print STDERR "Ignoring: $_";
68 :     }
69 :     }
70 :     close(CORR);
71 :     }
72 :     else
73 :     {
74 :     die "invalid correspondence table";
75 :     }
76 :     }
77 :     my @trees = &gjonewicklib::read_newick_trees;
78 : overbeek 1.1
79 :     my %tips = map{ $_ => 1 } map { &gjonewicklib::newick_tip_list($_) } @trees;
80 :    
81 :     foreach $_ (sort { lc $a cmp lc $b } keys(%tips))
82 :     {
83 : overbeek 1.2 my $tip = $corrH{$_} ? $corrH{$_} : $_;
84 :     print "$tip\n";
85 : overbeek 1.1 }
86 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3