X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fchdtxt.R;h=0a6350a1b8d3620cb783495cf9cd31f7bcabf6bc;hp=a6c2d4cfc59b9856c8b122cbd15a74c5c4150509;hb=5f12c0323a321a9fc4f09f3720d77ce0d65d1c3a;hpb=22cd27b2bbe9ab1ffa7ef06fa764b5147ae17dad

diff --git a/Rscripts/chdtxt.R b/Rscripts/chdtxt.R
index a6c2d4c..0a6350a 100644
--- a/Rscripts/chdtxt.R
+++ b/Rscripts/chdtxt.R
@@ -1,44 +1,14 @@
 #Author: Pierre Ratinaud
 #Copyright (c) 2008-2009 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
 
 
 #fonction pour la double classification
 #cette fonction doit etre splitter en 4 ou 5 fonctions
 
-#Rchdtxt<-function(tableuc1,tableuc2,listeuce1,listeuce2,arbre1,arbre2,uceout) {
-	#source('/home/pierre/workspace/iramuteq/Rscripts/CHD.R')
-
-	#lecture des tableaux
-#	data1<-read.csv2(tableuc1)
-#	data2<-read.csv2(tableuc2)
-
-	#analyse des tableaux avec la fonction CHD qui doit etre sourcee avant
-#	chd1<-CHD(data1)
-#	chd2<-CHD(data2)
-
-	#lecture des uce
-#	listuce1<-read.csv2(listeuce1)
-#	listuce2<-read.csv2(listeuce2)
-
-	#Une fonction pour assigner une classe a chaque UCE
-#AssignClasseToUce<-function(listuce,chd) {
-#    out<-matrix(nrow=nrow(listuce),ncol=ncol(chd))
-#    for (i in 1:nrow(listuce)) {
-#		for (j in 1:ncol(chd)) {
-#		    out[i,j]<-chd[(listuce[i,2]+1),j]
-#		}
-#    }
-#    out
-#}
-
 AssignClasseToUce <- function(listuce, chd) {
     print('assigne classe -> uce')
-    out<-matrix(nrow=nrow(listuce),ncol=ncol(chd))
-    for (j in 1:ncol(chd)) {
-        out[listuce[,1]+1, j] <- chd[listuce[,2]+1, j]
-    }
-    out
+    chd[listuce[,2]+1,]
 }
 
 fille<-function(classe,classeuce) {
@@ -47,8 +17,189 @@ fille<-function(classe,classeuce) {
 	listf<-unique(listf)
 	listf
 }
+
+
+croiseeff <- function(croise, classeuce1, classeuce2) {
+    cl1 <- 0
+    cl2 <- 1
+    for (i in 1:ncol(classeuce1)) {
+        cl1 <- cl1 + 2
+        cl2 <- cl2 + 2
+        clj1 <- 0
+        clj2 <- 1
+        for (j in 1:ncol(classeuce2)) {
+            clj1 <- clj1 + 2
+            clj2 <- clj2 + 2
+            croise[cl1 - 1, clj1 -1] <- length(which(classeuce1[,i] == cl1 & classeuce2[,j] == clj1))
+            croise[cl1 - 1, clj2 -1] <- length(which(classeuce1[,i] == cl1 & classeuce2[,j] == clj2))
+            croise[cl2 - 1, clj1 -1] <- length(which(classeuce1[,i] == cl2 & classeuce2[,j] == clj1))
+            croise[cl2 - 1, clj2 -1] <- length(which(classeuce1[,i] == cl2 & classeuce2[,j] == clj2))
+        }
+    }
+    croise
+}
+
+addallfille <- function(lf) {
+    nlf <- list()
+    for (i in 1:length(lf)) {
+        if (! is.null(lf[[i]])) {
+            nlf[[i]] <- lf[[i]]
+            filles <- lf[[i]]
+            f1 <- filles[1]
+            f2 <- filles[2]
+            if (f1 > length(lf)) {
+                for (j in (length(lf) + 1):f2) {
+                    nlf[[j]] <- 0
+                }
+            }
+        } else {
+            nlf[[i]] <- 0
+        }
+    }
+nlf
+}
+
+getfille <- function(nlf, classe, pf) {
+    if (!length(nlf[[classe]])) {
+        return(pf)
+    } else {
+		for (cl in nlf[[classe]]) {
+			pf <- c(pf, cl)
+			if (cl <= length(nlf)) {
+				pf <- getfille(nlf, cl, pf)
+			}
+		}
+	} 
+    return(pf)
+}
+
+getmere <- function(list_mere, classe) {
+    i <- as.numeric(classe)
+    pf <- NULL
+    while (i != 1 ) {
+        pf <- c(pf, list_mere[[i]])
+        i <- list_mere[[i]]
+    }
+    pf
+}
+
+getfillemere <- function(list_fille, list_mere, classe) {
+    return(c(getfille(list_fille, classe, NULL), getmere(list_mere, classe)))
+}
+
+getlength <- function(n1, clnb) {
+	colnb <- (clnb %/%2)
+	tab <- table(n1[,colnb])
+	eff <- tab[which(names(tab) == as.character(clnb))]
+	return(eff)
+}
+
+
+find.terminales <- function(n1, list_mere, list_fille, mincl) {
+	tab <- table(n1[,ncol(n1)])
+	clnames <- rownames(tab)
+	terminales <- clnames[which(tab >= mincl)]
+	tocheck <- setdiff(clnames, terminales)
+	if ("0" %in% terminales) {
+		terminales <- terminales[which(terminales != 0)]
+	}
+	if (length(terminales) == 0) {
+		return('no clusters')
+	}
+	if ("0" %in% tocheck) {
+		tocheck <- tocheck[which(tocheck != "0")]
+	}
+	print(terminales)
+	print(tocheck)
+	while (length(tocheck)!=0) {
+		for (val in tocheck) {
+			print(val)
+			mere <- list_mere[[as.numeric(val)]]
+			print('mere')
+			print(mere)
+			if (mere != 1) {
+				ln.mere <- getlength(n1, mere)
+				print('ln.mere')
+				print(ln.mere)
+				filles.mere <- getfille(list_fille, mere, NULL)
+				print('fille mere')
+				print(filles.mere)
+				filles.mere <- filles.mere[which(filles.mere != val)]
+				print(filles.mere)
+				if ((ln.mere >= mincl) & (length(intersect(filles.mere, tocheck)) == 0) & (length(intersect(filles.mere, terminales)) == 0 )) {
+					print('mere ok')
+					terminales <- c(terminales, mere)
+					for (f in c(filles.mere, val, mere)) {
+						tocheck <- tocheck[which(tocheck != f)]
+					}	
+				} else if ((ln.mere >= mincl) & (length(intersect(filles.mere, terminales)) == 0) & (length(intersect(filles.mere, tocheck))!=0)){
+					print('mere a checke cause fille ds tocheck')
+					tocheck <- tocheck[which(tocheck != val)]
+					tocheck <- c(mere, tocheck)
+
+				} else {
+					print('pas ok on vire du check')
+					tocheck <- tocheck[which(tocheck != val)]
+				}
+			} else {
+				print('mere == 1')
+				tocheck <- tocheck[which(tocheck != val)]
+			}
+			print('tocheck')
+			print(tocheck)
+		}
+		print(tocheck)
+	}
+	terminales
+}
+
+make.classes <- function(terminales, n1, tree, lf) {
+	term.n1 <- unique(n1[,ncol(n1)])
+	tree.tip <- tree$tip.label
+	cl.n1 <- n1[,ncol(n1)]
+	classes <- rep(NA, nrow(n1))
+	cl.names <- 1:length(terminales)
+	new.cl <- list()
+	for (i in 1:length(terminales)) {
+		if (terminales[i] %in% term.n1) {
+			classes[which(cl.n1==terminales[i])] <- cl.names[i]
+			new.cl[[terminales[i]]] <- cl.names[i]
+			tree.tip[which(tree.tip==terminales[i])] <- paste('a', cl.names[i], sep='')
+		} else {
+			filles <- getfille(lf, as.numeric(terminales[i]), NULL)
+			tochange <- intersect(filles, term.n1)
+			for (cl in tochange) {
+				classes[which(cl.n1==cl)] <- cl.names[i]
+				new.cl[[cl]] <- cl.names[i]
+				tree.tip[which(tree.tip==cl)] <- paste('a', cl.names[i], sep='')
+			}
+		}
+	}
+	make.tip <- function(x) {
+		if (substring(x,1,1)=='a') {
+			return(substring(x,2))
+		} else { 
+			return(0)
+		}
+	}
+	tree$tip.label <- tree.tip
+	ntree <- tree
+	tree$tip.label <- sapply(tree.tip, make.tip)
+	tovire <- sapply(tree.tip, function(x) {substring(x,1,1)!='a'})
+	tovire <- which(tovire)
+	ntree <-  drop.tip(ntree, tip=tovire)
+	en.double <- ntree$tip.label[duplicated(ntree$tip.label)]
+	en.double <- unique(en.double)
+	tovire <- sapply(en.double, function(x) {which(ntree$tip.label == x)[1]})
+	ntree <-  drop.tip(ntree, tip=tovire)
+	ntree$tip.label <- sapply(ntree$tip.label, function(x) {substring(x,2)})
+	classes[which(is.na(classes))] <- 0
+	res <- list(dendro_tot_cl = tree, tree.cl = ntree, n1=as.matrix(classes))
+	res
+}
+
 #nbt nbcl = nbt+1 tcl=((nbt+1) *2) - 2  n1[,ncol(n1)], nchd1[,ncol(nchd1)]
-Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
+Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 	#FIXME: le nombre de classe peut etre inferieur
     nbcl <- nbt + 1
     tcl <- ((nbt+1) * 2) - 2
@@ -56,210 +207,469 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	classeuce1<-AssignClasseToUce(listuce1,chd1$n1)
 	if (classif_mode==0) {
 		classeuce2<-AssignClasseToUce(listuce2,chd2$n1)
-    } else {
-		classeuce2<-classeuce1
-    }
+	}
+	#} else {
+	#	classeuce2<-classeuce1
+    #}
 
 	#calcul des poids (effectifs)
 
