#! /usr/bin/perl

use strict;
use diagnostics;
use warnings;
use Getopt::Long qw(:config permute);
use Pod::Usage;

use Data::Dumper;

srand(654321);

our $VERSION;
$VERSION = sprintf "0.%03d", q$Revision: 100 $ =~ /(\d+)/g;

# Positionner la variable PERL5LIB si besoin

# PERL5LIB est une variable comme PATH, sauf qu'elle ne sert pas 
# trouver les programmes, mais plutt les modules de perl
# En bash :
# export PERL5LIB=/chemin/vers/modules/perl:/chemin/vers/autres/modules
# En tcsh :
# setenv PERL5LIB /chemin/vers/modules/perl:/chemin/vers/autres/modules

# Si les modules sont installs dans les emplacements standard de
# perl, c'est inutile

use ALTree::Chi2 ();
use ALTree::Import;
use ALTree::Utils qw(erreur);
use ALTree::Input qw(PrepareTree);
#use Newchi2treeUtils;

###########################################
########  GLOBAL VARIABLES        #########
###########################################

# Variable $nodes
#   Ref on Hash of ('id' => Node)
# my $nodes;

# Variable $sites
#   Ref on Hash of ('site_nb' -> Site)
# my $sites;

###########################################
########  CONSTANTES              #########
###########################################

package SplitMode;
use constant NOSPLIT   => 0;
use constant CHI2SPLIT => 1;

package CoEvo;
use constant SIMPLE   => 0;
use constant DOUBLE => 1;

package RootMeth;
use constant OUTG  => 0;
use constant ANC   => 1;

package SignUtil;
use constant NO   => 0;
use constant YES  => 1;

package Seuil;
use constant SAMPLESIZE => 5;
use constant P_VAL_CHI2 => 0.01;
use constant P_VAL_TESTPROP => 0.01;
use constant ONLY_CASE  => 3;

package main;

###########################################
#########  BUILDING OF THE TREE  ##########
###########################################


# Outgroup is not removed from the hash nodes.
# It is only removed from the list of children of it's father 
sub RemoveOutgroup
{
    my $tree=shift;
    my $outgroup=shift;

    my($father_outgr)=$outgroup->GetFather();
    $father_outgr->DeleteChild($outgroup);
}

# Outgroup is put again in the list of children of it's father
sub AddOutgroup 
{
    my($outgroup)=shift;
    my($father_outgr)=$outgroup->GetFather();
    $father_outgr->AddChild($outgroup);
}

sub NbFils
{
    my($node)=shift;
    return $node->NbChildren();
}

sub Name
{
    my($node)=shift;
    return $node->Name();
}

###########################################################
####### CHECK FUNCTIONS ###################################
###########################################################

# Do some check on the tree
# Return true (1) if the outgroup need to be removed
sub CheckCorrespondance 
{
    my($tree)=shift;
    my($correspondance)=shift;
    my($name_corres)=shift;
    my($outgroup)=shift;
    my($ret)=0;

#Check if all the leaf are defined in $correspondance
    foreach my $node ($tree->GetNodesList()) {
	my($nb_fils)=$node->NbChildren();
	if ($nb_fils == 0) { # We are on a leaf
	    if (not defined $correspondance->{$node->GetId()}) {
		if (defined($outgroup) && ($node->GetId() eq $outgroup)) {
		    $ret=1;
		} else {
		    #$node->SetCase(0);
		    #$node->SetControl(0);
		    if (not defined($outgroup)) {
			erreur("The leaf '". $node->Name().
			       "' is not in the input file ".
			       "'$name_corres'.\nPerhaps this is the".
			       " outgroup and you need to remove it (option".
			       " --remove-outgroup).\n".
			       "Please, check you data\n", 0);
		    } else {
			erreur("The leaf '". $node->Name().
			       "' is not in the input file ".
			       "'$name_corres'.\nPlease, check you data\n", 0);
		    }
		}
	    }
	}
	
    }

    # Check if all the entries for correspondance whose name begin by
    # H are leafs in the tree

    foreach my $clef (keys %{$correspondance}) {
	if (not $tree->HasNodeIndex($clef)) {
	    erreur("Node '$clef' found in '$name_corres' does".
		   " not exist in the tree. You have probably".
		   " forgot to remove the haplotype corresponding".
		   " to the ancestor.\nPlease, check the input file".
		   " '$name_corres'.\n", 0);
	}
	if ($tree->GetRoot()->Name() eq $clef) {
	    next;
	} else {
	    my($nb_fils)=$tree->GetNode($clef)->NbChildren();
	    
	    if ($nb_fils!=0) {
		erreur("'$clef' present in $name_corres is a".
		       " internal node (not a leaf) in the tree\n".
		       "Please, check your data");
	    }
	}
    }    
    return $ret;
}

##################################################
########  PARCOURS ET REMPLISSAGE ARBRE  #########
##################################################

sub ClassicalChi2
{
    my($tabnodes_a_traiter)=shift;
    my($sum_case, $sum_control, $node, $sum_total);
    my($chi2)=0;
    my($chi2invalid)=0;
    foreach $node (@{$tabnodes_a_traiter}) {
        if (not defined($node->{"control"})) {
           die "arg for ".$node->Name();
	}
        $sum_control+=$node->{"control"};
        $sum_case+=$node->{"case"};
    }
    $sum_total=$sum_control+$sum_case;
    my($ddl)=scalar(@{$tabnodes_a_traiter})-1; # Nb branches -1

    my($error)=0;
    if ($ddl==0) { # 1 seul clade
        $error=4;
        #Faire un warning si on n'est pas  la racine?
    } else {
        if ($sum_case==0) {
            $error=1;
        } elsif ($sum_control==0) {
            $error=2;
        } else { # Calcul du chi2
            my($m, $c, $t_m, $t_c);
            foreach $node (@{$tabnodes_a_traiter}) {
                $m=$node->{"case"};
                $c=$node->{"control"};
		if ($m==0 && $c==0) {
		    my($name)=$node->Name();
		    erreur("no case and no control for node $name\n", 1);
		}
                $t_m=(($m+$c)*$sum_case)/$sum_total;
                        #print STDERR $node->Name() ," m=$m, t_m=$t_m, c=$c\n";
		$chi2 += (($m-$t_m)*($m-$t_m))/$t_m;
		
                $t_c=(($m+$c)*$sum_control)/$sum_total;
                $chi2 += (($c-$t_c)*($c-$t_c))/$t_c;
                if (($t_m <= Seuil::SAMPLESIZE) ||
                    ($t_c <= Seuil::SAMPLESIZE)) {
                    $chi2invalid++;
                }
            }
        }
    }
    return ($chi2, $chi2invalid, $error, $sum_control, $sum_case);
}

