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

Annotation of /FigKernelScripts/rep_genomes.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : overbeek 1.1
2 :     use FIG;
3 :     my $fig = new FIG;
4 :     use tree_utilities;
5 :    
6 :     ($size = shift @ARGV)
7 :     || die "usage: rep_genomes Size";
8 :    
9 :     my $tree = ['All','',[0],[]];
10 :    
11 :     foreach my $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
12 :     {
13 :     my $gs = $fig->genus_species($genome);
14 :     my $tax = $fig->taxonomy_of($genome);
15 :     my @tax = split(/;\s*/,$tax);
16 :     $tax[$#tax] = "$genome: " . $tax[$#tax];
17 :     &insert($tree,\@tax);
18 :     }
19 :    
20 :     my $leaves = &tree_utilities::tips_of_tree($tree);
21 :     my $sz_all = @$leaves;
22 :    
23 :     my $treeN = &representative_by_size($tree,$size);
24 :     my $leavesN = &tree_utilities::tips_of_tree($treeN);
25 :     foreach $_ (@$leavesN)
26 :     {
27 :     print "$_\n";
28 :     }
29 :    
30 :     sub insert {
31 :     my($tree,$taxP) = @_;
32 :     my($label,$ptrs,$i);
33 :    
34 :     if (@$taxP == 0)
35 :     {
36 :     return;
37 :     }
38 :     else
39 :     {
40 :     $label = shift @$taxP;
41 :     $ptrs = $tree->[2];
42 :     for ($i=1; ($i < @$ptrs) && ($ptrs->[$i]->[0] ne $label); $i++) {}
43 :     if ($i == @$ptrs)
44 :     {
45 :     push(@$ptrs,[$label,1,[$tree],[]]);
46 :     }
47 :     &insert($ptrs->[$i],$taxP);
48 :     return;
49 :     }
50 :     }
51 :    
52 :     sub representative_by_size {
53 :     # &representative_by_size($RootedTree,$N) -> \RepTree
54 :     my($treeP,$size) = @_;
55 :    
56 :     my($btree,@nodes,@sorted_nodes,%del,%keep,$tips);
57 :     my ($start,$to_remove,$i,$j,$nodeP,$cc);
58 :    
59 :     $tips = &tips_of_tree($treeP);
60 :     $start = $#{$tips} + 1;
61 :     $to_remove = $start - $size;
62 :     # print STDERR "we start with $start, so we need to pull $to_remove\n";
63 :     if (($to_remove <= 0) || ($size < 3))
64 :     {
65 :     return $treeP;
66 :     }
67 :    
68 :     $btree = &to_binary($treeP);
69 :     # &print_tree($btree);
70 :    
71 :     &tree_utilities::get_collapse_values($btree,\@nodes);
72 :     @sorted_nodes = sort by_distance @nodes;
73 :    
74 :     # print STDERR "nodes:\n";
75 :     # foreach $y (@nodes) { print STDERR " $y->[0] $y->[1]->[0]\n"; }
76 :     # print STDERR "sorted:\n";
77 :     # foreach $y (@sorted_nodes) { print STDERR " $y->[0] $y->[1]->[0]\n"; }
78 :    
79 :     for ($k=0; ($k <= $#sorted_nodes) && ($to_remove > 0); $k++,$to_remove--)
80 :     {
81 :     $nodeP = $sorted_nodes[$k]->[1];
82 :     $cc = &node_pointers($nodeP);
83 :     if ($cc->[1]->[1] <= $cc->[2]->[1])
84 :     {
85 :     $i = 1; $j = 2;
86 :     }
87 :     else
88 :     {
89 :     $i = 2; $j = 1;
90 :     }
91 :    
92 :     $del{$cc->[$j]->[0]} = 1;
93 :     # print STDERR "pulling at $nodeP->[0] ($sorted_nodes[$k]->[0]) $cc->[$j]->[0] $cc->[$i]->[0]\n";
94 :    
95 :     $nodeP->[0] = $cc->[$i]->[0];
96 :     $nodeP->[1] += $cc->[$i]->[1];
97 :     }
98 :    
99 :     foreach $x (@$tips)
100 :     {
101 :     if (! $del{$x})
102 :     {
103 :     $keep{$x} = 1;
104 :     # print STDERR "keeping $x\n";
105 :     }
106 :     }
107 :    
108 :     return &subtree($btree,\%keep);
109 :     }
110 :    
111 :     sub by_distance {
112 :     return ($a->[0] <=> $b->[0]);
113 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3