matrice graph classe
[iramuteq] / Rscripts / chdfunct.R
1 #datadm<-read.table('/home/pierre/.hippasos/corpus_agir_CHDS_16/fileACTtemp.csv', header=TRUE,sep=';', quote='\"',row.names = 1, na.strings = 'NA')
2 library(cluster)
3 #dissmat<-daisy(dataact, metric = 'gower', stand = FALSE)
4 #chd<-diana(dissmat,diss=TRUE,)
5 #height<-chd$height
6 #sortheight<-sort(height,decreasing=TRUE)
7 FindBestCluster<-function (x,Max=15) {
8     i<-1
9     j<-1
10     ListClasseOk<-list()
11     while (i < Max) {
12         if (x[i]==1){
13             while (x[i]==1) {
14             i<-i+1
15             }
16             ListClasseOk[[j]]<-i
17             j<-j+1
18         }
19         if (x[i]==x[i+1]) {
20             i<-i+1
21         }
22         else {
23             ListClasseOk[[j]]<-i+1
24             i<-i+1
25             j<-j+1
26         }
27     }
28         unlist(ListClasseOk)
29 }
30 #BestCLusterNb<-FindBestCluster(sortheight)
31 #classes<-as.data.frame(cutree(as.hclust(chd), k=6))[,1]
32 #datadm<-cbind(datadm,classes)
33 #clusplot(datadm,classes,shade=TRUE,color=TRUE,labels=4)
34
35 BuildContTable<- function (x) {
36         afctable<-NULL
37         for (i in 1:(ncol(x)-1)) {
38             coltable<-table(x[,i],x$classes)
39             afctable<-rbind(afctable,coltable)
40         }
41         afctable
42 }
43
44 PrintProfile<- function(dataclasse,profileactlist,profileetlist,antiproact,antiproet,clusternb,profileout,antiproout,profilesuplist=NULL,antiprosup=NULL) {
45     prolist<-list()
46     profile<-matrix(,0,6)
47     antipro<-matrix(,0,6)
48         cltot<-as.data.frame(dataclasse[dataclasse[,ncol(dataclasse)]!=0,])
49         cltot<-as.data.frame(as.character(cltot[,ncol(cltot)]))
50         tot<-nrow(cltot)
51     classes<-as.data.frame(as.character(dataclasse[,ncol(dataclasse)]))
52     classes.s<-as.data.frame(summary(cltot[,1],maxsum=500))
53     profile<-rbind(profile,c('***','nb classes',clusternb,'***','',''))
54     antipro<-rbind(antipro,c('***','nb classes',clusternb,'***','',''))
55     for(i in 1:clusternb) {
56         profile<-rbind(profile,c('**','classe',i,'**','',''))
57         nbind<-classes.s[which(rownames(classes.s)==i),1]
58         pr<-round((nbind/tot)*100,digits=2)
59         profile<-rbind(profile,c('****',nbind,tot,pr,'****',''))
60                 if (length(profileactlist[[1]][[i]])!=0){
61                 profile<-rbind(profile,as.matrix(profileactlist[[1]][[i]]))
62                 }
63                 if (!is.null(profilesuplist)) {
64                         profile<-rbind(profile,c('*****','*','*','*','*','*'))
65                         if (length(profilesuplist[[1]][[i]])!=0) {
66                                 profile<-rbind(profile,as.matrix(profilesuplist[[1]][[i]]))
67                         }               
68                 }
69         if (!is.null(profileetlist)) {
70             profile<-rbind(profile,c('*','*','*','*','*','*'))
71                     if (length(profileetlist[[1]][[i]])!=0) {
72                     profile<-rbind(profile,as.matrix(profileetlist[[1]][[i]]))
73                     }
74         }
75         antipro<-rbind(antipro,c('**','classe',i,'**','',''))
76         antipro<-rbind(antipro,c('****',nbind,tot,pr,'****',''))
77                 if (length(antiproact[[1]][[i]])!=0) {
78                 antipro<-rbind(antipro,as.matrix(antiproact[[1]][[i]]))
79                 }
80                 if (!is.null(profilesuplist)) {
81                         antipro<-rbind(antipro,c('*****','*','*','*','*','*'))
82                         if (length(antiprosup[[1]][[i]])!=0) {
83                                 antipro<-rbind(antipro,as.matrix(antiprosup[[1]][[i]]))
84                         }
85                 }
86         if (!is.null(profileetlist)) {
87             antipro<-rbind(antipro,c('*','*','*','*','*','*'))
88             if (length(antiproet[[1]][[i]])!=0) {
89                             antipro<-rbind(antipro,as.matrix(antiproet[[1]][[i]]))
90                     }
91         }
92         }
93     write.csv2(profile,file=profileout,row.names=FALSE)
94     write.csv2(antipro,file=antiproout,row.names=FALSE)
95 }
96
97 AddCorrelationOk<-function(afc) {
98         rowcoord<-afc$rowcoord
99         colcoord<-afc$colcoord
100         factor <- ncol(rowcoord)
101         hypo<-function(rowcoord,ligne) {
102                 somme<-0
103                 for (i in 1:factor) {
104                         somme<-somme+(rowcoord[ligne,i])^2
105                 }
106         sqrt(somme)
107         }
108         cor<-function(d,hypo) {
109                 d/hypo
110         }
111         CompCrl<-function(rowcol) {
112                 out<-rowcol
113                 for (i in 1:factor) {
114                         for(ligne in 1:nrow(rowcol)) {      
115                                 out[ligne,i]<-cor(rowcol[ligne,i],hypo(rowcol,ligne))
116                         }
117                 }
118         out
119         }
120         afc$rowcrl<-CompCrl(rowcoord)
121         afc$colcrl<-CompCrl(colcoord)
122         afc
123 }
124
125 AsLexico<- function(x) {
126         x<-as.matrix(x)
127         sumcol<-colSums(x)
128     sumrow<-rowSums(x)
129         tot<-sum(sumrow)
130         tablesqr<-x
131         tablep<-x
132         mod.names<-rownames(x)
133         #problem exemple aurelia
134         for (classe in 1:ncol(x)) {
135                 print(classe)
136                 for (ligne in 1:nrow(x)) {
137                         conttable<-matrix(0,2,2)
138                         conttable[1,1]<-as.numeric(x[ligne,classe])
139                         conttable[1,2]<-sumrow[ligne]-conttable[1,1]
140                         conttable[2,1]<-sumcol[classe]-conttable[1,1]
141                         conttable[2,2]<-tot-sumrow[ligne]-conttable[2,1]
142                         chiresult<-chisq.test(conttable,correct=TRUE)
143                         if (is.na(chiresult$p.value)) {
144                                 chiresult$p.value<-1
145                                 chiresult$statistic<-0
146                         }
147                         obsv<-chiresult$expected
148                         pval<-as.character(format(chiresult$p.value,scientific=TRUE))
149                         spval<-strsplit(pval,'e')
150                         if (is.na(spval)) {
151                                 print(spval)
152                         }
153                         if (conttable[1,1]>obsv[1,1]) {
154                                 tablep[ligne,classe]<-as.numeric(spval[[1]][2])*(-1)
155                                 tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
156                         }
157                         else if (conttable[1,1]<obsv[1,1]){
158                                 tablep[ligne,classe]<-as.numeric(spval[[1]][2])
159                                 tablesqr[ligne,classe]<--round(chiresult$statistic,digits=3)
160                         }
161                 }
162         }
163         output<-list()
164         eff_relatif<-(x/sumcol)*1000
165         output[[1]]<-tablep
166         output[[2]]<-tablesqr
167         output[[3]]<-eff_relatif
168         output
169 }               
170
171 MyChiSq<-function(x){
172         sr<-rowSums(x)
173     sc<-colSums(x)
174     n <- sum(x)
175         E <- outer(sr, sc, "*")/n
176         STAT<-sum((abs(x - E))^2/E)
177     PVAL <- pchisq(STAT, 1, lower.tail = FALSE)
178         chi<-list(statistic = STAT, expected = E, p.value = PVAL)
179     chi
180 }
181
182 AsLexico2<- function(mat, chip = FALSE) {
183         mat<-as.matrix(mat)
184         sumcol<-colSums(mat)
185         sumrow<-rowSums(mat)
186         tot<-sum(sumrow)
187         tablesqr<-mat
188         tablep<-mat
189     contcs <- mat
190     for (i in 1:nrow(contcs)) {
191         contcs[i,] <- sumcol
192     }
193     contrs <- mat
194     contrs[,1:ncol(contrs)] <- sumrow
195     conttot <- matrix(tot, nrow = nrow(mat), ncol = ncol(mat))
196     cont12 <- contrs - mat
197     cont21 <- contcs - mat
198     cont22 <- conttot - contrs - cont21
199         mod.names<-rownames(mat)
200     make_chi_lex <- function(x) {
201         tb<-matrix(0,2,2)
202         tb[1,1] <- mat[x]
203         tb[1,2] <- cont12[x]
204         tb[2,1] <- cont21[x]
205         tb[2,2] <- cont22[x]
206         chiresult<-MyChiSq(tb)
207         #chiresult$statistic
208         if (is.na(chiresult$p.value)) {
209                         chiresult$p.value<-1
210                         chiresult$statistic<-0
211                 }
212                 obsv<-chiresult$expected
213                 pval<-as.character(format(chiresult$p.value,scientific=TRUE))
214                 spval<-strsplit(pval,'e')
215                 if (is.na(spval)) {
216                         print(spval)
217                 }
218                 if (tb[1,1]>obsv[1,1]) {
219                         as.numeric(spval[[1]][2])*(-1)
220                 }
221                 else if (tb[1,1]<obsv[1,1]){
222                         as.numeric(spval[[1]][2])
223                 } else {
224             0
225         }
226     }
227     make_chi_p <- function(x) {
228         tb<-matrix(0,2,2)
229         tb[1,1] <- mat[x]
230         tb[1,2] <- cont12[x]
231         tb[2,1] <- cont21[x]
232         tb[2,2] <- cont22[x]
233         chiresult<-MyChiSq(tb)
234         #chiresult$statistic
235         if (is.na(chiresult$p.value)) {
236                         chiresult$p.value<-1
237                         chiresult$statistic<-0
238                 }
239                 obsv<-chiresult$expected
240                 if (tb[1,1]>obsv[1,1]) {
241                         chiresult$p.value
242                 }
243                 else if (tb[1,1]<obsv[1,1]){
244                         1
245                 } else {
246             1
247         }
248     }
249     make_chi <- function(x) {
250         tb<-matrix(0,2,2)
251         tb[1,1] <- mat[x]
252         tb[1,2] <- cont12[x]
253         tb[2,1] <- cont21[x]
254         tb[2,2] <- cont22[x]
255         chiresult<-MyChiSq(tb)
256         #chiresult$statistic
257         if (is.na(chiresult$p.value)) {
258                         chiresult$p.value<-1
259                         chiresult$statistic<-0
260                 }
261                 obsv<-chiresult$expected
262                 if (tb[1,1]>obsv[1,1]) {
263                         chiresult$statistic
264                 }
265                 else if (tb[1,1]<obsv[1,1]){
266                         0
267                 } else {
268             0
269         }
270     }
271
272     res <- matrix(sapply(1:length(mat), make_chi_lex), ncol = ncol(mat))
273     rownames(res)<-mod.names
274     colnames(res) <- colnames(mat)
275     eff_relatif<-round(t(apply(mat,1,function(x) {(x/t(as.matrix(sumcol))*1000)})),2)
276     rownames(eff_relatif)<-mod.names
277     colnames(eff_relatif) <- colnames(mat)
278     if (chip) {
279         reschip <- matrix(sapply(1:length(mat), make_chi_p), ncol = ncol(mat))
280         rownames(reschip)<- mod.names
281         colnames(reschip) <- colnames(mat)
282         reschi <- matrix(sapply(1:length(mat), make_chi), ncol = ncol(mat))
283         rownames(reschip)<- mod.names
284         colnames(reschip) <- colnames(mat)
285     }
286     out <-list()
287     out[[1]]<-res
288     out[[3]]<-eff_relatif
289     if (chip) {
290         out[[2]] <- reschip
291         out[[4]] <- reschi
292     }
293     out
294 }
295
296 make.spec.hypergeo <- function(mat) {
297     library(textometrieR)
298     spec <- specificites(mat)
299         sumcol<-colSums(mat)
300     eff_relatif<-round(t(apply(mat,1,function(x) {(x/t(as.matrix(sumcol))*1000)})),2)
301     colnames(eff_relatif) <- colnames(mat)
302     out <-list()
303     out[[1]]<-spec
304     out[[3]]<-eff_relatif
305     out
306 }
307
308 BuildProf01<-function(x,classes) {
309         #x : donnees en 0/1
310         #classes : classes de chaque lignes de x
311         dm<-cbind(x,cl=classes)
312         clnb=length(summary(as.data.frame(as.character(classes)),max=100))
313         mat<-matrix(0,ncol(x),clnb)
314         rownames(mat)<-colnames(x)
315         for (i in 1:clnb) {
316                 dtmp<-dm[which(dm$cl==i),]
317                 for (j in 1:(ncol(dtmp)-1)) {
318                         mat[j,i]<-sum(dtmp[,j])
319                 }
320         }
321         mat
322 }
323
324 BuildProf<- function(x,dataclasse,clusternb,lim=2) {
325         ####
326         #r.names<-rownames(x)
327         #x<-as.matrix(x)
328         #rownames(x)<-r.names
329         ####
330         #nuce<-nrow(dataclasse)
331     sumcol<-paste(NULL,1:nrow(x))
332         colclasse<-dataclasse[,ncol(dataclasse)]
333         nuce <- length(which(colclasse != 0))
334 #       for (i in 1:nrow(x)) {
335 #               sumcol[i]<-sum(x[i,])
336 #       }
337 #       afctablesum<-cbind(x,sumcol)
338     afctablesum <- cbind(x, rowSums(x))
339     #dataclasse<-as.data.frame(dataclasse[dataclasse[,ncol(dataclasse)]!=0,])
340         dataclasse<-as.matrix(dataclasse[dataclasse[,ncol(dataclasse)]!=0,])
341         tablesqr<-x
342         tablep<-x
343         x<-afctablesum
344         listprofile<-list()
345         listantipro<-list()
346         mod.names<-rownames(x)
347         prof<-list()
348         aprof<-list()
349         lnbligne<-matrix()
350         for (classe in 1:clusternb) {
351                 lnbligne[classe]<-length(colclasse[colclasse==classe])
352                 prof[[classe]]<-data.frame()
353                 aprof[[classe]]<-data.frame()
354         }
355         
356         for (ligne in 1:nrow(x)) {
357                 for (classe in 1:clusternb) {
358                         nbligneclasse<-lnbligne[classe]
359                         conttable<-data.frame()
360                         conttable[1,1]<-as.numeric(x[ligne,classe])
361                         conttable[1,2]<-as.numeric(as.vector(x[ligne,ncol(x)]))-as.numeric(x[ligne,classe])
362                         conttable[2,1]<-nbligneclasse-as.numeric(x[ligne,classe])
363                         conttable[2,2]<-nrow(dataclasse)-as.numeric(as.vector(x[ligne,ncol(x)]))-conttable[2,1]
364                         chiresult<-chisq.test(conttable,correct=FALSE)
365                         if (is.na(chiresult$p.value)) {
366                                 chiresult$p.value<-1
367                                 chiresult$statistic<-0
368                                 china=TRUE
369                         }
370                         obsv<-chiresult$expected
371                         tablep[ligne,classe]<-round(chiresult$p.value,digits=3)
372                         #tablep[ligne,classe]<-format(chiresult$p.value, scientific=TRUE)
373             if (chiresult$statistic>=lim) {
374                                 if (conttable[1,1]>obsv[1,1]) {
375                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
376                                         prof[[classe]][nrow(prof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
377                                         prof[[classe]][nrow(prof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
378                                         prof[[classe]][nrow(prof[[classe]]),3]<-round((as.numeric(as.vector(x[ligne,classe]))/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
379                                         prof[[classe]][nrow(prof[[classe]]),4]<-round(chiresult$statistic,digits=2)
380                                         prof[[classe]][nrow(prof[[classe]]),5]<-mod.names[ligne]
381                                         prof[[classe]][nrow(prof[[classe]]),6]<-chiresult$p.value
382                                 }
383                                 else if (conttable[1,1]<obsv[1,1]){
384                                         tablesqr[ligne,classe]<--round(chiresult$statistic,digits=3)
385                                         aprof[[classe]][nrow(aprof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
386                                         aprof[[classe]][nrow(aprof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
387                                         aprof[[classe]][nrow(aprof[[classe]]),3]<-round((as.numeric(x[ligne,classe])/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
388                                         aprof[[classe]][nrow(aprof[[classe]]),4]<--round(chiresult$statistic,digits=2)
389                                         aprof[[classe]][nrow(aprof[[classe]]),5]<-mod.names[ligne]
390                                         aprof[[classe]][nrow(aprof[[classe]]),6]<-chiresult$p.value
391                                 }
392                                 #pour gerer le cas avec une seule v et par exemple
393                                 else if (conttable[1,1]==obsv[1,1]) {
394                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
395                                         prof[[classe]][nrow(prof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
396                                         prof[[classe]][nrow(prof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
397                                         prof[[classe]][nrow(prof[[classe]]),3]<-round((as.numeric(as.vector(x[ligne,classe]))/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
398                                         prof[[classe]][nrow(prof[[classe]]),4]<-round(chiresult$statistic,digits=2)
399                                         prof[[classe]][nrow(prof[[classe]]),5]<-mod.names[ligne]
400                                         prof[[classe]][nrow(prof[[classe]]),6]<-chiresult$p.value
401                                         aprof[[classe]][nrow(aprof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
402                                         aprof[[classe]][nrow(aprof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
403                                         aprof[[classe]][nrow(aprof[[classe]]),3]<-round((as.numeric(x[ligne,classe])/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
404                                         aprof[[classe]][nrow(aprof[[classe]]),4]<--round(chiresult$statistic,digits=2)
405                                         aprof[[classe]][nrow(aprof[[classe]]),5]<-mod.names[ligne]
406                                         aprof[[classe]][nrow(aprof[[classe]]),6]<-chiresult$p.value
407                                 }
408                         }else {
409                                 if (conttable[1,1]>obsv[1,1]) {
410                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
411                                 } else if (conttable[1,1]<obsv[1,1]){
412                                         tablesqr[ligne,classe]<--round(chiresult$statistic,digits=3)
413                                 }
414                                 #pour gerer le cas avec une seule v et par exemple
415                                 else if (conttable[1,1]==obsv[1,1]) {
416                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
417                                 }
418                         }
419                         #                               }
420                 }
421         }
422         for (classe in 1:clusternb) {
423                 if (length(prof[[classe]])!=0) {
424                         prof[[classe]]<-prof[[classe]][order(prof[[classe]][,4],decreasing=TRUE),]
425                 }
426                 if (length(aprof[[classe]])!=0) {
427                         aprof[[classe]]<-aprof[[classe]][order(aprof[[classe]][,4]),]   
428                 }
429         }
430         output<-list()
431         output[[1]]<-tablep
432         output[[2]]<-tablesqr
433         output[[3]]<-afctablesum
434         output[[4]]<-prof
435         output[[5]]<-aprof
436         output
437 }
438
439
440 build.pond.prof <- function(mat, lim = 2) {
441         mat<-as.matrix(mat)
442         mod.names<-rownames(mat)
443         scol<-colSums(mat)
444         srow<-rowSums(mat)
445         tot<-sum(srow)
446         tablesqr<-mat
447         tablep<-mat
448         prof<-list()
449         aprof<-list()
450     clusternb <- ncol(mat)
451     x <- cbind(mat, rowSums(mat))
452         for (classe in 1:clusternb) {
453                 prof[[classe]]<-data.frame()
454                 aprof[[classe]]<-data.frame()
455         }
456
457     for (ligne in 1:nrow(mat)) {
458         for(classe in 1:ncol(mat)) {
459             tb <- matrix(0,2,2)
460             tb[1,1] <- mat[ligne,classe]
461             tb[1,2] <- srow[ligne] - tb[1,1]
462             tb[2,1] <- scol[classe] - tb[1,1]
463             tb[2,2] <- tot - srow[ligne] - tb[2,1]
464             chiresult <- MyChiSq(tb)
465             if (is.na(chiresult$p.value)) {
466                                 chiresult$p.value<-1
467                                 chiresult$statistic<-0
468                         }
469             tablep[ligne,classe]<-round(chiresult$p.value,digits=3)
470             conttable<-tb
471             obsv <- chiresult$expected
472             if (chiresult$statistic>=lim) {
473                                 if (conttable[1,1]>obsv[1,1]) {
474                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
475                                         prof[[classe]][nrow(prof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
476                                         prof[[classe]][nrow(prof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
477                                         prof[[classe]][nrow(prof[[classe]]),3]<-round((as.numeric(as.vector(x[ligne,classe]))/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
478                                         prof[[classe]][nrow(prof[[classe]]),4]<-round(chiresult$statistic,digits=2)
479                                         prof[[classe]][nrow(prof[[classe]]),5]<-mod.names[ligne]
480                                         prof[[classe]][nrow(prof[[classe]]),6]<-chiresult$p.value
481                                 }
482                                 else if (conttable[1,1]<obsv[1,1]){
483                                         tablesqr[ligne,classe]<--round(chiresult$statistic,digits=3)
484                                         aprof[[classe]][nrow(aprof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
485                                         aprof[[classe]][nrow(aprof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
486                                         aprof[[classe]][nrow(aprof[[classe]]),3]<-round((as.numeric(x[ligne,classe])/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
487                                         aprof[[classe]][nrow(aprof[[classe]]),4]<--round(chiresult$statistic,digits=2)
488                                         aprof[[classe]][nrow(aprof[[classe]]),5]<-mod.names[ligne]
489                                         aprof[[classe]][nrow(aprof[[classe]]),6]<-chiresult$p.value
490                                 }
491                                 #pour gerer le cas avec une seule v et par exemple
492                                 else if (conttable[1,1]==obsv[1,1]) {
493                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
494                                         prof[[classe]][nrow(prof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
495                                         prof[[classe]][nrow(prof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
496                                         prof[[classe]][nrow(prof[[classe]]),3]<-round((as.numeric(as.vector(x[ligne,classe]))/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
497                                         prof[[classe]][nrow(prof[[classe]]),4]<-round(chiresult$statistic,digits=2)
498                                         prof[[classe]][nrow(prof[[classe]]),5]<-mod.names[ligne]
499                                         prof[[classe]][nrow(prof[[classe]]),6]<-chiresult$p.value
500                                         aprof[[classe]][nrow(aprof[[classe]])+1,1]<-as.numeric(x[ligne,classe])
501                                         aprof[[classe]][nrow(aprof[[classe]]),2]<-as.numeric(as.vector(x[ligne,ncol(x)]))
502                                         aprof[[classe]][nrow(aprof[[classe]]),3]<-round((as.numeric(x[ligne,classe])/as.numeric(as.vector(x[ligne,ncol(x)])))*100,digits=2)
503                                         aprof[[classe]][nrow(aprof[[classe]]),4]<--round(chiresult$statistic,digits=2)
504                                         aprof[[classe]][nrow(aprof[[classe]]),5]<-mod.names[ligne]
505                                         aprof[[classe]][nrow(aprof[[classe]]),6]<-chiresult$p.value
506                                 }
507                         }else {
508                                 if (conttable[1,1]>obsv[1,1]) {
509                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
510                                 } else if (conttable[1,1]<obsv[1,1]){
511                                         tablesqr[ligne,classe]<--round(chiresult$statistic,digits=3)
512                                 }
513                                 #pour gerer le cas avec une seule v et par exemple
514                                 else if (conttable[1,1]==obsv[1,1]) {
515                                         tablesqr[ligne,classe]<-round(chiresult$statistic,digits=3)
516                                 }
517                         }
518
519         }
520     }
521         for (classe in 1:clusternb) {
522                 if (length(prof[[classe]])!=0) {
523                         prof[[classe]]<-prof[[classe]][order(prof[[classe]][,4],decreasing=TRUE),]
524                 }
525                 if (length(aprof[[classe]])!=0) {
526                         aprof[[classe]]<-aprof[[classe]][order(aprof[[classe]][,4]),]   
527                 }
528         }
529         output<-list()
530         output[[1]]<-tablep
531         output[[2]]<-tablesqr
532         output[[3]]<-x
533         output[[4]]<-prof
534         output[[5]]<-aprof
535         output
536 }
537
538     
539