dir /home/moumou/tmp/newtcltcc-0.9.25
<pre>can't create procedure "::tcc::Log": unknown namespace
    while executing
"proc ::tcc::Log {args} {
    # puts $args
}"
    (file "/home/moumou/tmp/newtcltcc-0.9.25/tcc.tcl" line 76)
    invoked from within
"source /home/moumou/tmp/newtcltcc-0.9.25/tcc.tcl"
    (in namespace eval "::request" script line 4)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)<hr/><p>OUTPUT BUFFER:</p>#!/usr/local/bin/tclsh

#package require tcc
source /home/moumou/tmp/newtcltcc-0.9.25/tcc.tcl
source tcc2.tcl

proc Data {{nseq 20} {lens 100}} {
    set ll [list A C D E F G H I K L M N P Q R S T V W Y . . . . . . . . . . . . . . . . . . . . .]
    for {set n 0} {$n < $nseq} {incr n} {
	set seq ""
	for {set i 0} {$i < $lens} {incr i} {
	    append seq [lindex $ll [expr {round(40*rand())}]]
	}
	lappend Lseq $seq
	lappend Lnom "S$n"
    }

    return [list $Lnom $Lseq]
}

proc CreePiliers {Ls} {
    set l [string length [lindex $Ls 0]]
    for {set i 0} {$i < $l} {incr i} {
	set p ""
	foreach s $Ls {
	    append p [string index $s $i]
	}
	lappend Lp $p
    }

    return $Lp
}

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

proc C_Random {alen} {

    tcc::reset
    tcc::ccode {
#include <stdio.h>
#include <stdlib.h>
#include <tcl.h>
    }
    tcc::ccommand Crand {dummy interp objc objv} {
	int i, seed, ip, alen;
	double rd;
	Tcl_Obj *Lrd;

	Tcl_GetIntFromObj(interp,objv[1],&alen);

	seed = 280167;
	srand(seed);
	Lrd = Tcl_NewListObj(0,NULL);
	for (i=0;i<alen;i++) {
	    rd = ((double)rand()/((double)(RAND_MAX)+(double)(1)));
	    ip = (int)(rd*(double)alen);
	    
	    Tcl_ListObjAppendElement(interp,Lrd,Tcl_NewIntObj(ip));
	}
	
	Tcl_SetObjResult(interp,Lrd);
	return TCL_OK;
    }

    return [Crand $alen]
}

proc T_NRIdentite {a lga b lgb} {

    foreach ca $a cb $b {
	incr p [expr {$ca ne "." && $ca eq $cb}]
    }

    return [expr {$lga>$lgb?$p*1.0/$lga:$p*1.0/$lgb}]
}


proc T_pci {Ln Ls} {
    global PCT

    foreach s $Ls {
	lappend Ll [string length [string map [list "." ""] $s]]
	lappend Ns [split $s ""]
    }
    set Ls $Ns

    set i 1
    foreach s1 [lrange $Ls 0 end-1] n1 [lrange $Ln 0 end-1] l1 [lrange $Ll 0 end-1] {
	set PCT($n1,$n1) 1.0
	foreach s2 [lrange $Ls $i end] n2 [lrange $Ln $i end] l2 [lrange $Ll $i end] {
	    set pc [T_NRIdentite $s1 $l1 $s2 $l2]
	    set PCT($n1,$n2) $pc
	    set PCT($n2,$n1) $pc
	}
	incr i
    }

    return
}

proc C_pci {Ln Ls} {
    global PCC

    set M [C_AllPaires $Ls]

    set i 1
    foreach n1 [lrange $Ln 0 end-1] {
	set PCC($n1,$n1) 1.0
	set Lp [lindex $M [expr {$i-1}]]
	set x 0
	foreach n2 [lrange $Ln $i end] {
	    set p [lindex $Lp $x]
	    set PCC($n1,$n2) $p
	    set PCC($n2,$n1) $p
	    incr x
	}
	incr i
    }

    return
}