sub CalculChi2
{
    my($tabnodes_a_traiter)=shift;
    my($ddl)=shift; 
    my($test_results)=shift;
    my($sign_util)=shift;
    my($chi2, $chi2invalid, $error, $sum_control, $sum_case);
    my($significatif);
    my($p_value);
    
    ($chi2, $chi2invalid, $error, $sum_control, $sum_case)= 
	ClassicalChi2($tabnodes_a_traiter);
    if ($error != 0) {
	# TODO: A vrifier : est-ce OK de mettre $significatif  0
	# la valeur est utilise au retour de cette fonction
#	$significatif=0;
	if ($error == 1) {
	    $test_results->{"texte"}=
		"No cases,  ($sum_control controls)";
	    if ($sign_util==SignUtil::YES) {
		$significatif=ALTree::Chi2::NON_SIGNIFICATIF;
	    }
	} elsif ($error == 2) {
	    $test_results->{"texte"}="No controls: only $sum_case cases";
	    if ($sum_case>=Seuil::ONLY_CASE) {
		 if ($sign_util==SignUtil::YES) {
		     $significatif=1;
		     $test_results->{"sign"}=ALTree::Chi2::SIGNIFICATIF;
		 }
	    } else {
		if ($sign_util==SignUtil::YES) {
		    $significatif=0;
		    $test_results->{"sign"}=ALTree::Chi2::NON_SIGNIFICATIF;
		}	
	    }
	    #$test_results->{"sign"}=ALTree::Chi2::NON_SIGNIFICATIF;
	} elsif ($error == 4) {
	    $test_results->{"texte"}="Only one clade";
	    if ($sign_util==SignUtil::YES) {		
		$significatif=0;
		$test_results->{"sign"}=ALTree::Chi2::NON_SIGNIFICATIF;
	    }
	    # Manque plein de trucs par rapport  la fonction dans chi2tree...
	} else {
	    die "invalid error $error\n";
	}
    } else {
	if ($chi2invalid !=0) {
	    $test_results->{"warning"}="Small sample size correction used";   
	    # J'ai pas compt dans combien de branches...
	    if ($ddl == 1) {
		$p_value=ALTree::CUtils::bilateral($tabnodes_a_traiter->[0]->{"case"},
					   $tabnodes_a_traiter->[0]->{"control"},
					   $tabnodes_a_traiter->[1]->{"case"},
					   $tabnodes_a_traiter->[1]->{"control"});
		if ($sign_util==SignUtil::YES) {
		    $significatif=ALTree::Chi2::chi2_fisher_significatif($p_value);
		}
	    } else {
		my(@clades, $node);
		foreach $node (@{$tabnodes_a_traiter}) {
		    push @clades, ($node->{"case"} + $node->{"control"});
		    # remplit un tableau contenant les effectifs
		    # totaux des diffrents clades  utiliser dans le
		    # rechantillonnage
		}
		($p_value)= ALTree::Chi2::reech_chi2($sum_case, $sum_control,
					     $ddl+1, $chi2, \@clades);
		$test_results->{"warning"}.=" ($p_value)";
		if ($sign_util==SignUtil::YES) {
		    $significatif= ALTree::Chi2::reech_significatif ($p_value);
		    if ($significatif != 
			ALTree::Chi2::chi2_significatif($ddl, $chi2)) {
			$test_results->{"warning"}.=" Result has changed !";
		    }
		}
	    }
	} else {
	    if ($sign_util==SignUtil::YES) {
		$significatif=ALTree::Chi2::chi2_significatif($ddl, $chi2);
	    }
	    #my $p=`pochisq $chi2 $ddl`+0; # Verif que les 2 appellent 
	                                   #bien la mme chose!
	    $p_value=ALTree::CUtils::pochisq($chi2,$ddl);
	    #if ($p != $p_value) {
	    #print STDERR "pochisq: $p != $p_value !\n";
	    #}
	}
	if ($sign_util==SignUtil::YES) {
	    if ($significatif) {
		$test_results->{"sign"}=ALTree::Chi2::SIGNIFICATIF;
	    #$test_results->{"texte"}.="significatif";
	    } else {
		$test_results->{"sign"}=ALTree::Chi2::NON_SIGNIFICATIF;
		# $test_results->{"texte"}.="non significatif";
	    }
	}
	$test_results->{"chi2"}=$chi2;
	$test_results->{"p_val"}=$p_value;
	#$test_results->{"texte"}.=" [p_value_chi2=$p_value]";
    }
    if ($sign_util==SignUtil::YES) {
	return ($significatif, $p_value);
    } else {
	return ($p_value);
    }
}

sub parcours_nosplit_chi2split
{
    my($tabnodes_a_traiter)=shift;
    my($prolonge)=shift;
    my($splitmode)=shift;
    my($node_ecriture)=shift;
    my($sign_util)=shift; # vaut 1 si on a besoin de la significativit, 0 sinon
    my($node, $child, @tab_noeuds_suivants);
    my($val)=0;
    my($test, $p_val);
    my($test_results);
 
    $test_results->{"ddl"}=scalar(@{$tabnodes_a_traiter})-1; # Nb branches -1
    if ($sign_util==SignUtil::YES) {
	($test, $p_val)=CalculChi2($tabnodes_a_traiter, $test_results->{"ddl"}, $test_results, SignUtil::YES );
    } elsif ($sign_util==SignUtil::NO) { 
	($p_val)=CalculChi2($tabnodes_a_traiter, $test_results->{"ddl"}, $test_results, SignUtil::NO);
    }
    $test_results->{"node_teste"}=$node_ecriture;
    push (@{$node_ecriture->{"res_test"}}, $test_results);
    $test_results->{"level"}=scalar(@{$node_ecriture->{"res_test"}})-1;
    
    if ($sign_util== SignUtil::YES && $test==1 && $splitmode == SplitMode::CHI2SPLIT) { # sign et que on on est en chi2split
	foreach $node (@{$tabnodes_a_traiter}) {
	    if (NbFils($node) != 0) {
		my @children=$node->GetChildrenList();
		parcours_nosplit_chi2split(\@children, 
					   $prolonge, $splitmode, $node);
	    }
	}
    } elsif ($sign_util== SignUtil::NO || $test==0 || $splitmode == SplitMode::NOSPLIT) { # ou alors on est en nosplit
	foreach $node (@{$tabnodes_a_traiter}) {
	    if (NbFils($node) != 0) {
		$val=1;
		foreach $child ($node->GetChildrenList()) {
		    push (@tab_noeuds_suivants, $child);
		}
	    } else {
		if ($prolonge == 1) {
		    push (@tab_noeuds_suivants, $node);
		}
	    }
	}
	if ($val==1) {
	    parcours_nosplit_chi2split(\@tab_noeuds_suivants, 
				       $prolonge, $splitmode, $node_ecriture, $sign_util);
	} else {
	    return;
	}
    }
}

sub FillCaseControl
{
    my($present_node)=shift;
    my($correspondance)=shift;
    if ($present_node->NbChildren()==0)  {
	my($id);
	$id=$present_node->{"id"};
	if (not defined $present_node->{"case"}) {# car sinon, pb pour H000
	    $present_node->{"case"} = $correspondance->{$id}->{"case"};
	}
	if (not defined $present_node->{"control"}) {
	   $present_node->{"control"} = $correspondance->{$id}->{"control"};
	}
	#print $present_node->{"id"}, " m:", $present_node->{"case"}, " c:", $present_node->{"control"}, " ";
    } else {
	my($child);
	# print $present_node->{"id"}, " "; #123456
	for $child ($present_node->GetChildrenList()) { 
	    FillCaseControl($child, $correspondance);
	    $present_node->{"case"}+=$child->{"case"};
	    $present_node->{"control"}+=$child->{"control"};
	}
	#print $present_node->{"id"}, " m:", $present_node->{"case"}," c:", $present_node->{"control"}," ";
    }
    
}


