#library(ca) #library(MASS) #source('/home/pierre/workspace/iramuteq/Rscripts/afc.R') #data<-read.table('output/corpus_bin.csv',header=TRUE,sep='\t') source('/home/pierre/workspace/iramuteq/Rscripts/anacor.R') CHD<-function(data,x=9){ dataori=data dtable=data listcol<-list() listmere<-list() a<-0 print('vire colonnes vides en entree')#FIXME : il ne doit pas y avoir de colonnes vides en entree !! for (m in 1:length(dtable)) { if (sum(dtable[m-a])==0) { print('colonne vide') dtable<-dtable[,-(m-a)] a<-a+1 } } for (i in 1:x) { clnb<-(i*2) listmere[[clnb]]<-i listmere[[clnb+1]]<-i listcol[[clnb]]<-vector() listcol[[clnb+1]]<-vector() #extraction du premier facteur de l'afc print('afc') #afc<-ca(dtable,nd=1) #afc<-corresp(dtable,nd=1) #afc<-fca(dtable) afc<-boostana(dtable,nd=1) #coordonnees des colonnes sur le premier facteur #coordrow=afc$rowcoord #coordrow=as.matrix(afc$rscore) #coordrow<-as.matrix(afc$rproj[,1]) coordrow<-as.matrix(afc$row.scores) #row.names(coordrow)<-afc$rownames row.names(coordrow)<-rownames(dtable) #classement en fonction de la position sur le premier facteur #listclasse<-ifelse(coordrow<0,paste('CLASSE',clnb,sep=''),paste('CLASSE',clnb+1,sep='')) print('deb recherche meilleur partition') coordrow<-as.matrix(coordrow[order(coordrow[,1]),]) #print(rownames(coordrow)) zeropoint<-which.min(abs(coordrow)) print(zeropoint) g<-length(coordrow[coordrow[,1]coordrow[zeropoint]]) prct<-1 g<-round(g*prct) d<-round(d*prct) print(g) print(d) temptable<-as.matrix(coordrow[(zeropoint-g):(zeropoint+d)]) row.names(temptable)<-rownames(coordrow)[(zeropoint-g):(zeropoint+d)] #print(temptable) missing<-zeropoint-g listchi<-vector() chtable<-matrix(0,2,(ncol(dtable))) totforme<-chtable[1,] for (forme in 1:(ncol(dtable))) { totforme[forme]<-sum(dtable[,forme]) } chtable[2,]<-totforme for (l in 1:length(temptable)) { # print(rownames(temptable)[l]) linetoswitch=as.matrix(dtable[rownames(temptable)[l],]) # print(linetoswitch) chtable[1,]<-chtable[1,]+linetoswitch chtable[2,]<-chtable[2,]-linetoswitch valchi<-chisq.test(chtable)$statistic if (is.na(valchi)){ valchi<-0 } listchi<-append(listchi,valchi) } #listchi<-listchi[!is.na(listchi)] maxchi<-which(listchi==max(listchi)) print(max(listchi)) print(maxchi) maxchi<-maxchi+missing #print(listchi) #listclasse print('liste classe') print(coordrow[(maxchi)]) listclasse<-ifelse(coordrow<=coordrow[(maxchi)],clnb,clnb+1) # listclasse<-ifelse(coordrow<0,clnb,clnb+1) listchi<-as.matrix(listchi) listchi<-cbind(listchi,temptable) filename<-paste('graphechi',as.character(i)) filename<-paste(filename,'.jpeg') jpeg(filename) plot(listchi[,1]~listchi[,2]) abline(v=0) print(coordrow[zeropoint-g]) abline(v=coordrow[zeropoint-g]) abline(v=coordrow[zeropoint+d]) abline(v=coordrow[(maxchi)]) dev.off() #ajout du classement au tableau dtable<-transform(dtable,cl1=listclasse) #calcul de la specificite des colonnes t1<-dtable[dtable$cl1==clnb,] t2<-dtable[dtable$cl1==clnb+1,] for (k in 1:(ncol(dtable)-1)) { t<-matrix(0,2,2) t[1,1]<-sum(t1[,k]) t[1,2]<-sum(t2[,k]) t[2,1]<-nrow(t1)-t[1,1] t[2,2]<-nrow(t2)-t[1,2] chi<-chisq.test(t) if (chi$statistic>6){#FIXME : valeur a mettre en option base :2.7 if (chi$expected[1,1]1) { plusgrand<-plusgrand[1] } #???????????????????????????????????? #constuction du prochain tableau a analyser print('construction tableau suivant') classe<-classes[plusgrand] dtable<-dataori[dataori[length(dataori)]==classe,] dtable<-dtable[,1:(length(dtable)-i)] listcolelim<-listcol[[as.integer(classe)]] mother<-listmere[[as.integer(classe)]] while (mother!=1) { listcolelim<-append(listcolelim,listcol[[mother]]) print(listcolelim) mother<-listmere[[mother]] } listcolelim<-sort(unique(listcolelim)) print(listcolelim) print('avant') print(ncol(dtable)) if (!is.logical(listcolelim)){ print('elimination colonne') a<-0 for (col in listcolelim){ dtable<-dtable[,-(col-a)] a<-a+1 } } print('apres') print(ncol(dtable)) #elimination des colonnes ne contenant que des 0 print('vire colonne vide dans boucle') a<-0 for (m in 1:ncol(dtable)) { if (sum(dtable[,m-a])==0) { dtable<-dtable[,-(m-a)] a<-a+1 } } #elimination des lignes ne contenant que des 0 # print('vire ligne vide dans boucle') # a<-0 # for (m in 1:nrow(dtable)) { # if (sum(dtable[m-a,])==0) { # print('ligne vide') # dtable<-dtable[-(m-a),] # a<-a+1 # } # } } dataori[(length(dataori)-x+1):length(dataori)] } #dataout<-CHD(data,9) #library(cluster) #dissmat<-daisy(dataout, metric = 'gower', stand = FALSE) #chd<-diana(dissmat,diss=TRUE,) #pour tester le type, passer chaque colonne en matice et faire mode(colonne) #for (i in 1:13) {tmp<-as.matrix(data[i]);print(mode(tmp))}