proc C_Bootstrap {Ln Lpil Lr} {
    global nboot MC

    puts "Lr [llength $Lr]" ; flush stdout
    tcc::reset
    tcc::ccode {
	#include <stdio.h>
	#include <stdlib.h>
	#include <tcl.h>
	static double
	SeqMatch(char *seq1, char *seq2, int l)
	{
	    int l1, l2, r, i;
	    double ratio;
	    
	    l1 = l2 = r = 0;
	    for (i=0;i<l;i++) {
		if (seq1[i] != '.') l1++;
		if (seq2[i] != '.') l2++;
		if (seq1[i] != '.' && seq1[i] == seq2[i]) r++;
	    }
	    
	    l=((l1>l2) ? l1 : l2);
	    if (l<=0) {
		ratio=0.0;
	    } else {
		ratio = ((double) r)/l;
	    }
	    
	    return ratio;
	}
    }
    
    
    tcc::ccommand C_DoBootstrap {dummy interp objc objv} {
	char *pil0, *pil;
	char **tseq=NULL;
	int seed, ip, nseq, l, r, i, j, alen, nboot;
	Tcl_Obj *matrix, *row, **lstr;
	double ratio, rd;
	
	int pobjc;
	Tcl_Obj **pobjv;
	
	if (objc!=3) {
	    Tcl_WrongNumArgs(interp,1,objv,"listpil");
	    return TCL_ERROR;
	}
	
	if (Tcl_ListObjGetElements(interp,objv[1],&pobjc,&pobjv)!=TCL_OK) {
	    return TCL_ERROR;
	}
	alen  = pobjc;

	if (Tcl_ListObjGetElements(interp,objv[2],&nboot,&lstr)!=TCL_OK) {
	    return TCL_ERROR;
	}

	//printf("nboot %d\n",nboot);
	//fflush(stdout);
	
	//seed = 280167;
	//srand(seed);
	
	// printf("RAND_MAX = %u\n", RAND_MAX); 
	pil0=Tcl_GetByteArrayFromObj(pobjv[1],&nseq);
	// printf("nseq= %d\n",nseq);
	// fflush(stdout);
	
	tseq = (char **)calloc(nseq+1,sizeof(char *));
	for (i=0; i<nseq; i++) { 
	    tseq[i]= (char *)calloc(alen+1, sizeof(char));
	}
	tseq[nseq] = NULL;
	
	for (i=0;i<alen;i++) {
	    //rd = ((double)rand()/((double)(RAND_MAX)+(double)(1)));
	    //ip = (int)(rd*(double)alen);
	    Tcl_GetIntFromObj(interp,lstr[i],&ip);

	    //printf("%d choose ip %d\n",i ,ip);
	    //fflush(stdout);
	    pil=Tcl_GetByteArrayFromObj(pobjv[ip],&nseq);
	    //printf("pilier %d\n%s\n",ip ,pil);
	    //fflush(stdout);
	    for (j=0;j<nseq;j++) {
		//printf("i=%d j=%d %c\n",i,j,pil[j]);
		//fflush(stdout);
		tseq[j][i]=pil[j];
	    }
	}
	
	matrix = Tcl_NewListObj(0,NULL);
	for (i=0;i<nseq-1;i++) {
	    row = Tcl_NewListObj(0,NULL);
	    for (j=i+1;j<nseq;j++) {
		ratio = SeqMatch(tseq[i],tseq[j],alen);
		Tcl_ListObjAppendElement(interp,row,Tcl_NewDoubleObj(ratio));
	    }
	    Tcl_ListObjAppendElement(interp,matrix,row);
	}
	
	Tcl_SetObjResult(interp,matrix);
	return TCL_OK;
    }
        
    for {set i 0} {$i < $nboot} {incr i} {
	set MC($i) [C_DoBootstrap $Lpil $Lr]
    }

    return
}

proc T_Bootstrap {Ln Lpil Lr} {
    global nboot MT

    set nbs [llength $Ln]
    set lgs [llength $Lpil]

    for {set k 0} {$k < $nbs} {incr k} {
	lappend fvar s$k
    }

    for {set bt 0} {$bt < $nboot} {incr bt} {
	set ListeArbres 0
	set NewA [list]
	set Lr [list]

	#for {set col 0} {$col < $lgs} {incr col} 
	foreach H $Lr {
	    #set H [expr {int((${lgs}-1)*rand())}]
	    
	    for {set i 0} {$i < $nbs} {incr i} {
		lappend l$i [lindex [lindex $Lpil $H] $i]
	    }
	}
	
	for {set i 0} {$i < $nbs} {incr i} {
	    lappend NewA [set l$i]
	    lappend Lr [string length [string map [list "." ""] [join [set l$i] ""]]]
	    set l$i {}
	}
	
	set i 1
	foreach n1 $Ln s1 $NewA l1 $Lr {
	    set TPCI($n1,$n1) 0.0
	    foreach n2 [lrange $Ln $i end] s2 [lrange $NewA $i end] l2 [lrange $Lr $i end] {
		set pcid [expr {1.0-[T_NRIdentite $s1 $l1 $s2 $l2]}]
		set TPCI($n1,$n2) $pcid
		set TPCI($n2,$n1) $pcid
	    }
	    incr i
	}

	set i 1
	foreach n1 [lrange $Ln 0 end-1] {
	    set row [list]
	    foreach n2 [lrange $Ln $i end] {
		lappend row [set TPCI($n1,$n2)]
	    }
	    lappend MT($bt) $row
	}
    }

    return
}


proc AnaBoot {} {
    global MT MC nboot

    for {set i 0} {$i < $nboot} {incr i} {
	set Lc [set MC($i)]
	set Lt [set MT($i)]
	puts "\nBoot No $i"
	foreach c $Lc t $Lt {
	    foreach s $c q $t {
		if {abs($s-$q) < 1.0e-5} {
		    puts "diff de val"
		}
	    }
	}
    }

    return
}

set ALen 300
set NSeq 30

set nboot 3
lassign [Data $NSeq $ALen] Lnom Lseq
set Lpil [CreePiliers $Lseq]
#puts "pil0 : [lindex $Lpil 0]"

#puts "T_pci : [time {T_pci $Lnom $Lseq}]"
#puts "C_pci : [time {C_pci $Lnom $Lseq}]"

set Lrand [C_Random $ALen]

puts "C_Bootstrap : [time {C_Bootstrap $Lnom $Lpil $Lrand}]"
puts "T_Bootstrap : [time {T_Bootstrap $Lnom $Lpil $Lrand}]"
</pre>