source: branches/stable/PERL_SCRIPTS/BIOPERL/beautifyNewick.pl

Last change on this file was 6141, checked in by westram, 11 years ago
  • spellchecked all (phew)
  • Property svn:executable set to *
File size: 3.0 KB
Line 
1#!/usr/bin/perl
2# ============================================================ #
3#                                                              #
4#   File      : beautifyNewick.pl                              #
5#   Purpose   : Beautify a newick tree                         #
6#                                                              #
7#   Coded by Ralf Westram (coder@reallysoft.de) in June 2009   #
8#   Institute of Microbiology (Technical University Munich)    #
9#   www.arb-home.de                                            #
10#                                                              #
11# ============================================================ #
12
13use strict;
14use warnings;
15
16use Bio::TreeIO;
17
18# ----------------------------------------
19
20my $indent_incr     = 1; # how much indentation to use
21my $inTreeComments = 50; # indentation of in-tree-comments (0=none)
22
23# ----------------------------------------
24
25sub make_indent($) {
26  my ($indlev) = @_;
27  my $s = '';
28  for (my $i = 0; $i<$indlev; $i++) { $s .= ' '; }
29  return $s;
30}
31
32my $depth = 0;
33
34sub indent() {
35  my $indlev = $depth*$indent_incr;
36  return make_indent($indlev);
37}
38
39sub node2string($);
40sub node2string($) {
41  my ($node) = @_;
42
43  if ($node->is_Leaf) {
44    return indent().'"'.$node->id.'"';
45  }
46
47  my $str = indent()."(";
48  $depth++;
49
50  my @children = ();
51  foreach my $child ($node->each_Descendent()) {
52    push @children, node2string($child).':'.$child->branch_length;
53  }
54
55  if ($inTreeComments) {
56    my $len = length($str);
57
58    $str .= make_indent($inTreeComments-$len)."[children=".scalar(@children);
59    if ($indent_incr==0) { $str .= ', level='.$depth; }
60    $str .= "]";
61  }
62  $str .= "\n";
63
64  $str .= join(",\n", @children)."\n";
65
66  $depth--;
67  $str .= indent().")";
68
69  return $str;
70}
71
72sub main() {
73  my $args = scalar(@ARGV);
74  if ($args<2) {
75    die(
76        "Usage: beautifyNewick.pl [--indent] [--intreecmt] in.tree out.tree\n".
77        "       --indent=inc          indent subnodes by 'inc' spaces\n".
78        "       --intreecmt=col       insert info-comments inside tree at column 'col'\n".
79        "       --overwrite           overwrite existing output file\n".
80        "\n"
81       );
82  }
83
84  my $infile    = undef;
85  my $outfile   = undef;
86  my $overwrite = 0;
87
88  foreach (@ARGV) {
89    if (/^--indent=/) { $indent_incr = $'; }
90    elsif (/^--intreecmt=/) { $inTreeComments = $'; }
91    elsif ($_ eq '--overwrite') { $overwrite = 1; }
92    else {
93      if (not defined $infile) { $infile = $_; }
94      elsif (not defined $outfile) { $outfile = $_; }
95      else {
96        print "Warning: ignoring superfluous argument '$_'\n";
97      }
98    }
99  }
100
101  if (not defined $outfile) { die "Missing arguments!\n"; }
102
103  if (not -f $infile) { die "File not found: '$infile'\n"; }
104  if ($overwrite==0 and -f $outfile) { die "File already exists: '$outfile'\n"; }
105
106  my $in   = new Bio::TreeIO(-format => 'newick', -file => $infile);
107  my $tree = $in->next_tree;
108
109  open(TREE,'>'.$outfile) || die "can't write '$outfile' (Reason: $!)";
110  my $root = $tree->get_root_node($tree);
111  print TREE node2string($root);
112  close(TREE);
113}
114main();
Note: See TracBrowser for help on using the repository browser.