font size...
[iramuteq] / Rscripts / CHD.R.old
1 #library(ca)
2 #library(MASS)
3 #source('/home/pierre/workspace/iramuteq/Rscripts/afc.R')
4 #data<-read.table('output/corpus_bin.csv',header=TRUE,sep='\t')
5 source('/home/pierre/workspace/iramuteq/Rscripts/anacor.R')
6
7 CHD<-function(data,x=9){
8         dataori=data
9         dtable=data
10         listcol<-list()
11         listmere<-list()
12         a<-0
13         print('vire colonnes vides en entree')#FIXME : il ne doit pas y avoir de colonnes vides en entree !!
14         for (m in 1:length(dtable)) {
15             if (sum(dtable[m-a])==0) {
16                 print('colonne vide')
17                         dtable<-dtable[,-(m-a)]
18                         a<-a+1
19             }
20     }
21         for (i in 1:x) {
22                 clnb<-(i*2)
23                 listmere[[clnb]]<-i
24                 listmere[[clnb+1]]<-i
25                 listcol[[clnb]]<-vector()
26                 listcol[[clnb+1]]<-vector()
27                 #extraction du premier facteur de l'afc
28                 print('afc')
29                 #afc<-ca(dtable,nd=1)
30                 #afc<-corresp(dtable,nd=1)
31                 #afc<-fca(dtable)
32                 afc<-boostana(dtable,nd=1)
33                 #coordonnees des colonnes sur le premier facteur
34                 #coordrow=afc$rowcoord
35                 #coordrow=as.matrix(afc$rscore)
36                 #coordrow<-as.matrix(afc$rproj[,1])
37                 coordrow<-as.matrix(afc$row.scores)
38                 #row.names(coordrow)<-afc$rownames
39                 row.names(coordrow)<-rownames(dtable)
40                 #classement en fonction de la position sur le premier facteur
41                 #listclasse<-ifelse(coordrow<0,paste('CLASSE',clnb,sep=''),paste('CLASSE',clnb+1,sep=''))
42
43                 print('deb recherche meilleur partition')
44                 coordrow<-as.matrix(coordrow[order(coordrow[,1]),])
45                 #print(rownames(coordrow))
46                 zeropoint<-which.min(abs(coordrow))
47                 print(zeropoint)
48                 g<-length(coordrow[coordrow[,1]<coordrow[zeropoint]])
49                 d<-length(coordrow[coordrow[,1]>coordrow[zeropoint]])
50                 prct<-1
51                 g<-round(g*prct)
52                 d<-round(d*prct)
53                 print(g)
54                 print(d)
55                 temptable<-as.matrix(coordrow[(zeropoint-g):(zeropoint+d)])
56                 row.names(temptable)<-rownames(coordrow)[(zeropoint-g):(zeropoint+d)]
57                 #print(temptable)
58                 missing<-zeropoint-g
59                 listchi<-vector()
60                 chtable<-matrix(0,2,(ncol(dtable)))
61                 totforme<-chtable[1,]
62                 for (forme in 1:(ncol(dtable))) {
63                         totforme[forme]<-sum(dtable[,forme])
64                 }               
65                 chtable[2,]<-totforme
66                 for (l in 1:length(temptable)) {
67                 #       print(rownames(temptable)[l])
68                         linetoswitch=as.matrix(dtable[rownames(temptable)[l],])
69                 #       print(linetoswitch)
70                         chtable[1,]<-chtable[1,]+linetoswitch
71                         chtable[2,]<-chtable[2,]-linetoswitch
72                         valchi<-chisq.test(chtable)$statistic
73                         if (is.na(valchi)){
74                                 valchi<-0
75                         }
76                         listchi<-append(listchi,valchi)
77                 }
78                 #listchi<-listchi[!is.na(listchi)]
79                 maxchi<-which(listchi==max(listchi))
80                 print(max(listchi))
81                 print(maxchi)
82                 maxchi<-maxchi+missing
83                 #print(listchi)
84                 #listclasse
85                 print('liste classe')
86                 print(coordrow[(maxchi)])
87                 listclasse<-ifelse(coordrow<=coordrow[(maxchi)],clnb,clnb+1)
88 #               listclasse<-ifelse(coordrow<0,clnb,clnb+1)
89                 listchi<-as.matrix(listchi)
90                 listchi<-cbind(listchi,temptable)
91                 filename<-paste('graphechi',as.character(i))
92                 filename<-paste(filename,'.jpeg')
93                 jpeg(filename)
94                 plot(listchi[,1]~listchi[,2])
95                 abline(v=0)
96                 print(coordrow[zeropoint-g])
97                 abline(v=coordrow[zeropoint-g])
98                 abline(v=coordrow[zeropoint+d])
99                 abline(v=coordrow[(maxchi)])
100                 dev.off()
101                 
102                 #ajout du classement au tableau
103                 dtable<-transform(dtable,cl1=listclasse)
104                 
105                 #calcul de la specificite des colonnes
106                 t1<-dtable[dtable$cl1==clnb,]
107                 t2<-dtable[dtable$cl1==clnb+1,]
108                 
109                 for (k in 1:(ncol(dtable)-1)) {
110                         t<-matrix(0,2,2)
111                         t[1,1]<-sum(t1[,k])
112                         t[1,2]<-sum(t2[,k])
113                         t[2,1]<-nrow(t1)-t[1,1]
114                         t[2,2]<-nrow(t2)-t[1,2]
115                         chi<-chisq.test(t)
116                         if (chi$statistic>6){#FIXME : valeur a mettre en option base :2.7
117                                 if (chi$expected[1,1]<t[1,1]){
118                                         listcol[[clnb+1]]<-append(listcol[[clnb+1]],k)
119                                 } else {
120                                         listcol[[clnb]]<-append(listcol[[clnb]],k)
121                                 }
122                         }
123                 }
124                 
125                 #lignes concernees
126                 listrownamedtable<-rownames(dtable)
127                 listrownamedtable<-as.integer(listrownamedtable)
128         newcol<-vector(length=nrow(dataori))
129                 #remplissage de la nouvelle colonne avec les nouvelles classes
130                 print('remplissage')
131                 num<-0
132                 for (ligne in listrownamedtable) {
133                         num<-num+1
134                         newcol[ligne]<-as.vector(dtable$cl1[num])[1]
135                 }
136                 #recuperation de la classe precedante pour les cases vides
137                 print('recuperation classes precedentes')
138                 matori<-as.matrix(dataori)
139         if (i!=1) {
140         #    options(warn=-1)
141             for (ligne in 1:length(newcol)) {
142          #       print(newcol[ligne])
143                 if (newcol[ligne]==0) { # ce test renvoie un warning
144                     newcol[ligne]<-matori[ligne,length(matori[1,])]
145                 }
146             }
147          #   options(warn=0)
148         }
149                 #???????????????????????????????????
150                 #je ne comprends pas : j'ai vraiment besoin de faire ces deux actions  pour ajouter la nouvelle colonne aux donnees ?
151                 #si je ne le fais pas, ca plante...
152                 dataori<-cbind(dataori,newcol)
153                 dataori<-transform(dataori,newcol=newcol)
154                 #???????????????????????????????????
155                 
156                 #liste des noms de colonne
157                 #colname<-colnames(dataori)
158                 #nom de la derniere colonne
159                 #colname<-colname[length(dataori)]
160                 #la derniere colonne
161                 colclasse<-as.character(dataori[,ncol(dataori)])
162                 #print(colclasse)
163         #les modalites de la derniere colonne
164                 classes<-levels(as.factor(colclasse))
165                 print(classes)
166                 #determination de la classe la plus grande
167                 tailleclasse<-paste(NULL,1:length(classes))
168                 b<-0
169                 for (classe in classes) {
170                    b<-b+1
171                    dtable<-dataori[dataori[length(dataori)]==classe,]
172                    tailleclasse[b]<-length(dtable[,1])
173                 }
174                 tailleclasse<-as.integer(tailleclasse)
175                 print(tailleclasse)
176                 plusgrand<-which(tailleclasse==max(tailleclasse))
177                 
178                 #???????????????????????????????????
179                 #Si 2 classes ont des effectifs egaux, on prend la premiere de la liste...
180                 if (length(plusgrand)>1) {
181                         plusgrand<-plusgrand[1]
182                 }
183                 #????????????????????????????????????
184                 
185                 #constuction du prochain tableau a analyser
186                 print('construction tableau suivant')
187                 classe<-classes[plusgrand]
188                 dtable<-dataori[dataori[length(dataori)]==classe,]
189                 dtable<-dtable[,1:(length(dtable)-i)]
190                 
191                 
192                 listcolelim<-listcol[[as.integer(classe)]]
193                 mother<-listmere[[as.integer(classe)]]
194                 while (mother!=1) {
195                         listcolelim<-append(listcolelim,listcol[[mother]])
196                         print(listcolelim)
197                         mother<-listmere[[mother]]
198                 }
199                 
200                 listcolelim<-sort(unique(listcolelim))
201                 print(listcolelim)
202                 print('avant')
203                 print(ncol(dtable))
204                 if (!is.logical(listcolelim)){
205                         print('elimination colonne')
206                         a<-0
207                         for (col in listcolelim){
208                                 dtable<-dtable[,-(col-a)]
209                                 a<-a+1
210                         }
211                 }
212                 print('apres')
213                 print(ncol(dtable))
214                 #elimination des colonnes ne contenant que des 0
215                 print('vire colonne vide dans boucle')
216                 a<-0
217                 for (m in 1:ncol(dtable)) {
218                         if (sum(dtable[,m-a])==0) {
219                                 dtable<-dtable[,-(m-a)]
220                                 a<-a+1
221                         }
222                 }
223                 #elimination des lignes ne contenant que des 0
224 #               print('vire ligne vide dans boucle')
225 #               a<-0
226 #               for (m in 1:nrow(dtable)) {
227 #                       if (sum(dtable[m-a,])==0) {
228 #                               print('ligne vide')
229 #                               dtable<-dtable[-(m-a),]
230 #                               a<-a+1
231 #                       }
232 #               }
233         }
234         dataori[(length(dataori)-x+1):length(dataori)]
235 }
236
237 #dataout<-CHD(data,9)
238
239 #library(cluster)
240 #dissmat<-daisy(dataout, metric = 'gower', stand = FALSE)
241 #chd<-diana(dissmat,diss=TRUE,)
242
243
244 #pour tester le type, passer chaque colonne en matice et faire mode(colonne)
245 #for (i in 1:13) {tmp<-as.matrix(data[i]);print(mode(tmp))}