perl/etc/WoodyMiaoLin/PbeBefore2015/tip_label.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 open I, "<", "../b.modified_alignment/haplotype_sampleID.txt";
   6 open O, ">", "tip_label.txt";
   7
   8 my $total;
   9 while (<I>) {
  10         chomp;
  11         my @a = split /\t/;
  12         my @b = split / /, $a[1];
  13         my $prefix;
  14         my @number;
  15         my $n;
  16         foreach (@b) {
  17                 ++$n;
  18                 /(\D+)(\d+)/;
  19                 if ($prefix) {
  20                         warn $_ if $prefix ne $1;
  21                 } else {
  22                         $prefix = $1;
  23                 }
  24                 push @number, $2;
  25         }
  26         $total += $n;
  27         my $c = $prefix . join(",", sort {$a <=> $b} @number) . ", n = $n";
  28         print O "$a[0]\t($c)\n";
  29 }
  30 warn $total;
  31 close I;
  32 close O;