forester/archive/perl/extractSpecies.pl

   1 #!/usr/bin/perl -W
   2
   3 # extractSpecies.pl
   4 # ----------------
   5 #
   6 # Copyright (C) 2003 Christian M. Zmasek
   7 # All rights reserved
   8 #
   9 # Created: 09/03/03
  10 # Author: Christian M. Zmasek
  11 # zmasek@genetics.wustl.edu
  12 # http://www.genetics.wustl.edu/eddy/people/zmasek/
  13 #
  14 # Last modified 03/12/04 (Added gg)
  15
  16 # Purpose. Adds species information to a file describing a phylogenetic
  17 #          tree in the following format (by way of example):
  18 #          "((ceINX_CE33055:0.02883,cbINX_CB09748:0.02934):0.36899[&&NHX:B=100],..."
  19 #          ce stands for "CAEEL". The hash  %SPECIES needs to be set accordingly.
  20 #
  21
  22
  23 use strict;
  24
  25
  26 my %SPECIES = (
  27                 "dm" => "DROME",
  28                 "ag" => "ANOGA",
  29                 "ce" => "CAEEL",
  30                 "cb" => "CAEBR",
  31                 "ci" => "CIOIN",
  32                 "fr" => "FUGRU",
  33                 "gg" => "CHICK",
  34                 "rn"  => "RAT",
  35                 "mm"  => "MOUSE",
  36                 "hs"  => "HUMAN"
  37                );
  38
  39
  40 my $infile        = "";
  41 my $outfile       = "";
  42 my $intree        = "";
  43 my $return_line   = "";
  44
  45 if ( @ARGV != 1 && @ARGV != 2 ) {
  46     &errorInCommandLine();
  47 }
  48
  49 $infile = $ARGV[ 0 ];
  50
  51 if ( @ARGV == 1 ) {
  52     $outfile = $infile;
  53     $outfile =~ s/\.nhx$//;
  54     $outfile .= "_species.nhx";
  55 }
  56
  57 if ( @ARGV == 2 ) {
  58     $outfile = $ARGV[ 1 ];
  59 }
  60
  61
  62
  63
  64 if ( -e $outfile ) {
  65     die "\n$0: <<$outfile>> already exists.\n\n";
  66 }
  67 unless ( ( -s $infile ) && ( -f $infile ) && ( -T $infile ) ) {
  68     die "\n$0: <<$infile>> does not exist, is empty, or is not a plain textfile.\n\n";
  69 }
  70
  71 open( IN, "$infile" ) || die "\n$0: Cannot open file <<$infile>>: $!\n";
  72 open( OUT, ">$outfile" ) || die "\n$0: Cannot create file <<$outfile>>: $!\n";
  73
  74 while ( $return_line = <IN> ) {
  75     $return_line =~ s/\s+//g;
  76     $return_line =~ s/\+/_/g;
  77
  78     $intree .= $return_line;
  79
  80 }
  81
  82 close( IN );
  83
  84 while ( ( my $short, my $long ) = each ( %SPECIES ) ) {
  85
  86     while ( $intree =~ /[(),]($short[^\[]+?)[(),]/ ) {
  87
  88         my $name_and_length = $1;
  89
  90         print "$name_and_length   ->   $name_and_length\[\&\&NHX:S=$long\]\n";
  91
  92         $intree =~ s/$name_and_length/$name_and_length\[&&NHX:S=$long\]/;
  93
  94     }
  95
  96 }
  97
  98 print OUT $intree;
  99
 100 close( OUT );
 101
 102 print "\n\nDone!\n\n";
 103
 104 exit( 0 );
 105
 106
 107
 108 sub errorInCommandLine {
 109     print "\n";
 110     print "extractSpecies.pl infile [outfile]";
 111     print "\n\n";
 112     exit( -1 );
 113 }