#Author: Pierre Ratinaud #Copyright (c) 2008-2009 Pierre Ratinaud #Lisense: GNU/GPL fille<-function(classe,classeuce) { listfm<-unique(unlist(classeuce[classeuce[,classe%/%2]==classe,])) listf<-listfm[listfm>=classe] listf<-unique(listf) listf } #fonction pour la double classification #cette fonction doit etre splitter en 4 ou 5 fonctions Rchdquest<-function(tableuc1,listeuce1,uceout ,nbt = 9, mincl = 2) { #source('/home/pierre/workspace/iramuteq/Rscripts/CHD.R') #lecture des tableaux data1<-read.csv2(tableuc1)#,row.names=1) cn.data1 <- colnames(data1) data1 <- as.matrix(data1) colnames(data1) <- cn.data1 rownames(data1) <- 1:nrow(data1) data2<-data1 sc<-colSums(data2) if (min(sc)<=4){ data1<-data1[,-which(sc<=4)] sc<-sc[-which(sc<=4)] } #analyse des tableaux avec la fonction CHD qui doit etre sourcee avant chd1<-CHD(data1, x = nbt) chd2<-chd1 #FIXME: le nombre de classe peut etre inferieur nbcl <- nbt + 1 tcl <- ((nbt+1) * 2) - 2 #lecture des uce listuce1<-read.csv2(listeuce1) listuce2<-listuce1 #Une fonction pour assigner une classe a chaque UCE AssignClasseToUce<-function(listuce,chd) { out<-matrix(nrow=nrow(listuce),ncol=ncol(chd)) for (i in 1:nrow(listuce)) { for (j in 1:ncol(chd)) { out[i,j]<-chd[(listuce[i,2]+1),j] } } out } #Assignation des classes classeuce1<-AssignClasseToUce(listuce1,chd1$n1) classeuce2<-classeuce1 #calcul des poids (effectifs) poids1<-vector(mode='integer',length=tcl) makepoids<-function(classeuce,poids) { for (classes in 2:(tcl + 1)){ for (i in 1:ncol(classeuce)) { if (poids[(classes-1)]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)]) } print(sum(uce)) if (maxchi < sum(chi)) { maxchi<-sum(chi) suce<-sum(uce) best<-i } } } } print((suce/nrow(classeuce1)*100)) listcoordok[[best]] } #findmaxclasse(listx,listy) #coordok<-trouvecoordok(1) coordok<-findmaxclasse(listx,listy) print(coordok) fille<-function(classe,classeuce) { listfm<-unique(unlist(classeuce[classeuce[,classe%/%2]==classe,])) listf<-listfm[listfm>=classe] listf<-unique(listf) listf } lfilletot<-function(classeuce) { listfille<-NULL for (classe in 1:nrow(coordok)) { listfille<-unique(c(listfille,fille(coordok[classe,1],classeuce))) listfille } } listfille1<-lfilletot(classeuce1) listfille2<-lfilletot(classeuce2) #utiliser rownames comme coordonnees dans un tableau de 0 Assignclasse<-function(classeuce,x) { nchd<-matrix(0,ncol=ncol(classeuce),nrow=nrow(classeuce)) for (classe in 1:nrow(coordok)) { clnb<-coordok[classe,x] colnb<-clnb%/%2 tochange<-which(classeuce[,colnb]==clnb) for (row in 1:length(tochange)) { nchd[tochange[row],colnb:ncol(nchd)]<-classe } } nchd } print('commence assigne new classe') nchd1<-Assignclasse(classeuce1,1) #nchd1<-Assignnewclasse(classeuce1,1) nchd2<-Assignclasse(classeuce2,2) print('fini assign new classe') croisep<-matrix(ncol=nrow(coordok),nrow=nrow(coordok)) 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) n1<-nchd1[nchd1[,ncol(nchd1)]!=0,] n2<-nchd2[nchd2[,ncol(nchd2)]!=0,] print('debut graph') clnb<-nrow(coordok) print('fini') write.csv2(nchd1[,ncol(nchd1)],uceout) res <- list(n1 = nchd1, coord_ok = coordok, cuce1 = classeuce1, chd = chd1) res } #n1<-Rchdtxt('/home/pierre/workspace/iramuteq/corpus/agir2sortie01.csv','/home/pierre/workspace/iramuteq/corpus/testuce.csv','/home/pierre/workspace/iramuteq/corpus/testuceout.csv')