use strict;
use warnings;
use Data::Dumper;

my $sites={'mouse'=>'CGGCGGAAAACTGTCCTCCGTGC',
           'rat'=>  'CGACGGAACATTCTCCTCCGCGC', 
           'human'=>'CGACGGAATATTCCCCTCCGTGC',
           'chimp'=>'CGACGGAAGACTCTCCTCCGTGC'};
my $tree = [['mouse','rat'],['human','chimp']]; 

# Sanity checks
my $len=-1;
treeCheck($tree,$sites,\$len);
              
my @val;
$val[$_]=parsimony(extractLocus($tree,$sites,$_))->[0] for (0..$len-1);
print join('',@val)."\n";


sub treeCheck {
  my ($subTree,$sites,$len)=@_;
  if (ref($subTree) eq 'ARRAY') {
    die "Not a binary tree" if @$subTree != 2;
    treeCheck($subTree->[0],$sites,$len);
    treeCheck($subTree->[1],$sites,$len);
  } else {
    die "Invalid char" if $sites->{$subTree} !~ /^[ATCG]+$/;
    if ($$len<0) {
      $$len=length($sites->{$subTree});
    } else {
      die "Invalid length" if length($sites->{$subTree}) != $$len;
    }
  }
}

sub extractLocus {
  my ($subTree,$sites,$index)=@_;
  if (ref($subTree) eq 'ARRAY') {
    return [extractLocus($subTree->[0],$sites,$index),extractLocus($subTree->[1],$sites,$index)];
  } else {
    my $base=substr($sites->{$subTree},$index,1);
    $base =~ tr/ATCG/1248/;    
    return $base;
  }
}
  
sub parsimony {
  my $locusTree=shift;
  if (ref($locusTree) eq 'ARRAY') {
    my $left=parsimony($locusTree->[0]);
    my $right=parsimony($locusTree->[1]);
    my $count=$left->[0]+$right->[0];
    $count++ if ($left->[1] & $right->[1])==0;
    my $bases=$left->[1] | $right->[1];
    return [$count,$bases]
  } else {
    return[0,$locusTree];
  }
}
##</code><code>##

With $tree = [['mouse','rat'],['human','chimp']]; 
gives 00100000302011000000100

With $tree = ['mouse',['rat',['human','chimp']]]; 
gives 00100000301011000000100