sub FillLevel
{
    my($present_node)=shift;
    my($level)=shift;
    my($child);
        
    $present_node->{"level"}=$level;
    $level+=1;
    foreach $child (@{$present_node->{"children"}}) { 
	FillLevel($child, $level);
    }
}

sub FillHeight
{
    my($present_node)=shift;
    my($height)=shift;
    my($child);
    $height+=1;
    foreach $child (@{$present_node->{"children"}}) { 
	FillHeight($child, $height);
    }
    $present_node->{"height"}=$height;
}


##################################################
######## AFFICHAGE DE L' ARBRE  ##################
##################################################
sub LongueurTrait
{
    my($node)=shift;
    my($level)=shift;
    return("      "x$level."------");
}

sub AffichageParLevel # Ne prend pas une fonction pour l'affichage
{
    my ($racine)=shift;
    my ($len)=6;
    my $AffichageInterne;

    $AffichageInterne= sub
    {
	my ($node) = shift;
	my ($start) = shift; # dbut commun  tout ce noeud (et descendants)
	my ($up) = shift; # quand on est au dessus de ce noeud
	my ($here) =shift; # quand on affiche ce noeud
	my ($down) =shift; # quand on est au dessous de ce noeud
	
	my($nb_fils)=NbFils($node);
	my($i);
	
	if ($nb_fils >= 1) {
	    $AffichageInterne->($node->GetChild(0),
				$start.$up.(" "x$len), " ", "/", "|");
	}
	for ($i=1; $i<$nb_fils/2; $i++) {
	    $AffichageInterne->($node->GetChild($i),
				$start.$up.(" "x$len), "|", "|", "|");
	}
	print $start.$here.("-"x$len)."* ", Name($node), "\n";
	for ( ;$i < $nb_fils-1; $i++) {
	    $AffichageInterne->($node->GetChild($i),
				$start.$down.(" "x$len), "|", "|", " ");
	}
	if ($nb_fils > 1) {
	    $AffichageInterne->($node->GetChild($nb_fils-1),
				$start.$down.(" "x$len), "|", "\\", " ");
	}
    };
    $AffichageInterne->($racine, "", " ", "-", " ");
}

sub AffichageArbre # Prend une fonction pour l'affichage
{
    my ($racine)=shift;
    my ($function)=shift;
    my ($len)=4;
    my $AffichageInterne;
   
    
    $AffichageInterne= sub
    {
	my ($node) = shift;
	my ($start) = shift; # dbut commun  tout ce noeud (et descendants)
	my ($up) = shift; # quand on est au dessus de ce noeud
	my ($here) =shift; # quand on affiche ce noeud
	my ($down) =shift; # quand on est au dessous de ce noeud
	my ($at) =shift; # quand on les autres lignes de ce noeud
	
	my($nb_fils)=NbFils($node);
	my($i, $j, $sep);
	my (@tableau)=split (/\n/, $function->($node));
	if ($nb_fils >= 1) {
	    $AffichageInterne->($node->{"children"}->[0],
				$start.$up.(" "x$len), " ", "/", "|", "|");
	}
	for ($i=1; $i<$nb_fils/2; $i++) {
	    $AffichageInterne->($node->{"children"}->[$i],
				$start.$up.(" "x$len), "|", "|", "|", "|");
	}
	print $start.$here.("-"x$len)."* ", $tableau[0], "\n";
	if ($nb_fils > 1) {
	    $sep="|";
	} else {
	    $sep=" ";
	}
	for ($j=1; $j<=$#tableau; $j++) {
	    print $start.$at.(" "x$len).$sep." ", $tableau[$j], "\n";
	}
	#    print $start.$here.("-"x$len)."* ", $function->($node), "\n";
	for ( ;$i < $nb_fils-1; $i++) {
	    $AffichageInterne->($node->{"children"}->[$i],
				$start.$down.(" "x$len), "|", "|", "|", "|");
	}
	if ($nb_fils > 1) {
	    $AffichageInterne->($node->{"children"}->[$nb_fils-1],
				$start.$down.(" "x$len), "|", "\\", " ", " ");
	}
    };
    $AffichageInterne->($racine, "", " ", "-", " ", " ");
}

###############################################################
## FONCTION DEFINISSANT LES INFOS QUI VONT ETRE AFFICHEES #####
###############################################################

# Return results of the test: ddl, p_value, significatif or not, texte and warning
sub TestInfos
{
    my($node)=shift;
    return InfosAffichees($node, 2);

#    my($chaine)=Name($node)."\n";
#    my($lbl_test)=0;
#    my $test;
#    if (defined $node->{"res_test"}) {
#       	for $test (@{$node->{"res_test"}}) {
#	    $chaine.="[".$test->{"level"}."]"." ddl= ".$test->{"ddl"}.
#		" chi2= ".$test->{"chi2"}.
#		" p_value_chi2= ".$test->{"p_val"}.
#	}
#    }
#    return($chaine); 
    
}
sub AssociationInfos
{
    my($node)=shift;
    return InfosAffichees($node, 1);
}

sub TreeInfos
{
 my($node)=shift;
    return InfosAffichees($node, 0);
}

#Return ddl, level, pvalues and chi2
sub InfosAffichees
{
    my($node)=shift;
    my($mode)=shift;
    my($chaine)=Name($node);
    my($lbl_test)=0;
    my $test;
    if ($mode==1 || $mode == 2) { # Affiche ou pas les case/control
	$chaine.=" case/control:".$node->{"case"}."/".$node->{"control"};
    }
    if (1) { # affiche les apomorphies
	$chaine.="\n";
	foreach my $apo ($node->GetApoList()) {
	    $chaine.= ("  Site: ".$apo->GetSiteNb." Sens: ".$apo->GetSensLabel()."\n");
	}
    }
    $chaine.="\n";
    if (1) { # affiche ou pas les ddl
	if (defined $node->{"res_test"}) {
	    for $test (@{$node->{"res_test"}}) {
		$chaine.= sprintf "[%d] ddl=%d", 
		$test->{"level"}, $test->{"ddl"};
		if ($test->{"ddl"} > 0) {
		    $chaine.= sprintf " chi2=%.2f p_value_chi2=%.3g",
		    $test->{"chi2"}, $test->{"p_val"};
		    # TODO : a arrive quand on a que des malades ou tmoins
		    # dans les clades...
		    if (not defined($test->{"chi2"})) {
			print "chi2 for ", Name($node),
			"(", $test->{"ddl"}, ")", "\n";
		    }
		    if (not defined($test->{"p_val"})) {
			print "p_val for ", Name($node), 
			"(", $test->{"ddl"}, ")", "\n";
		    }
		    if ($mode ==2) {
			if (defined($test->{"sign"})) {
			    if ($test->{"sign"} == ALTree::Chi2::NON_SIGNIFICATIF) {
				$chaine .= " (non significatif)";
			    } elsif ($test->{"sign"} == ALTree::Chi2::SIGNIFICATIF) {
				$chaine .= " (significatif)";
			    } else {
				ALTree::Utils::internal_error("unknown value ".
				    $test->{"sign"});
			    }
			}		    
			if (defined($test->{"texte"})) {
			    $chaine .= "\n".$test->{"texte"};
			}
			if (defined($test->{"warning"})) {
			    $chaine .= "\n".$test->{"warning"};
			}
		    }
		}
		$chaine.="\n";
	    }
	}
    }
    return($chaine); 
    
}
##########################################################
######## MODIFICATIONS/CALCULS SUR L'ARBRE ###############
##########################################################

