X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fchdtxt.R;h=066f968bd7f0b180145b016f7d92faf57ba897f2;hp=436d0ba917e1c056b642f41a1b5a519554e122d5;hb=50fa0b90a596d288e88d1e2685da4076473611c2;hpb=42a67a41b64a6e0cc3fd2a63a0749e9aa4b9374c

diff --git a/Rscripts/chdtxt.R b/Rscripts/chdtxt.R
index 436d0ba..066f968 100644
--- a/Rscripts/chdtxt.R
+++ b/Rscripts/chdtxt.R
@@ -1,6 +1,6 @@
 #Author: Pierre Ratinaud
 #Copyright (c) 2008-2009 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
 
 
 #fonction pour la double classification
@@ -95,9 +95,10 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, 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)
 
@@ -129,9 +130,9 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 	if (classif_mode==0) {
 		poids2<-vector(mode='integer',length = tcl)
 		poids2<-makepoids(classeuce2,poids2)
-	} else {
-		poids2<-poids1
-	}
+	}# else {
+	#	poids2<-poids1
+	#}
     
     print('croisement classif')
 
@@ -156,7 +157,12 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 #    	}
 #        croise
 #    }
-    croise <- croiseeff( matrix(ncol=tcl,nrow=tcl), classeuce1, classeuce2)
+	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)
@@ -216,7 +222,39 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 	    }
         chicroise
     }
-    chicroise <- dochicroise(croise, mincl)
+
+	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
@@ -384,8 +422,8 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
                 chi <- NULL
                 uce <- NULL
                 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)])
+                    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)
@@ -481,7 +519,9 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 	}
     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) {
@@ -497,20 +537,24 @@ Rchdtxt<-function(uceout, chd1, chd2 = NULL, mincl=0, classif_mode=0, nbt = 9) {
 	nchd1<-Assignclasse(classeuce1,1)
 	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
+	}
 
 	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)