X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2FCHD.R;h=68edd4e848d9af2d2527d14ac82998d38305afc0;hp=fcec03fb49ad4f7f2b892717358b7f9f147e53b7;hb=8347c52224950bb01c725f9efdeee8631f8d4052;hpb=8fa853a25a9d62b1446e1bc543e5a3a4d0e03dcf

diff --git a/Rscripts/CHD.R b/Rscripts/CHD.R
index fcec03f..68edd4e 100644
--- a/Rscripts/CHD.R
+++ b/Rscripts/CHD.R
@@ -1,6 +1,6 @@
 #Author: Pierre Ratinaud
 #Copyright (c) 2008-2011 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
 
 pp<-function(txt,val) {
 	d<-paste(txt,' : ')
@@ -26,22 +26,37 @@ find.max <- function(dtable, chitable, compte, rmax, maxinter, sc, TT) {
     lo[1:nrow(dtable)] <- 0
     for (k in 1:nrow(ln)) {lo[[ln[k,1]]]<-append(lo[[ln[k,1]]],ln[k,2])}
     for (k in 1:nrow(dtable)) {lo[[k]] <- lo[[k]][-1]}
-    lo<-lo[-c(1,length(lo))]
-    for (l in lo) {
-        compte <- compte + 1 
-        chitable[1,l]<-chitable[1,l]+1
-        chitable[2,l]<-chitable[2,l]-1
-        chi<-MyChiSq(chitable,sc,TT)
-        if (chi>maxinter) {
-            maxinter<-chi
-            rmax<-compte
-        }   
-    }
+	## lo<-lo[-c(1,length(lo))]
+	## for (l in lo) {
+	##     compte <- compte + 1 
+	##     chitable[1,l]<-chitable[1,l]+1
+	##     chitable[2,l]<-chitable[2,l]-1
+	##     chi<-MyChiSq(chitable,sc,TT)
+		## if (chi>maxinter) {
+		##     maxinter<-chi
+		##     rmax<-compte
+		## }   
+    #}
+	lo<-lo[-c(1)]
+	for (l in lo) {
+		chi<-MyChiSq(chitable,sc,TT)
+		if (chi>maxinter) {
+			maxinter<-chi
+			rmax<-compte
+		}
+		compte <- compte + 1
+		chitable[1,l]<-chitable[1,l]+1
+		chitable[2,l]<-chitable[2,l]-1
+	}	
     res <- list(maxinter=maxinter, rmax=rmax)
     res
 }  
 
-CHD<-function(data.in, x=9, libsvdc=FALSE, libsvdc.path=NULL){
+
+
+
+
+CHD<-function(data.in, x=9, mode.patate = FALSE, svd.method, libsvdc.path=NULL){
 #	sink('/home/pierre/workspace/iramuteq/dev/findchi2.txt')
 	dataori <- data.in
     row.names(dataori) <- rownames(data.in)
@@ -78,7 +93,7 @@ CHD<-function(data.in, x=9, libsvdc=FALSE, libsvdc.path=NULL){
 		#extraction du premier facteur de l'afc
 		print('afc')
 		pp('taille dtable dans boucle (col/row)',c(ncol(dtable),nrow(dtable)))
-		afc<-boostana(dtable, nd=1, libsvdc=libsvdc, libsvdc.path=libsvdc.path)
+		afc<-boostana(dtable, nd=1, svd.method = svd.method, libsvdc.path=libsvdc.path)
 		pp('SV',afc$singular.values)
 		pp('V.P.', afc$eigen.values)
 		coordrow <- as.matrix(afc$row.scores[,1])
@@ -103,7 +118,7 @@ CHD<-function(data.in, x=9, libsvdc=FALSE, libsvdc.path=NULL){
         rmax <- NULL
 
         inert <- find.max(dtable, chitable, compte, rmax, maxinter, sc, TT)
-		print('@@@@@@@@@@@@@@@@@@@@@@@@@@@@')
+        print('@@@@@@@@@@@@@@@@@@@@@@@@@@@@')
 		pp('max inter phase 1', inert$maxinter/TT)#max(listinter))
 		print('@@@@@@@@@@@@@@@@@@@@@@@@@@@@')
         ordert <- ordert[order(ordert[,3]),]
@@ -120,107 +135,109 @@ CHD<-function(data.in, x=9, libsvdc=FALSE, libsvdc.path=NULL){
 ###################################################################
 #                  reclassement des individus                     #
 ###################################################################
-		malcl<-1000000000000
-		it<-0
-		listsub<-list()
-		#in boucle
-        ln <- which(dtable==1, arr.ind=TRUE)
-        lnz <- list()
-        lnz[1:nrow(dtable)] <- 0
-
-        for (k in 1:nrow(ln)) {lnz[[ln[k,1]]]<-append(lnz[[ln[k,1]]],ln[k,2])}
-        for (k in 1:nrow(dtable)) {lnz[[k]] <- lnz[[k]][-1]}
-		TT<-sum(dtable)
-
-		while (malcl!=0 & N1>=5 & N2>=5) {
-			it<-it+1
-			listsub[[it]]<-vector()
-            txt <- paste('nombre iteration', it)
-			#pp('nombre iteration',it)
-			vdelta<-vector()
-			#dtable[,'cl']<-cl
-			t1<-dtable[which(cl[,1]==clnb),]#[,-ncol(dtable)]
-			t2<-dtable[which(cl[,1]==clnb+1),]#[,-ncol(dtable)]
-			ncolt<-ncol(t1)
-			#pp('ncolt',ncolt)
-
-            if (N1 != 1) {
-                sc1<-colSums(t1)
-            } else {
-                sc1 <- t1
-            }
-            if (N2 != 1) {
-			    sc2<-colSums(t2)
-            } else {
-                sc2 <- t2
-            }
-			
-            sc<-sc1+sc2
-			chtableori<-rbind(sc1,sc2)
-			chtable<-chtableori
-			interori<-MyChiSq(chtableori,sc,TT)/TT#chisq.test(chtableori)$statistic#/TT
-			txt <- paste(txt, ' - interori : ',interori)
-            #pp('interori',interori)
-
-			N1<-nrow(t1)
-			N2<-nrow(t2)
-
-			#pp('N1',N1)
-			#pp('N2',N2)
-			txt <- paste(txt, 'N1:', N1,'-N2:',N2)
-            print(txt)
-            compte <- 0
-			for (l in lnz){
-                    chi.in<-chtable
-                    compte <- compte + 1
-					if(cl[compte]==clnb){
-						chtable[1,l]<-chtable[1,l]-1
-						chtable[2,l]<-chtable[2,l]+1
-					}else{
-						chtable[1,l]<-chtable[1,l]+1
-						chtable[2,l]<-chtable[2,l]-1
-					}
-					interswitch<-MyChiSq(chtable,sc,TT)/TT#chisq.test(chtable)$statistic/TT
-					ws<-interori-interswitch
-
-					if (ws<0){
-						interori<-interswitch
-						if(cl[compte]==clnb){
-							#sc1<-chtable[1,]
-							#sc2<-chtable[2,]
-							cl[compte]<-clnb+1
-							listsub[[it]]<-append(listsub[[it]],compte)
-						} else {
-							#sc1<-chtable[1,]
-							#sc2<-chtable[2,]
-							cl[compte]<-clnb
-							listsub[[it]]<-append(listsub[[it]],compte)
-						}
-						vdelta<-append(vdelta,compte)
-                    } else {
-                        chtable<-chi.in
-					}
-               }
-#			for (val in vdelta) {
-#				if (cl[val]==clnb) {
-#					cl[val]<-clnb+1
-#					listsub[[it]]<-append(listsub[[it]],val)
-#					}else {
-#					cl[val]<-clnb
-#					listsub[[it]]<-append(listsub[[it]],val)
-#				}
-#			}
-			print('###################################')
-			print('longueur < 0')
-			malcl<-length(vdelta)
-			if ((it>1)&&(!is.logical(listsub[[it]]))&&(!is.logical(listsub[[it-1]]))){
-				if (listsub[[it]]==listsub[[(it-1)]]){
-					malcl<-0
-				}
-			}
-			print(malcl)
-			print('###################################')
-		}
+        if (!mode.patate) {
+    		malcl<-1000000000000
+    		it<-0
+    		listsub<-list()
+    		#in boucle
+            ln <- which(dtable==1, arr.ind=TRUE)
+            lnz <- list()
+            lnz[1:nrow(dtable)] <- 0
+    
+            for (k in 1:nrow(ln)) {lnz[[ln[k,1]]]<-append(lnz[[ln[k,1]]],ln[k,2])}
+            for (k in 1:nrow(dtable)) {lnz[[k]] <- lnz[[k]][-1]}
+    		TT<-sum(dtable)
+    
+    		while (malcl!=0 & N1>=5 & N2>=5) {
+    			it<-it+1
+    			listsub[[it]]<-vector()
+                txt <- paste('nombre iteration', it)
+    			#pp('nombre iteration',it)
+    			vdelta<-vector()
+    			#dtable[,'cl']<-cl
+    			t1<-dtable[which(cl[,1]==clnb),]#[,-ncol(dtable)]
+    			t2<-dtable[which(cl[,1]==clnb+1),]#[,-ncol(dtable)]
+    			ncolt<-ncol(t1)
+    			#pp('ncolt',ncolt)
+    
+                if (N1 != 1) {
+                    sc1<-colSums(t1)
+                } else {
+                    sc1 <- t1
+                }
+                if (N2 != 1) {
+    			    sc2<-colSums(t2)
+                } else {
+                    sc2 <- t2
+                }
+    			
+                sc<-sc1+sc2
+    			chtableori<-rbind(sc1,sc2)
+    			chtable<-chtableori
+    			interori<-MyChiSq(chtableori,sc,TT)/TT#chisq.test(chtableori)$statistic#/TT
+    			txt <- paste(txt, ' - interori : ',interori)
+                #pp('interori',interori)
+    
+    			N1<-nrow(t1)
+    			N2<-nrow(t2)
+    
+    			#pp('N1',N1)
+    			#pp('N2',N2)
+    			txt <- paste(txt, 'N1:', N1,'-N2:',N2)
+                print(txt)
+                compte <- 0
+    			for (l in lnz){
+                        chi.in<-chtable
+                        compte <- compte + 1
+    					if(cl[compte]==clnb){
+    						chtable[1,l]<-chtable[1,l]-1
+    						chtable[2,l]<-chtable[2,l]+1
+    					}else{
+    						chtable[1,l]<-chtable[1,l]+1
+    						chtable[2,l]<-chtable[2,l]-1
+    					}
+    					interswitch<-MyChiSq(chtable,sc,TT)/TT#chisq.test(chtable)$statistic/TT
+    					ws<-interori-interswitch
+    
+    					if (ws<0){
+    						interori<-interswitch
+    						if(cl[compte]==clnb){
+    							#sc1<-chtable[1,]
+    							#sc2<-chtable[2,]
+    							cl[compte]<-clnb+1
+    							listsub[[it]]<-append(listsub[[it]],compte)
+    						} else {
+    							#sc1<-chtable[1,]
+    							#sc2<-chtable[2,]
+    							cl[compte]<-clnb
+    							listsub[[it]]<-append(listsub[[it]],compte)
+    						}
+    						vdelta<-append(vdelta,compte)
+                        } else {
+                            chtable<-chi.in
+    					}
+                   }
+    #			for (val in vdelta) {
+    #				if (cl[val]==clnb) {
+    #					cl[val]<-clnb+1
+    #					listsub[[it]]<-append(listsub[[it]],val)
+    #					}else {
+    #					cl[val]<-clnb
+    #					listsub[[it]]<-append(listsub[[it]],val)
+    #				}
+    #			}
+    			print('###################################')
+    			print('longueur < 0')
+    			malcl<-length(vdelta)
+    			if ((it>1)&&(!is.logical(listsub[[it]]))&&(!is.logical(listsub[[it-1]]))){
+    				if (listsub[[it]]==listsub[[(it-1)]]){
+    					malcl<-0
+    				}
+    			}
+    			print(malcl)
+    			print('###################################')
+    		}
+        }
 		#dtable<-cbind(dtable,'cl'=as.vector(cl))
         #dtable[,'cl'] <-as.vector(cl)
 #######################################################################