sub FusionBrNulles
{
    my($present_node)=shift;
    my($child);
    my($nb_fils)=NbFils($present_node);
    
    $present_node->{"label"}=$present_node->{"id"};
    $present_node->RecordOrigFather();
    if ($nb_fils != 0) { # on n'est pas dans une feuille
	$present_node->AddOldChild($present_node->GetChildrenList());
	$present_node->ForgetChildren();
	foreach $child ($present_node->GetOldChildrenList()) {
	    if (! FusionBrNulles($child)) {
		$present_node->AddChild($child);
	    }
	}
	if (not $present_node->HasFather()) {
	    return 0;
	}
	if (not defined $present_node->{"br_len"}) {
	    print STDERR "Branch lenght not defined for ", $present_node->{"id"}, "\n"; 
	    exit 1;
	} elsif ($present_node->GetBrLen() == 0) { # branche nulle
	    #print "brnulle ", $present_node->{"id"}, " ";
	    foreach $child  (@{$present_node->{"children"}}) {
		$child->{"father"}=$present_node->{"father"}; #remplace father
		#print "father's name ", $present_node->GetFather()->Name(),"\n"; 
		$present_node->GetFather()->AddChild($child);
	    }
	    $present_node->{"father"}->{"label"}.="+(".$present_node->{"label"}.")";
	    return 1;
	}
    }
    return 0;
}


##########################################################
################### CLEAN FUNCTION  ######################
##########################################################

sub CleanCaseControl
{
    my($tree)=shift;
    
    foreach my $node ($tree->GetNodesList()) {
	$node->EraseCase();
	$node->EraseControl();
    }
}

sub CleanChi2
{
    my($tree)=shift;
    
    foreach my $node ($tree->GetNodesList()) {
	delete $node->{"res_test"};
    }
}

##########################################################
########### FUNCTIONS FOR ASSOCIATION TEST ###############
##########################################################

# From the hash correspondance, fill the variables necessary for Resampling
sub Correspond2Resampling
{
    my($correspondance)=shift;
    my($haploID, $ref_effectif, $total_mal, $total_tem);
    foreach $haploID (keys %{$correspondance}) {
	$ref_effectif->{$haploID}=$correspondance->{$haploID}->{"case"}+
	    $correspondance->{$haploID}->{"control"};
	$total_mal+=$correspondance->{$haploID}->{"case"};
	$total_tem+=$correspondance->{$haploID}->{"control"};
    }
   #  DEBUG print "total_mal=$total_mal total_tem=$total_tem\n";
    return ($total_mal, $total_tem, $ref_effectif);
}


sub Resampling # repompe intgralement de tree_resampling puis modifie....
{
    my($total_mal) = shift;
    my($total_tem) = shift;
    my($ref_effectif) = shift; # ref on a hash: keys=H002 value= nbmal+nb_tem
    my($clefs, $alea, $i);
    my($new_correspondance);
    foreach $clefs (keys %{$ref_effectif}) { 
	$new_correspondance->{$clefs}->{"case"}=0;
	$new_correspondance->{$clefs}->{"control"}=0;
	for ($i=0; $i<$ref_effectif->{$clefs}; $i++) {
	    $alea=rand($total_mal+$total_tem);
	    # print "alea=$alea";
	    if ($alea < $total_mal) {
		#	print "inf\n";
		$total_mal--;
		$new_correspondance->{$clefs}->{"case"}++;
		$new_correspondance->{$clefs}->{"control"}+=0;
	    } else {
		#	    print "sup\n";
		$total_tem--;
		$new_correspondance->{$clefs}->{"control"}++;
		$new_correspondance->{$clefs}->{"case"}+=0;
	    }
	}
#	print "clefs:$clefs nb_mal=$nb_mal{$clefs}, nb_tem=$nb_tem{$clefs}\n";
    }
    return ($new_correspondance);
}

sub StockeChi2

{
    my($ligne_chi2)=shift;
    my $racine=shift;
    my $test_res;
    foreach $test_res (@{$racine->{"res_test"}}) {
	# Si on n'a qu'une seule branche, la p-value n'est pas dfinie
	if ($test_res->{"ddl"} > 0) {
	    push @{$ligne_chi2}, $test_res->{"chi2"};
	}
    }
    # Fill a 2*n table: each line containig chi2 and each columns
    # corresponding to one repetition
    #push (@{$table_of_line}, \@ligne_chi2);
}


sub Association 
{
    my($racine)=shift;
    my($correspondance)=shift;
    my($prolonge)=shift;
    my($sign_util)=shift;
    my($total_mal, $total_tem, $effectif, $new_correspondance);
    ($total_mal, $total_tem, $effectif)=Correspond2Resampling($correspondance);
    ($new_correspondance)=Resampling($total_mal, $total_tem, $effectif);

    # DEBUG  my($haploID);
    #foreach $haploID (keys %{$new_correspondance}) {
    #	print "Haplo: $haploID mal= ",$new_correspondance->{$haploID}->{"case"}, " tem=", $new_correspondance->{$haploID}->{"control"},"\n";
    #}  
    #print "\n";
    
    FillCaseControl($racine,$new_correspondance);
    parcours_nosplit_chi2split($racine->{"children"}, $prolonge, 
			       SplitMode::NOSPLIT, $racine, $sign_util);
} 

sub RepeatAssociation
{
    my($tree)=shift;
    my($correspondance)=shift;
    my($prolonge)=shift;
    my($nb_permutation)= shift;
    my($sign_util)=shift;

    my($racine)=$tree->GetRoot();

    my($ligne_chi2)=[]; 
    print "\n Number of permutation: $nb_permutation\n";
    
    my($value_per_line, $test_res);
    foreach $test_res (@{$racine->{"res_test"}}) {
	# Si on n'a qu'une seule branche, la p-value n'est pas dfinie
	if ($test_res->{"ddl"} > 0) {
	    $value_per_line++;
	}
    }

    # !!! Est_ce que a serait bien de passer value_per_mine en parametre de stocke_chi2 et de vrifier qu'on a bien le bon nb de valeur par ligne? !!!

    
    StockeChi2($ligne_chi2, $racine); # Chi2 values corresponding to the real data are put to @{$ligne_chi2}
    my($i, $j);
    for ($i=0; $i<$nb_permutation; $i++) {
	CleanCaseControl($tree);
	CleanChi2($tree);
	Association($racine, $correspondance, $prolonge, $sign_util);
	StockeChi2($ligne_chi2, $racine);
    }
    
    #for (my($i)=0; $i<scalar @{$ligne_chi2}; $i++) {
#	print $ligne_chi2->[$i], " ";
#    }

    return($value_per_line, $ligne_chi2);
}

##########################################################
################# LOCALISATION ###########################
##########################################################

