--- /dev/null
+#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]])
+ d<-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]<t[1,1]){
+ listcol[[clnb+1]]<-append(listcol[[clnb+1]],k)
+ } else {
+ listcol[[clnb]]<-append(listcol[[clnb]],k)
+ }
+ }
+ }
+
+ #lignes concernees
+ listrownamedtable<-rownames(dtable)
+ listrownamedtable<-as.integer(listrownamedtable)
+ newcol<-vector(length=nrow(dataori))
+ #remplissage de la nouvelle colonne avec les nouvelles classes
+ print('remplissage')
+ num<-0
+ for (ligne in listrownamedtable) {
+ num<-num+1
+ newcol[ligne]<-as.vector(dtable$cl1[num])[1]
+ }
+ #recuperation de la classe precedante pour les cases vides
+ print('recuperation classes precedentes')
+ matori<-as.matrix(dataori)
+ if (i!=1) {
+ # options(warn=-1)
+ for (ligne in 1:length(newcol)) {
+ # print(newcol[ligne])
+ if (newcol[ligne]==0) { # ce test renvoie un warning
+ newcol[ligne]<-matori[ligne,length(matori[1,])]
+ }
+ }
+ # options(warn=0)
+ }
+ #???????????????????????????????????
+ #je ne comprends pas : j'ai vraiment besoin de faire ces deux actions pour ajouter la nouvelle colonne aux donnees ?
+ #si je ne le fais pas, ca plante...
+ dataori<-cbind(dataori,newcol)
+ dataori<-transform(dataori,newcol=newcol)
+ #???????????????????????????????????
+
+ #liste des noms de colonne
+ #colname<-colnames(dataori)
+ #nom de la derniere colonne
+ #colname<-colname[length(dataori)]
+ #la derniere colonne
+ colclasse<-as.character(dataori[,ncol(dataori)])
+ #print(colclasse)
+ #les modalites de la derniere colonne
+ classes<-levels(as.factor(colclasse))
+ print(classes)
+ #determination de la classe la plus grande
+ tailleclasse<-paste(NULL,1:length(classes))
+ b<-0
+ for (classe in classes) {
+ b<-b+1
+ dtable<-dataori[dataori[length(dataori)]==classe,]
+ tailleclasse[b]<-length(dtable[,1])
+ }
+ tailleclasse<-as.integer(tailleclasse)
+ print(tailleclasse)
+ plusgrand<-which(tailleclasse==max(tailleclasse))
+
+ #???????????????????????????????????
+ #Si 2 classes ont des effectifs egaux, on prend la premiere de la liste...
+ if (length(plusgrand)>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))}
projects / iramuteq / blobdiff