X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fchdtxt.R;h=a0a9cdd2ae8993a34d0f168abab5eaf677b043b4;hp=a6c2d4cfc59b9856c8b122cbd15a74c5c4150509;hb=e4fcd29b0d143168ba43be91e3c829eceefb0dd3;hpb=01340c360c525681f4502b480d5c4e1db33816c5

diff --git a/Rscripts/chdtxt.R b/Rscripts/chdtxt.R
index a6c2d4c..a0a9cdd 100644
--- a/Rscripts/chdtxt.R
+++ b/Rscripts/chdtxt.R
@@ -80,7 +80,8 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	} else {
 		poids2<-poids1
 	}
-
+    
+    print('croisement classif')
 	croise=matrix(ncol=tcl,nrow=tcl)
 	#production du tableau de contingence
 	for (i in 1:ncol(classeuce1)) {
@@ -91,18 +92,18 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 		#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]
+		    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
 	}
     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
 	}
@@ -113,24 +114,24 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	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)
+		    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(chicroise)
@@ -145,11 +146,11 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	}
 	testpres<-function(x,listcoord) {
 	    for (i in 1:length(listcoord)) {
-		if (x==listcoord[i]) {
-		    return(-1)
-		} else {
-		    a<-1
-		}
+		    if (x==listcoord[i]) {
+		        return(-1)
+		    } else {
+		        a<-1
+		    }
 	    }
 	    a
 	}
@@ -203,17 +204,15 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 	    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))
-		  }
+	        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
@@ -235,23 +234,23 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
 		#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)])
+		    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
+		            } 
 		        }
-		        if (maxchi < sum(chi)) {
-		            maxchi<-sum(chi)
-		            suce<-sum(uce)
-		            best<-i
-		        } 
 		    }
-		}
 	    }
 	    print((suce/nrow(classeuce1)*100))
 	    listcoordok[[best]]
@@ -294,17 +293,6 @@ Rchdtxt<-function(uceout,mincl=0,classif_mode=0, nbt = 9) {
     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)