sub CalculateRit 
{
    my($tree)=shift;
    my($s_site_nb)=shift;
    my($s_state)=shift;
    my($co_evo)=shift;
    my($clef);
    my($info_mutation); 
    my($s_t, $s_t_rev)=(0,0);
    
    my($s_sitesens_per_tree)=$tree->GetSite($s_site_nb)
	->GetSens($s_state);

    if (not defined($s_sitesens_per_tree)) {
	warn("No S site (number $s_site_nb)".
		" with sens '".$s_state->GetLabel()."' found\n");
    }
    # Calcul du Rit
    # Notation des commentaires: le s_site mute de T->M
    foreach my $node ($s_sitesens_per_tree->GetNodesList()) {
	foreach my $sitesens_per_tree ($node->GetApoList()) {
	    if ($sitesens_per_tree == $s_sitesens_per_tree) {
		# on profite du fait pour incrmenter le nombre de
		# mutation de s_site
		# (On aurait aussi pu globalement incrmenter s_t
		#  de la taille du tableau du premier foreach :
		#  en effet, on passe ici une fois pour chaque
		#  foreach du second niveau)
		$s_t++;
	    } else {
		# le sitesens co-mute par ex de 1->2
		$sitesens_per_tree->IncRit();
	    }
	}
    }

    if ($co_evo == CoEvo::DOUBLE){
	# On 'retourne' le sens s_state
	$s_state->Switch();
	my $s_sitesens_per_tree_rev=$tree->GetSite($s_site_nb)
	    ->GetSens($s_state);
	# On le remet dans le bon sens aprs l'avoir tout tourneboul
	$s_state->Switch();
	
	if (defined($s_sitesens_per_tree_rev)) {
	    # Calcul du Rit
	    foreach my $node ($s_sitesens_per_tree_rev->GetNodesList()) {
		foreach my $sitesens_per_tree ($node->GetApoList()) {
		    if ($sitesens_per_tree == $s_sitesens_per_tree_rev) {
			# nombre de mutation inverse du s_site (M->T)
			# (mme remarque que prcdemment)
			$s_t_rev++;
		    } else {
			# le sitesens co-mute de 2->1 avec s_site M->T
			# donc on incrmente Rit pour sitesens 1->2
			$sitesens_per_tree->GetSensRev()->IncRit();
		    }
		}
	    }
	}
    } elsif ($co_evo == CoEvo::SIMPLE){
    } else {
	die "Invalid value for co_evo: $co_evo - should be 0 or 1\n";
    }
    return($s_t, $s_t_rev);
}

sub CalculateEit
{ 
    my($tree)=shift; # Comme d'hab
    my($s_site_nb)=shift; # Pas utile ici !
    my($s_t)=shift; # nombre de fois o S mute T->M
    my($s_t_rev)=shift; # nombre de fois o S mute M->T
    my($b_t)=shift; # nombre de branches au total dans l'arbre 
                    # (aprs fusion des branches nulles)

    # Calcul du Eit (et implicitement le Mit)
    foreach my $site_per_tree ($tree->GetSitesList()) {
	foreach my $sitesens_per_tree ($site_per_tree->GetSensList()) {
	    $sitesens_per_tree->
		SetEit(($sitesens_per_tree->GetMit()*$s_t+
			$sitesens_per_tree->GetSensRev()->GetMit()*$s_t_rev)
		       /$b_t);
	   # print "  m_it= ", $sitesens_per_tree->GetMit(),"\n";
	   # print $site_per_tree->GetSiteNb(),"   ", $sitesens_per_tree->GetEit(), "\n";
	}
    }
}

sub PrintAllVit
{
    my($tree)=shift;
    my($s_site_nb)=shift;
    my($mutation , $sens); 
    foreach my $site_per_tree ($tree->GetSitesList()) {
	if ($site_per_tree->GetSiteNb() == $s_site_nb) {
	    next;
	}
	foreach my $sitesens_per_tree ($site_per_tree->GetSensList()) {
	    print "mutation= ",$site_per_tree->GetSiteNb(), "\t";
	    print "sens= ", $sitesens_per_tree->GetSensLabel(),"\n";
	    print "  m_it= ", $sitesens_per_tree->GetMit(),
	    " R_it= ", $sitesens_per_tree->GetRit(), 
	    " E_it= ", $sitesens_per_tree->GetEit(),
	    " V_it= ", $sitesens_per_tree->GetVit(),"\n";
	}
    }

}

sub PrintAllVi
{
    my($foret)=shift;
    my($s_site_nb)=shift;
    my($mutation , $sens); 
    foreach my $site_per_foret ($foret->GetSitesList()) {
	if ($site_per_foret->GetSiteNb() == $s_site_nb) {
	    next;
	}
	foreach my $sitesens_per_foret ($site_per_foret->GetSensList()) {
	    print "mutation= ",$site_per_foret->GetSiteNb(), "\t";
	    print "sens= ", $sitesens_per_foret->GetSensLabel(),"\t";
	    print "  V_i= ", $sitesens_per_foret->GetVi(),"\n";
	}
    }

}

# Pour chaque site, on a choisi un sens en fonction du Vi (max) et on
# affiche le tableau des Vi pour tous les sites et pour le sens choisi
sub PrintViMax
{
    my($foret)=shift;
    my($s_site_nb)=shift;
    foreach my $site ($foret->GetViMaxSiteList()) {
	if ($site->GetSiteNb() == $s_site_nb) {
	    next;
	}
	print "site number ", $site->GetSiteNb(), "\n";
	foreach my $sens ($site->GetViMaxSensList()) {
	    print "\tsens ", $sens->GetSensLabel(), "\t";
	    print "V_i = ", $sens->GetVi(), "\n";
	}
    }
}

# Affiche le tableau de tous les Vi, pour tes les sites et pour tous
# les sens (tris par ordre dcroissant)
sub PrintViMaxSens
{
    my($foret)=shift;
    my($s_site_nb)=shift;
    foreach my $sens ($foret->GetViMaxSensList()) {
	if ($sens->GetSiteNb() == $s_site_nb) {
	    next;
	}
	print "site number ", $sens->GetSiteNb(), "\t";
	print "\tsens ", $sens->GetSensLabel(), "\t";
	print "V_i = ", $sens->GetVi(), "\n";
    }
}

###########################################################
# Fonctions du prog principal #############################
###########################################################
sub check_tree_numbers
{
    my $num_tree_in_file=shift;
    my $user_tree_numbers=shift;
    my @tree_numbers;
    my %selected_trees;

    for my $tree_num (@{$user_tree_numbers}) {
	if ($tree_num < 1) {
	    erreur("Invalid tree-to-analyse $tree_num\n", 0);
	  } elsif ($tree_num > $num_tree_in_file) {
	      erreur("Invalid tree-to-analyse $tree_num (only $num_tree_in_file in file)\n", 0);
	  }
	if (defined($selected_trees{$tree_num})) {
	    erreur("Invalid tree-to-analyse $tree_num (already selected)\n", 0);
	}
	$selected_trees{$tree_num}=1;
	# Correspondance entre les numros de l'utilisateur et les
	# indices dans le tableau (ie commence  1 ou  0)
	push @tree_numbers, $tree_num-1;
    }
    return \@tree_numbers;
}

sub select_trees
{
    my $max=shift;
    my $nb=shift;

    my @tab;
    for (my $i=0; $i<$max; $i++) {
	$tab[$i]=$i;
    }
    my @selected;
    for (my $i=0; $i<$nb; $i++) {
	my $alea=int(rand($max--));
	push @selected, $tab[$alea];
	splice(@tab, $alea, 1);
    }
    return \@selected;
}