-	makepoids<-function(classeuce,poids) {
-	    for (classes in 2:(tcl + 1)){
-		for (i in 1:ncol(classeuce)) {
-		    if (poids[(classes-1)]<length(classeuce[,i][classeuce[,i]==classes])) {
-		        poids[(classes-1)]<-length(classeuce[,i][classeuce[,i]==classes])
-		    }
-		}
-	    }
-	    poids
-	}
+    makepoids <- function(classeuce, poids) {
+        cl1 <- 0
+        cl2 <- 1
+        for (i in 1:nbt) {
+            cl1 <- cl1 + 2
+            cl2 <- cl2 + 2
+            poids[cl1 - 1] <- length(which(classeuce[,i] == cl1))
+            poids[cl2 - 1] <- length(which(classeuce[,i] == cl2))
+        }
+        poids
+    }
+
+#	makepoids<-function(classeuce,poids) {
+#	    for (classes in 2:(tcl + 1)){
+#		    for (i in 1:ncol(classeuce)) {
+#		        if (poids[(classes-1)]<length(classeuce[,i][classeuce[,i]==classes])) {
+#		            poids[(classes-1)]<-length(classeuce[,i][classeuce[,i]==classes])
+#		        }
+#		    }
+#	    }
+#	    poids
+#	}
+    print('make poids')
 	poids1<-vector(mode='integer',length = tcl)
 	poids1<-makepoids(classeuce1,poids1)
 	if (classif_mode==0) {
 		poids2<-vector(mode='integer',length = tcl)
 		poids2<-makepoids(classeuce2,poids2)
-	} else {
-		poids2<-poids1
-	}
+	}# else {
+	#	poids2<-poids1
+	#}
+    
+    print('croisement classif')
 
