X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2FCHD.R;h=68edd4e848d9af2d2527d14ac82998d38305afc0;hp=049d5c7badcd3f5ffe733e61373ad3f858b7fd2c;hb=8347c52224950bb01c725f9efdeee8631f8d4052;hpb=13666be5de5eeffbe63774c3c0aecd407b519ac6 diff --git a/Rscripts/CHD.R b/Rscripts/CHD.R index 049d5c7..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, mode.patate = FALSE, 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, mode.patate = FALSE, libsvdc=FALSE, libsvdc.path=NUL #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, mode.patate = FALSE, libsvdc=FALSE, libsvdc.path=NUL 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]),]