sub PrintTree { 
    my $tree=shift;

    my ($racine)=$tree->GetRoot();
    AffichageArbre($racine, \&TreeInfos);
    print "\n\n";
}

sub SwitchRoot {
    my $tree= shift;
    my $outgroup=shift;

    my $root=$outgroup->GetFather();
    $tree->ChangeRoot($root);    
    my $newracine=$tree->GetRoot();
}

###########################################################

sub manage_options
{
    my %options;
    my $result;
    
    my $choix={ "data-type" => 
		{ "snp" => DataType::SNP,
		  "dna" => DataType::DNA,
	        },
		"rootmeth" => 
		{ "outgroup" => RootMeth::OUTG,
		  "ancestor" => RootMeth::ANC,
	        },  
		"tree-building-program" =>
		{ "phylip" => PhylProg::PHYLIP,
		  "paup" => PhylProg::PAUP,
		  "paml" => PhylProg::PAML,
		  },
		"splitmode" =>
		{ "chi2split" => SplitMode::CHI2SPLIT,
		  "nosplit" => SplitMode::NOSPLIT,
		  },
		"co-evo" =>
		{ "simple" => CoEvo::SIMPLE,
		  "double" => CoEvo::DOUBLE,
		  },
		};

    my $handle_choix = sub {
	my $option=shift;
	my $value=shift;

	foreach my $key (keys %{$choix->{$option}}) {
	    if ($key=~/^$value/i) {
		$options{$option."-value"}=$choix->{$option}->{$key};
		return;
	    }
	}
	die "Option '$option': unauthorized value '$value'\n";
    };
    my $handle_args = sub {
	my $name=shift;
	die "What about '$name' ?\n";
    };
    my $handle_progname = sub {
	my $name=shift;
	die "What about '$name' ?\n";
    };
	

    %options=("<>" => $handle_args);

    foreach my $option (keys %{$choix}) {
	$options{$option}=$handle_choix;
    }

    GetOptions (\%options,
		"version",
		"short-help|h",
		"help",
		"man",
		"association|a!", # !!! demander pour le !  Vince
		"s-localisation|l!",	
		"first-input-file|i=s",
                "second-input-file|j=s",
                "output-file|o=s",
                "data-type|t=s",
		"remove-outgroup!",
		"outgroup=s",
                "tree-building-program|p=s",
                "splitmode|s=s",
		"prolongation|b!",
		"chi2-threshold|n=f",
		"permutations|r=i",
		"number-of-trees-to-analyse=i",
		"tree-to-analyse=i@",
		"s-site-number=i",
		"s-site-characters=s",
		"co-evo|e=s",
		"print-tree!",
		"anc-seq=s",
		"<>",
		) or pod2usage(2);
    if (defined($options{"version"})) {
	print $0, " version ", $VERSION, "\n";
	print "(CUtils version ", $ALTree::CUtils::VERSION, 
	"; chi2.pm version ", $ALTree::Chi2::VERSION,
	"; Perl version ", $], ")\n";
	exit 0;
    }
    if (defined($options{"short-help"})) {
	pod2usage(-exitstatus => 0, -verbose => 0);
    }
    if (defined($options{"help"})) {
	pod2usage(-exitstatus => 0, -verbose => 1);
    }
    if (defined($options{"man"})) {
	pod2usage(-exitstatus => 0, -verbose => 2);
    }

    delete($options{"<>"});
    foreach my $option (keys %{$choix}) {
	delete($options{$option});
	if (exists($options{$option."-value"})) {
	    $options{$option}=$options{$option."-value"};
	    delete($options{$option."-value"});
	}
    }
    
    return \%options;
}