-	croise=matrix(ncol=tcl,nrow=tcl)
-	#production du tableau de contingence
-	for (i in 1:ncol(classeuce1)) {
-	    #poids[i]<-length(classeuce1[,i][x==classes])
-	    for (j in 1:ncol(classeuce2)) {
-		tablecroise<-table(classeuce1[,i],classeuce2[,j])
-		tabcolnames<-as.numeric(colnames(tablecroise))
-		#tabcolnames<-c(tabcolnames[(length(tabcolnames)-1)],tabcolnames[length(tabcolnames)])
-		tabrownames<-as.numeric(rownames(tablecroise))
-		#tabrownames<-c(tabrownames[(length(tabrownames)-1)],tabrownames[length(tabrownames)])
-		for (k in (ncol(tablecroise)-1):ncol(tablecroise)) {
-		    for (l in (nrow(tablecroise)-1):nrow(tablecroise)) {
-		        croise[(tabrownames[l]-1),(tabcolnames[k]-1)]<-tablecroise[l,k]
-		    }
-		}
-	    }
-	    tablecroise
+#    croise=matrix(ncol=tcl,nrow=tcl)
+#
+#    docroise <- function(croise, classeuce1, classeuce2) {
+#    	#production du tableau de contingence
+#    	for (i in 1:ncol(classeuce1)) {
+#    	    #poids[i]<-length(classeuce1[,i][x==classes])
+#    	    for (j in 1:ncol(classeuce2)) {
+#    		    tablecroise<-table(classeuce1[,i],classeuce2[,j])
+#    		    tabcolnames<-as.numeric(colnames(tablecroise))
+#    		    #tabcolnames<-c(tabcolnames[(length(tabcolnames)-1)],tabcolnames[length(tabcolnames)])
+#    		    tabrownames<-as.numeric(rownames(tablecroise))
+#    		    #tabrownames<-c(tabrownames[(length(tabrownames)-1)],tabrownames[length(tabrownames)])
+#    		    for (k in (ncol(tablecroise)-1):ncol(tablecroise)) {
+#    		        for (l in (nrow(tablecroise)-1):nrow(tablecroise)) {
+#    		            croise[(tabrownames[l]-1),(tabcolnames[k]-1)]<-tablecroise[l,k]
+#    		        }
+#    		    }
+#    	    }
+#    	}
+#        croise
+#    }
+	if (classif_mode==0) {
+    	croise <- croiseeff( matrix(ncol=tcl,nrow=tcl), classeuce1, classeuce2)
+	} else {
+		croise <- croiseeff( matrix(ncol=tcl,nrow=tcl), classeuce1, classeuce1)
 	}
+    #print(croise)
     if (classif_mode == 0) {ind <- (nbcl * 2)} else {ind <- nbcl}
 	if (mincl==0){
 		mincl<-round(nrow(classeuce1)/ind)
-	}#valeur a calculer nbuce/20
-	if (mincl<3){
-		mincl<-3
 	}
+	#if (mincl<3){
+	#	mincl<-3
+	#}
     print(mincl)	
 	#print('table1')
 	#print(croise)
 	#tableau des chi2 signes
-	chicroise<-croise
-	for (i in 1:nrow(croise)) {
-	    for (j in 1:ncol(croise)) {
-		if (croise[i,j]==0) {
-		    chicroise[i,j]<-0
-		} else if (croise[i,j]<mincl) { 
-		    chicroise[i,j]<-0
-		} else {
-		chitable<-matrix(ncol=2,nrow=2)
-		chitable[1,1]<-croise[i,j]
-		chitable[1,2]<-poids1[i]-chitable[1,1]
-		chitable[2,1]<-poids2[j]-chitable[1,1]
-		chitable[2,2]<-nrow(classeuce1)-poids2[j]-chitable[1,2]
-		chitest<-chisq.test(chitable,correct=FALSE)
-		if ((chitable[1,1]-chitest$expected)<0) {
-		    chicroise[i,j]<--round(chitest$statistic,digits=7)
-		} else {
-		    chicroise[i,j]<-round(chitest$statistic,digits=7)
-		#print(chitest)
-		}
+    print('croise chi2')
+	#chicroise<-croise
+
+#    nr <- nrow(classeuce1)
+#    newchicroise <- function(croise, mincl, nr, poids1, poids2) {
+#        chicroise <- croise
+#        chicroise[which(croise < mincl)] <- 0
+#        tocompute <- which(chicroise > 0, arr.ind = TRUE)
+#        for (i in 1:nrow(tocompute)) {
+#            chitable <- matrix(ncol=2,nrow=2)
+#            chitable[1,1] <- croise[tocompute[i,1],  tocompute[i,2]]
+#            chitable[1,2] <- poids1[tocompute[i,1]] - chitable[1,1]
+#            chitable[2,1] <- poids2[tocompute[i,2]] - chitable[1,1]
+#            chitable[2,2] <- nr - poids2[tocompute[i,2]] - chitable[1,2]
+#            chitest<-chisq.test(chitable,correct=FALSE)
+#            chicroise[tocompute[i,1],  tocompute[i,2]] <- ifelse(chitable[1,1] > chitest$expected[1,1], round(chitest$statistic,digits=7), -round(chitest$statistic,digits=7))
+#        }
+#        chicroise
+#    }
+#
+        
+
+	dochicroise <- function(croise, mincl) {
+        chicroise <- croise
+        for (i in 1:nrow(croise)) {
+	        for (j in 1:ncol(croise)) {
+	            if (croise[i,j]==0) {
+	                chicroise[i,j]<-0
+	            } else if (croise[i,j]<mincl) { 
+	                chicroise[i,j]<-0
+	            } else {
+	                chitable<-matrix(ncol=2,nrow=2)
+	                chitable[1,1]<-croise[i,j]
+	                chitable[1,2]<-poids1[i]-chitable[1,1]
+	                chitable[2,1]<-poids2[j]-chitable[1,1]
+	                chitable[2,2]<-nrow(classeuce1)-poids2[j]-chitable[1,2]
+	                chitest<-chisq.test(chitable,correct=FALSE)
+	                if ((chitable[1,1]-chitest$expected[1,1])<0) {
+	                    chicroise[i,j]<--round(chitest$statistic,digits=7)
+	                } else {
+	                    chicroise[i,j]<-round(chitest$statistic,digits=7)
+	        #print(chitest)
+	                }
+	            }
+	        }   
+	    }
+        chicroise
+    }
+
+	dochicroisesimple <- function(croise, mincl) {
+		chicroise <- croise
+		for (i in 1:nrow(croise)) {
+			for (j in 1:ncol(croise)) {
+				if (croise[i,j]==0) {
+					chicroise[i,j]<-0
+				} else if (croise[i,j]<mincl) { 
+					chicroise[i,j]<-0
+				} else {
+					chitable<-matrix(ncol=2,nrow=2)
+					chitable[1,1]<-croise[i,j]
+					chitable[1,2]<-poids1[i]-chitable[1,1]
+					chitable[2,1]<-poids1[j]-chitable[1,1]
+					chitable[2,2]<-nrow(classeuce1)-poids1[j]-chitable[1,2]
+					chitest<-chisq.test(chitable,correct=FALSE)
+					if ((chitable[1,1]-chitest$expected[1,1])<0) {
+						chicroise[i,j]<--round(chitest$statistic,digits=7)
+					} else {
+						chicroise[i,j]<-round(chitest$statistic,digits=7)
+						#print(chitest)
+					}
+				}
+			}   
 		}
-	    }   
+		chicroise
+	}
+	if (classif_mode == 0) {
+		chicroise <- dochicroise(croise, mincl)
+	} else {
+		chicroise <- dochicroisesimple(croise, mincl)
 	}
+    
+    print('fin croise')
 	#print(chicroise)
 	#determination des chi2 les plus fort
 	chicroiseori<-chicroise
-	maxi<-vector()
-	chimax<-vector()
-	for (i in 1:tcl) {
-	    maxi[i]<-which.max(chicroise)
-	    chimax[i]<-chicroise[maxi[i]]
-	    chicroise[maxi[i]]<-0
-	}
-	testpres<-function(x,listcoord) {
-	    for (i in 1:length(listcoord)) {
-		if (x==listcoord[i]) {
-		    return(-1)
-		} else {
-		    a<-1
-		}
-	    }
-	    a
-	}
-	c.len=nrow(chicroise)
-	r.len=ncol(chicroise)
-	listx<-c(0)
-	listy<-c(0)
-	rang<-0
-	cons<-list()
-	#on garde une valeur par ligne / colonne
-	for (i in 1:length(maxi)) {
-	#coordonnées de chi2 max
-	    x.co<-ceiling(maxi[i]/c.len)
-	    y.co<-maxi[i]-(x.co-1)*c.len
-	    a<-testpres(x.co,listx)
-	    b<-testpres(y.co,listy)
-	    
-	    if (a==1) {
-			if (b==1) {
-			    rang<-rang+1
-			    listx[rang]<-x.co
-			    listy[rang]<-y.co
-			}
-	    }
-	    cons[[1]]<-listx
-	    cons[[2]]<-listy
-	}
+
+    doxy <- function(chicroise) {
+        listx <- NULL
+        listy <- NULL
+        listxy <- which(chicroise > 3.84, arr.ind = TRUE)
+        #print(listxy)
+        val <- chicroise[which(chicroise > 3.84)]
+        ord <- order(val, decreasing = TRUE)
+        listxy <- listxy[ord,]
+        #for (i in 1:nrow(listxy)) {
+        #    if ((!listxy[,2][i] %in% listx) & (!listxy[,1][i] %in% listy)) {
+        #        listx <- c(listx, listxy[,2][i])
+        #        listy <- c(listy, listxy[,1][i])
+        #    }
+        #}
+        xy <- list(x = listxy[,2], y = listxy[,1])
+        xy
+    }
+    xy <- doxy(chicroise)
+    listx <- xy$x
+    listy <- xy$y
+
+#	maxi<-vector()
+#	chimax<-vector()
+#	for (i in 1:tcl) {
+#	    maxi[i]<-which.max(chicroise)
+#	    chimax[i]<-chicroise[maxi[i]]
+#	    chicroise[maxi[i]]<-0
+#	}
+#	testpres<-function(x,listcoord) {
+#	    for (i in 1:length(listcoord)) {
+#		    if (x==listcoord[i]) {
+#		        return(-1)
+#		    } else {
+#		        a<-1
+#		    }
+#	    }
+#	    a
+#	}
+#	c.len=nrow(chicroise)
+#	r.len=ncol(chicroise)
+#	listx<-c(0)
+#	listy<-c(0)
+#	rang<-0
+#	cons<-list()
+#	#on garde une valeur par ligne / colonne
+#	for (i in 1:length(maxi)) {
+#	#coordonnées de chi2 max
+#        #coord <- arrayInd(maxi[i], dim(chicroise))
+#        #x.co <- coord[1,2]
+#        #y.co <- coord[1,1]
+#	    x.co<-ceiling(maxi[i]/c.len)
+#	    y.co<-maxi[i]-(x.co-1)*c.len
+#        #print(x.co)
+#        #print(y.co)
+#        #print(arrayInd(maxi[i], dim(chicroise)))
+#	    a<-testpres(x.co,listx)
+#	    b<-testpres(y.co,listy)
+#	    
+#	    if (a==1) {
+#			if (b==1) {
+#			    rang<-rang+1
+#			    listx[rang]<-x.co
+#			    listy[rang]<-y.co
+#			}
+#	    }
+#	    cons[[1]]<-listx
+#	    cons[[2]]<-listy
+#	}
 	#pour ecrire les resultats
 	for (i in 1:length(listx)) {
 	    txt<-paste(listx[i]+1,listy[i]+1,sep=' ')
 	    txt<-paste(txt,croise[listy[i],listx[i]],sep=' ')
 	    txt<-paste(txt,chicroiseori[listy[i],listx[i]],sep=' ')
-	    print(txt)
+	    #print(txt)
 	}
-
 	#colonne de la classe
 	#trouver les filles et les meres 
 	trouvefillemere<-function(classe,chd) {
 	    unique(unlist(chd[chd[,classe%/%2]==classe,]))
 	}
 
+
+#----------------------------------------------------------------------
+    findbestcoord <- function(classeuce1, classeuce2, classif_mode, nbt) {
+        #fillemere1 <- NULL
+        #fillemere2 <- NULL
+
+        #fillemere1 <- unique(classeuce1)
+        #if (classif_mode == 0) {
+        #    fillemere2 <- unique(classeuce2)
+        #} else {
+        #    fillemere2 <- fillemere1
+        #}
+
+        #
+        listcoordok <- list()
+        maxcl <- 0
+        nb <- 0
+        lf1 <- addallfille(chd1$list_fille) 
+        if (classif_mode == 0) {
+            lf2 <- addallfille(chd2$list_fille)
+        } else {
+            lf2 <- lf1
+            listx<-listx[1:((nbt+1)*2)]
+            listy<-listy[1:((nbt+1)*2)]
+        }
+        lme1 <- chd1$list_mere
+        if (classif_mode == 0) {
+            lme2 <- chd2$list_mere
+        } else {
+            lme2 <- lme1
+        }
+        print('length listx')
+        print(length(listx))
+        #if (classif_mode == 0) {
+        for (first in 1:length(listx)) {
+            coordok <- NULL
+            f1 <- NULL
+            f2 <- NULL
+            listxp<-listx
+    	    listyp<-listy
+            
+    	    #listxp<-listx[first:length(listx)]
+    	    #listxp<-c(listxp,listx[1:(first-1)])
+    	    #listyp<-listy[first:length(listy)]
+    	    #listyp<-c(listyp,listy[1:(first-1)])
+            listxp <- listxp[order(listx, decreasing = TRUE)]
+            listyp <- listyp[order(listx, decreasing = TRUE)]
+            #listxp<-c(listxp[first:length(listx)], listx[1:(first-1)])
+            #listyp<-c(listyp[first:length(listy)], listy[1:(first-1)])
+            for (i in 1:length(listx)) {
+                if( (!(listxp[i]+1) %in% f1) & (!(listyp[i]+1) %in% f2) ) {
+                    #print(listyp[i]+1)
+                    #print('not in')
+                    #print(f2)
+                    coordok <- rbind(coordok, c(listyp[i] + 1,listxp[i] + 1))
+                    #print(c(listyp[i] + 1,listxp[i] + 1))
+                    un1 <- getfillemere(lf2, chd2$list_mere, listxp[i] + 1)
+                    f1 <- c(f1, un1)
+                    f1 <- c(f1, listxp[i] + 1)
+                    un2 <- getfillemere(lf1, chd1$list_mere, listyp[i] + 1)
+                    f2 <- c(f2, un2)
+                    f2 <- c(f2, listyp[i] + 1)
+                }
+                #print(coordok)
+            }
+            #if (nrow(coordok) > maxcl) {
+                nb <- 1
+            #    listcoordok <- list()
+                listcoordok[[nb]] <- coordok
+            #    maxcl <- nrow(coordok)
+            #} else if (nrow(coordok) == maxcl) {
+                nb <- nb + 1
+            #    listcoordok[[nb]] <- coordok
+            #}
+        }
+        #} else {
+#            stopid <- ((nbt+1) * 2) - 2
+#            for (first in 1:stopid) {
+#                coordok <- NULL
+#                f1 <- NULL
+#                f2 <- NULL
+#                listxp<-listx
+#                listyp<-listy
+#                
+#                #listxp<-listx[first:length(listx)]
+#                #listxp<-c(listxp,listx[1:(first-1)])
+#                #listyp<-listy[first:length(listy)]
+#                #listyp<-c(listyp,listy[1:(first-1)])
+#                listxp <- listxp[order(listx, decreasing = TRUE)]
+#                listyp <- listyp[order(listx, decreasing = TRUE)]
+#                #listxp<-c(listxp[first:length(listx)], listx[1:(first-1)])
+#                #listyp<-c(listyp[first:length(listy)], listy[1:(first-1)])
+#                for (i in 1:stopid) {
+#                    if( (!(listxp[i]+1) %in% f1) & (!(listyp[i]+1) %in% f2) ) {
+#                        #print(listyp[i]+1)
+#                        #print('not in')
+#                        #print(f2)
+#                        coordok <- rbind(coordok, c(listyp[i] + 1,listxp[i] + 1))
+#                        #print(c(listyp[i] + 1,listxp[i] + 1))
+#                        un1 <- getfillemere(lf2, chd2$list_mere, listxp[i] + 1)
+#                        f1 <- c(f1, un1)
+#                        f1 <- c(f1, listxp[i] + 1)
+#                        un2 <- getfillemere(lf1, chd1$list_mere, listyp[i] + 1)
+#                        f2 <- c(f2, un2)
+#                        f2 <- c(f2, listyp[i] + 1)
+#                    }
+#                    #print(coordok)
+#                }
+#                #if (nrow(coordok) > maxcl) {
+#                nb <- 1
+#                #    listcoordok <- list()
+#                listcoordok[[nb]] <- coordok
+#                #    maxcl <- nrow(coordok)
+#                #} else if (nrow(coordok) == maxcl) {
+#                nb <- nb + 1
+#                #    listcoordok[[nb]] <- coordok
+#                #}
+#            }            
+#        }
+        #print(listcoordok)
+        listcoordok <- unique(listcoordok)
+        print(listcoordok)
+        best <- 1
+        if (length(listcoordok) > 1) {
+            maxchi <- 0
+            for (i in 1:length(listcoordok)) {
+                chi <- NULL
+                uce <- NULL
+                for (j in 1:nrow(listcoordok[[i]])) {
+                    chi<-c(chi,chicroiseori[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
+                    uce<-c(uce,croise[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
+                }
+            	if (maxchi < sum(chi)) {
+            	    maxchi <- sum(chi)
+            	    suce <- sum(uce)
+            	    best <- i
+            	}
+            }
+        print(suce/nrow(classeuce1))
+        }
+        listcoordok[[best]]
+    }
+#---------------------------------------------------------------------------------   
 	#pour trouver une valeur dans une liste
 	#is.element(elem, list)
 	#== elem%in%list
-
-	coordok<-NULL
-	trouvecoordok<-function(first) {
-	    fillemere1<-NULL
-	    fillemere2<-NULL
-	    listxp<-listx
-	    listyp<-listy
-	    listxp<-listx[first:length(listx)]
-	    listxp<-c(listxp,listx[1:(first-1)])
-	#    listxp<-listxp[-first]
-	    listyp<-listy[first:length(listy)]
-	    listyp<-c(listyp,listy[1:(first-1)])
-	#    listyp<-listyp[-first]
-	    for (i in 1:length(listxp)) {
-	       if (!(listxp[i]+1)%in%fillemere1) {
-		  if (!(listyp[i]+1)%in%fillemere2) {
-		  coordok<-rbind(coordok,c(listyp[i]+1,listxp[i]+1))
-		  fillemere1<-c(fillemere1,trouvefillemere(listxp[i]+1,chd2$n1))
-		  fillemere2<-c(fillemere2,trouvefillemere(listyp[i]+1,chd1$n1))
-		  }
-	       }
-	    }
+    oldfindbestcoord <- function(listx, listy) {
+    	coordok<-NULL
+    	trouvecoordok<-function(first) {
+    	    fillemere1<-NULL
+    	    fillemere2<-NULL
+    	    listxp<-listx
+    	    listyp<-listy
+    	    listxp<-listx[first:length(listx)]
+    	    listxp<-c(listxp,listx[1:(first-1)])
+    	    listyp<-listy[first:length(listy)]
+    	    listyp<-c(listyp,listy[1:(first-1)])
+    	    for (i in 1:length(listxp)) {
+    	        if (!(listxp[i]+1)%in%fillemere1) {
+    		        if (!(listyp[i]+1)%in%fillemere2) {
+    		            coordok<-rbind(coordok,c(listyp[i]+1,listxp[i]+1))
+    		            fillemere1<-c(fillemere1,trouvefillemere(listxp[i]+1,chd2$n1))
+    		            fillemere2<-c(fillemere2,trouvefillemere(listyp[i]+1,chd1$n1))
+    		        }
+    	       }
+    	    }
+    	    coordok
+    	}
+    #fonction pour trouver le nombre maximum de classes
+    	findmaxclasse<-function(listx,listy) {
+    	    listcoordok<-list()
+    	    maxcl<-0
+    	    nb<-1
+    	    for (i in 1:length(listy)) {
+    			coordok<-trouvecoordok(i)
+    			if (maxcl <= nrow(coordok)) {
+    			    maxcl<-nrow(coordok)
+    			    listcoordok[[nb]]<-coordok
+    			    nb<-nb+1
+    			}
+    	    }
+    	    listcoordok<-unique(listcoordok)
+            #print(listcoordok)
+    		#si plusieurs ensemble avec le meme nombre de classe, on conserve
+    		#la liste avec le plus fort chi2
+    	    if (length(listcoordok)>1) {
+    		    maxchi<-0
+    		    best<-NULL
+    		    for (i in 1:length(listcoordok)) {
+    		        chi<-NULL
+    		        uce<-NULL
+    		        if (nrow(listcoordok[[i]])==maxcl) {
+    		            for (j in 1:nrow(listcoordok[[i]])) {
+    		                chi<-c(chi,croise[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
+    		                uce<-c(uce,chicroiseori[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
+    		            }
+    		            if (maxchi < sum(chi)) {
+    		                maxchi <- sum(chi)
+    		                suce <- sum(uce)
+    		                best <- i
+    		            } 
+    		        }
+    		    }
+    	    }
+    	    print((maxchi/nrow(classeuce1)*100))
+    	    listcoordok[[best]]
+    	}
+        print('cherche max')
+	    coordok<-findmaxclasse(listx,listy)
 	    coordok
-	}
-#fonction pour trouver le nombre maximum de classes
-	findmaxclasse<-function(listx,listy) {
-	    listcoordok<-list()
-	    maxcl<-0
-	    nb<-1
-	    for (i in 1:length(listy)) {
-			coordok<-trouvecoordok(i)
-			if (maxcl <= nrow(coordok)) {
-			    maxcl<-nrow(coordok)
-			    listcoordok[[nb]]<-coordok
-			    nb<-nb+1
-			}
-	    }
-	    listcoordok<-unique(listcoordok)
-		#si plusieurs ensemble avec le meme nombre de classe, on conserve
-		#la liste avec le plus fort chi2
-	    if (length(listcoordok)>1) {
-		maxchi<-0
-		best<-NULL
-		for (i in 1:length(listcoordok)) {
-		    chi<-NULL
-		    uce<-NULL
-		    if (nrow(listcoordok[[i]])==maxcl) {
-		        for (j in 1:nrow(listcoordok[[i]])) {
-		            chi<-c(chi,croise[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
-		            uce<-c(uce,chicroiseori[(listcoordok[[i]][j,1]-1),(listcoordok[[i]][j,2]-1)])
-		        }
-		        if (maxchi < sum(chi)) {
-		            maxchi<-sum(chi)
-		            suce<-sum(uce)
-		            best<-i
-		        } 
-		    }
-		}
-	    }
-	    print((suce/nrow(classeuce1)*100))
-	    listcoordok[[best]]
-	}
+    }
 	#findmaxclasse(listx,listy)
 	#coordok<-trouvecoordok(1)
-	coordok<-findmaxclasse(listx,listy)
-	print(coordok)
+    #coordok <- oldfindbestcoord(listx, listy)
+    print('begin bestcoord')
+    coordok <- findbestcoord(listx, listy, classif_mode, nbt)
+
 
 	lfilletot<-function(classeuce,x) {
 	    listfille<-NULL
@@ -268,9 +678,11 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 			listfille
 	    }
 	}
-
+    print('listfille')
 	listfille1<-lfilletot(classeuce1,1)
-	listfille2<-lfilletot(classeuce2,2)
+	if (classif_mode == 0) {
+		listfille2<-lfilletot(classeuce2,2)
+	}
 
 	#utiliser rownames comme coordonnees dans un tableau de 0
 	Assignclasse<-function(classeuce,x) {
@@ -284,32 +696,26 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	}
 	print('commence assigne new classe')
 	nchd1<-Assignclasse(classeuce1,1)
-	if (classif_mode==0)
+	if (classif_mode==0) {
 		nchd2<-Assignclasse(classeuce2,2)
-	else
-		nchd2<-nchd1
+	}
 	print('fini assign new classe')
 	#croisep<-matrix(ncol=nrow(coordok),nrow=nrow(coordok))
-    nchd2[which(nchd1[,ncol(nchd1)]==0),] <- 0
-    nchd2[which(nchd1[,ncol(nchd1)]!=nchd2[,ncol(nchd2)]),] <- 0
-    nchd1[which(nchd2[,ncol(nchd2)]==0),] <- 0
+	if (classif_mode==0) {
+    	nchd2[which(nchd1[,ncol(nchd1)]==0),] <- 0
+    	nchd2[which(nchd1[,ncol(nchd1)]!=nchd2[,ncol(nchd2)]),] <- 0
+    	nchd1[which(nchd2[,ncol(nchd2)]==0),] <- 0
+	}
 
-#	for (i in 1:nrow(nchd1)) {
-#	    if (nchd1[i,ncol(nchd1)]==0) {
-#		nchd2[i,]<-nchd2[i,]*0
-#	    }
-#	    if (nchd1[i,ncol(nchd1)]!=nchd2[i,ncol(nchd2)]) {
-#		nchd2[i,]<-nchd2[i,]*0
-#	    }
-#	    if (nchd2[i,ncol(nchd2)]==0) {
-#		nchd1[i,]<-nchd1[i,]*0
-#	    }
-#	}
 	print('fini croise')
 	elim<-which(nchd1[,ncol(nchd1)]==0)
 	keep<-which(nchd1[,ncol(nchd1)]!=0)
 	n1<-nchd1[nchd1[,ncol(nchd1)]!=0,]
-	n2<-nchd2[nchd2[,ncol(nchd2)]!=0,]
+	if (classif_mode==0) {
+		n2<-nchd2[nchd2[,ncol(nchd2)]!=0,]
+	} else {
+		classeuce2 <- NULL
+	}
 	#clnb<-nrow(coordok)
 	print('fini')
 	write.csv2(nchd1[,ncol(nchd1)],uceout)