sub main
{
    my($rec_program);
    my $result;
    my $options;
    
    my $option_require = sub {
	my $option=shift;
	my $texte=shift;
	if (not exists($options->{$option})) {
	    my $msg="Error: option '$option' needed";
	    if (defined($texte)) {
		$msg.="\n".$texte;
	    }		
	    pod2usage("Error: option '$option' required");
	}
    };
    my $option_value = sub {
	my $option=shift;
	my $default=shift;
	my $msg=shift;
	if (not exists($options->{$option})) {
	    if (defined $msg) {
		print STDERR $msg, "\n";
	    }
	    return $default;
	}
	return $options->{$option};
    };
    my $option_selected = sub {
	my $option=shift;
	my $texte=shift;
	if (not exists($options->{$option})) {
	    my $msg="option '$option' not selected";
	    if (defined($texte)) {
		$msg.="\n".$texte;
	    }		
	    return 0;
	} else {
	    return 1;
	}
    };

    $options=manage_options();
    
    my($prolonge)=$option_value->("prolongation", 1);
    my($print_tree)=$option_value->("print-tree", 0);

    $option_require->("tree-building-program");
    my($phylo_program)=$option_value->("tree-building-program");  
    
    $option_require->("first-input-file");
    my $input_file=$option_value->("first-input-file");

    my($association)=$option_value->("association", 0);
    my($s_loc)=$option_value->("s-localisation", 0);
    if (!$association && !$s_loc) {
	erreur("Should I perform the association test or the".
	       " localisation test ?\n(use option '--association'".
	       " or '--s-localisation'.)\n", 1);
    }
    if ($option_selected->("output-file")) {
	my $out=$option_value->("output-file");
	open(STDOUT, '>', $out) 
	    or erreur("Unable to write in '$out': $!\n", 0);
    }

    my $datatype;
    my $ancetre="";
    if ($phylo_program == PhylProg::PHYLIP) {
	$option_require->("data-type");
	$datatype=$option_value->("data-type");
	if ($option_selected->("anc-seq")) {
	    $ancetre=$option_value->("anc-seq");
	}
    }

    ###########################################################
    # Rcupration et prcalcul des arbres qu'on va utiliser
    ###########################################################

    my @trees;
    {
	my($input_file)=ALTree::Input::ReadInputFile1($input_file, $phylo_program, 
						      $datatype, $ancetre);
	my $num_trees_in_file=$input_file->{"nb_trees"};

	my(@no_tree);
	my($user_tree_numbers)=$option_value->("tree-to-analyse", \@no_tree);
	my $tree_numbers=check_tree_numbers($num_trees_in_file, $user_tree_numbers);

	my $nb_tree_selected=scalar(@{$tree_numbers});
	if ($association) { 
	    if ($nb_tree_selected == 0) {
		$tree_numbers=select_trees($num_trees_in_file, 1);
	    } elsif ($nb_tree_selected > 1) {
		erreur("Only one tree can be selected for association\n");
	    }
	}
	if ($s_loc) {
	    if ($nb_tree_selected == 0) {
		my($trees_to_analyse)=$option_value->("number-of-trees-to-analyse",
						      undef);
		if (not defined($trees_to_analyse)) {
		    print STDERR "Warning: no option number-of-trees-to-analyse".
			" or tree-to-analyse: using all ($num_trees_in_file)".
			" trees";
		    $trees_to_analyse=$num_trees_in_file;
		}
		if ($trees_to_analyse>$num_trees_in_file) {
		    erreur("Invalid number of trees to analyse :".
			   " your file contains only".
			   " $num_trees_in_file trees\n", 0);
		}
		if ($trees_to_analyse<1) {
		    erreur("Not enought trees to analyse".
			   " ($trees_to_analyse)\n", 0);
		}
		$tree_numbers=select_trees($num_trees_in_file, $trees_to_analyse);
	    } elsif ($nb_tree_selected > $num_trees_in_file) {
		erreur("Invalid number of trees to analyse :".
		       " your file contains only".
		       " $num_trees_in_file trees\n", 0);
	    }
	}

	my $anctype=$input_file->{"anctype"};
	if ($anctype == ANC::Rooted && 
	    ($option_selected->("outgroup") 
	     || $option_selected->("remove-outgroup"))) {
	    erreur("You cannot use the options '--outgroup' or".
		   " '--remove-outgroup' because your input file '"
		   .$input_file->{"filename"}."' contains trees rooted".
		   " with an ancestral sequence.\n", 1);
	}
	if ($anctype == ANC::OutGroup) {
	    my $outgroup=$input_file->{"outgroup"};
	    if (defined($outgroup)) {
		if ($option_value->("outgroup", $outgroup) ne $outgroup) {
		    erreur("The option '--outgroup' tell me to use '".
			   $option_value->("outgroup")."' as an outgroup ".
			   "whereas the file '".$input_file->{"filename"}.
			   "' contains trees rooted with the outgroup '".
			   $outgroup."'.\n", 1);
		}
	    } else {
		$input_file->{"outgroup"}=$option_value->("outgroup", undef);
	    }
	}
	my ($switchroot)="";
	if ($anctype == ANC::Unrooted) {
	    $input_file->{"outgroup"}=$option_value->("outgroup", undef);
	    $switchroot=$option_value->("outgroup", 0);
	}
	if ($option_selected->("remove-outgroup")
	    && not defined($input_file->{"outgroup"})) {
	    if ($anctype == ANC::OutGroup) {
		erreur("You tell me to remove the outgroup for the".
		       " analyses. ".
		       "The input file '".$input_file->{"filename"}.
		       "' contains trees rooted using ".
		       "an outgroup but I cannot automaticaly find which one".
		       " has been used.\nPlease, provide me the outgroup".
		       " (option '--outgroup')\n", 0);
	    } else {
		erreur("You tell me to remove the outgroup for the".
		       " analyses, ".
		       "however, I do not know what is the outgroup\n".
		       "Please, use the '--outgroup' option\n", 0);
	    }
	}
	if ($association
	    && $anctype == ANC::Unrooted
	    && not defined($input_file->{"outgroup"})) {
	    erreur("I need a rooted tree to perform the association".
		   " test. However, the input file '".
		   $input_file->{"filename"}."' contains unrooted trees\n".
		   "Please, provide me an outgroup (option '--outgroup')\n"
		   , 1);
	    #erreur("I need a rooted tree to perform the association".
	#	   " test.\nThe input file '".$input_file->{"filename"}.
	#	   "' contains trees rooted using ".
	#	   "an outgroup\nbut I cannot automaticaly find which one".
	#	   " has been used.\nPlease, provide me the outgroup".
	#	   " (option '--outgroup')\n"
	#	   , 1);
	}

	my $remove_outgroup=$option_value->("remove-outgroup", 0);
	for my $num_tree (@{$tree_numbers}) {
	    my $file_tree=PrepareTree($phylo_program, $input_file, 
				      $datatype, $ancetre, $num_tree);
	    push @trees, $file_tree;

	    my ($tree)=$file_tree->{"tree"};
	    my $outgroup;
	    if (defined($input_file->{"outgroup"})) {
		$outgroup=$tree->GetNode($input_file->{"outgroup"});
		if (not defined($outgroup)) {
		    erreur ("I cannot find the outgroup '".
			    $input_file->{"outgroup"}."' in the".
			    " tree number ".($file_tree->{"index"}+1).
			    " in file '".$input_file->{"filename"}.
			    "'. It does not correspond to any node!\n", 0);
		}
		if (!$switchroot) {
		    if ($outgroup->GetFather() != $tree->GetRoot()) {
			erreur("The outgroup '".$outgroup->Name().
			       "' is not just under the root ".
			       "for the tree number ".
			       ($file_tree->{"index"}+1).
			       " in file '".$input_file->{"filename"}.
			       "'.\nDo you choose the rigth outgroup ?\n", 0);
		    }
		}
	    }
	    if ($switchroot) {
		SwitchRoot($tree, $outgroup);
	    }
	    if ($remove_outgroup) {
		RemoveOutgroup($tree, $outgroup);
	    }

	    if ($print_tree) {
		PrintTree($tree);
	    }
	    if ($s_loc && defined($file_tree->{"has_ambiguity"})) {
		erreur("Some apomorphies are ambiguous in the".
		       " tree number ".($file_tree->{"index"}+1).
		       " in file '".$input_file->{"filename"}.
		       "' (I find the character state '?').".
		       " It cannot be used for the localisation test.\n", 0);
	    }
	}
    }
    print STDERR "read done\n";
    ###########################################################
    # Let's go. D'abord pour l'association
    ###########################################################

    if ($association == 1) { 
	my($splitmode)=SplitMode::NOSPLIT; # nosplit est impos
	
	# name of the file containing haploID, nb case and nb control
	my($name_corres)=$option_value->("second-input-file", "correspond.txt");
	my($correspondance); # ref on a hash containing haploID refferring to
	# a hash containing nb case and nb control
	$correspondance=ALTree::Input::ReadCorrespond($name_corres);
	
	my($file_tree)=$trees[0];
	my($tree)=$file_tree->{"tree"};
	
	my($outgroup)=$file_tree->{"file"}->{"outgroup"};
	if (CheckCorrespondance($tree, $correspondance, $name_corres,
				$outgroup)) {
	    if (!$option_selected->("remove-outgroup")) {
		print STDERR "Warning: assuming option '--remove-outgroup' as".
		    " the outgroup '".$outgroup.
		    "' is not in the file '".$name_corres."'\n";
		
		RemoveOutgroup($tree, $tree->GetNode($outgroup));
	    }
	} else {
	    if ($option_selected->("remove-outgroup")) {
		erreur("You tell me to remove the outgroup '$outgroup',".
		       " however it is present in the file '".
		       $name_corres.". Please, check your data.'\n", 0);
	    }
	}
	#print "\n";
	FusionBrNulles($tree->GetRoot());
	# Structure change, on recalcul...
	FillHeight($tree->GetRoot(), 0);
	FillLevel($tree->GetRoot(), 0);
	FillCaseControl($tree->GetRoot(),$correspondance); 

	print "\n";
	
	my $racine=$tree->GetRoot();
	my @children=$racine->GetChildrenList();
	
	$option_require->("permutations", 
			  "The number of permutations used to calculate".
			  " exact p-values must be specified or set to 0\n");
	
	my $permutation=$option_value->("permutations");
	my($sign_util);
	if ($permutation==0) {
	    my($seuil_chi2)=$option_value->("chi2-threshold", 0.01, 
					    "Using default chi2 threshold 0.01");
	    ALTree::Chi2::definition_p_chi2($seuil_chi2, 0.01); # mettre une option 
	    # pour seuil test_prop
	    $sign_util = SignUtil::YES # on a besoin de la significativit
	    } elsif ($permutation>0) {
		$sign_util = SignUtil::NO; # on n'a pas besoin de la sign
	    } else {
		die "invalid value for the number of permutation: $permutation\n";
	    }
	parcours_nosplit_chi2split(\@children, $prolonge, $splitmode, $racine, $sign_util );
       	
	{
	    if ($permutation==0) {
		AffichageArbre($racine, \&TestInfos);
	    } elsif ($permutation>0) {
		AffichageArbre($racine, \&AssociationInfos);
		my($value_per_line, $ligne_chi2);
		($value_per_line, $ligne_chi2)=RepeatAssociation
		    ($tree, $correspondance, $prolonge,$permutation, $sign_util);
		my($corrected_values);
		$corrected_values=ALTree::CUtils::double_permutation
		    ($permutation+1, $value_per_line, $ligne_chi2);
		
		print "\n";
		print "p_val for each level:\n";
		my($i);
		for ($i=0; $i<$value_per_line; $i++) {
		    print "level ", $i+1, " p-value (non corrected) ",
		    $corrected_values->{"chi2"}->[$i], "\n";
		}
		print "corrected minimal p_value in the tree: ", 
		$corrected_values->{"pmin"}, "\n";# at level TODO\n";
	    } else {
		die "invalid value for the number of permutation: $permutation\n";
	    }
	}
    } 

    ###########################################################
    # Let's go. Et pour la localisation
    ###########################################################

    if ($s_loc==1) {
	#$option_require->("splitmode");
	#my($splitmode)=$option_value->("splitmode");
	print "Localisation method using S-character\n";
	$option_require->("s-site-number");
	my($s_site_nb)=$option_value->("s-site-number");
	$option_require->("s-site-characters");
	my($s_char_state)=$option_value->("s-site-characters");
	$option_require->("co-evo");
	my($co_evo_type)=$option_value->("co-evo");
#	print "co_evo_type=$co_evo_type\n";

#DEBUG	print "s_char_state=$s_char_state\n";
	if (not ($s_char_state =~ 
		 m/([A-Za-z0-9]+)\s*[-=_]*[>]\s*([A-Za-z0-9]+)/)) {
	    erreur("Invalid character change for character".
		   " S. It should be Anc -> Der\n", 0);
	}
	my($s_anc)=$1;
	my($s_der)=$2;
	my($s_state)= ALTree::Sens->New($s_anc." --> ".$s_der);
	my($foret)=ALTree::Foret->New();
	

	#$Data::Dumper::Indent = 0;
	for my $file_tree (@trees) {
	    my $tree=$file_tree->{"tree"};
	    
	    my ($b_t)=$tree->GetNbBrNonNulle();

	    my $site=$tree->GetSite($s_site_nb);
	    if (not defined($site)) {
		erreur("Invalid value ($s_site_nb) for".
		       " --s-site-number\n", 0);
	    }

	    my($s_t, $s_t_rev)=CalculateRit($tree, $s_site_nb, $s_state, 
					    $co_evo_type); 
	    CalculateEit($tree, $s_site_nb, $s_t, $s_t_rev, $b_t);
	    $foret->AddTree($tree);
	}
	$foret->CalculVi();
	#PrintAllVi($foret, $s_site_nb);# Non tri
	#PrintViMax($foret, $s_site_nb); # Affiche la liste en choisissant
	#pour chaque sit, juste le meilleur sens
	print "\n";
	print "Results:\n";
	PrintViMaxSens($foret, $s_site_nb);
	
    }
}


sub PleinInfos {
    my $node=shift;
    
    my $suite=""; #"\nligne suivante\net encore aprs\n ";
    if (defined ($node->{"father"})) {
	return Name($node). "\nFrom: ". Name($node->{"father"}).$suite;
    } else {
	return Name($node).$suite;
    }
}

use FileHandle;
use IPC::Open2;
sub my_test {
    my $pid;
    
    $pid = open2(*Reader, *Writer, "phylip mix" );
    print Writer "r\no\n6\nw\na\n5\ny\nweight\nr\n";
    while (<Reader>) {
	print "PHYL: ", $_;
    }
    
}

#my_test;
#exit 0;

main;

#man perlpod

__END__
    
=head1 NAME

altree - Analysing phylogeny trees

=head1 SYNOPSIS

altree [options]

 Options:
    --version        program version
    --short-help|h   brief help message
    --help           help message with options descriptions
    --man            full documentation
    --association|a  perform the association test
    --s-localisation|l   perform the localisation using the S character
    --first-input-file|i result_file from phylogeny reconstruction programs
    --second-input-file|j file containing the nb of cases/controls carrying an haplotype
    --output-file|o output_file
    --data-type|t DNA|SNP
    --outgroup outgroup_name
    --remove-outgroup 
    --tree-building-program|p phylip|paup|paml
    --splitmode|s nosplit|chi2split
    --prolongation|b
    --chi2-threshold|n value
    --permutations|r number
    --number-of-trees-to-analyse number
    --tree-to-analyse number
    --s-site-number number
    --s-site-characters ancestral state -> derived state
    --co-evo|e simple|double
    --print-tree 
    --anc-seq ancestral sequence (only with phylip)

=head1 OPTIONS

=over 8

=item B<--version>

Print the program version and exits.

=item B<--short-help>

Print a brief help message and exits.

=item B<--help>

Print a help message with options descriptions and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--association|a>

Perform the association test

=item B<--s-localisation|l>

Localise the susceptibility locus using the "S-character method"

=item B<--first-input-file|i> F<result_file>

Input file 1 (paup, phylip or paml results file)

=item B<--second-input-file|j> F<correspond_file>

Input file 2, default F<correspond.txt>

=item B<--output-file|o> outfile

Output file

=item B<--data-type|t> C<DNA>|C<SNP>

Type of data: DNA (ATGCU) or SNP (0-1)

=item B<--outgroup>  C<outgroup>

Root the tree with this outgroup

=item B<--remove-outgroup>

Remove the outgroup of the tree before performing the tests

=item B<--tree-building-program|p> C<phylip>|C<paup>|C<paml>

Phylogeny reconstruction program

=item B<--splitmode|s> C<nosplit>|C<chi2split>
    
how tests are performed from a level to another

=item B<--prolongation|b>

Prolongation of branches in the tree

=item B<--chi2-threshold|n> value

Significance threshold for chi2 (default value 0.01)

=item B<--permutations|r> number

Number of permutations used to calculate exact p_values
(Only for association test)

=item B<--number-of-trees-to-analyse> number

Number of trees to analyse in the localisation analysis 
(only for localisation method using S-character)

=item B<--tree-to-analyse number>

With this option, you can specify the tree to use (instead of
random). Can be used several times to specify multiple trees.

=item B<--s-site-number number>

Number of the S character site in the sequence
(only for localisation method using S-character)

=item B<s-site-characters>

Character states for the S character: ancestral state -> derived state
ex: G->C or 0->1  (only for localisation method using S-character)

=item B<co-evo|e>

Type of co-evolution indice 
  simple: only the anc -> der transition of S is used 
  double: the two possible transitions are used

=item B<print-tree>

If this option is selected, the tree will be printed to the output

=item B<anc-seq>

With this option, you can specify the ancestral sequence.
This option is only useful when the tree is reconstructed using the mix program of phylip with the ancestral states specified in the file "ancestors"

=back

=head1 DESCRIPTION

B<This program> will read the given input file(s) and do someting
useful with the contents thereof.

=cut
