1 #############################################################
2 makesimi<-function(dm){
3         a<-dm
4         m<-matrix(0,ncol(dm),ncol(dm))
5         rownames(m)<-colnames(a)
6         colnames(m)<-colnames(a)
7         eff<-colSums(a)
8         for (col in 1:(ncol(a)-1)){
9                 for (colc in (col+1):ncol(a)){
10                         ta<-table(a[,col],a[,colc])
11                         if (ncol(ta)==1 & colnames(ta)[1]=='0') {
12                                 ta<-cbind(ta,'1'=c(0,0))
13                         } else if (ncol(ta)==1 & colnames(ta)[1]=='1') {
14                                 ta<-cbind('0'=c(0,0),t)
15                         } else if (nrow(ta)==1 & rownames(ta)[1]=='0'){
16                                 ta<-rbind(ta,'1'=c(0,0))
17                         } else if (nrow(ta)==1 & rownames(ta)[1]=='1') {
18                                 ta<-rbind('0'=c(0,0),ta)
19                         }
20                         #m[colc,col]<-length(which((a[,col]==1) & (a[,colc]==1)))
21                         m[colc,col]<-ta[2,2]
22                         m[col,colc]<-m[colc,col]
23                 }
24         }
25         out<-list(mat=m,eff=eff)
26
28 makejac<-function(dm){
29         a<-dm
30         m<-matrix(0,ncol(dm),ncol(dm))
31         rownames(m)<-colnames(a)
32         colnames(m)<-colnames(a)
33         eff<-colSums(a)
34         for (col in 1:(ncol(a)-1)){
35                 for (colc in (col+1):ncol(a)){
36                         ta<-table(a[,col],a[,colc])
37                         if (ncol(ta)==1 & colnames(ta)[1]=='0') {
38                                 ta<-cbind(ta,'1'=c(0,0))
39                         } else if (ncol(ta)==1 & colnames(ta)[1]=='1') {
40                                 ta<-cbind('0'=c(0,0),t)
41                         } else if (nrow(ta)==1 & rownames(ta)[1]=='0'){
42                                 ta<-rbind(ta,'1'=c(0,0))
43                         } else if (nrow(ta)==1 & rownames(ta)[1]=='1') {
44                                 ta<-rbind('0'=c(0,0),ta)
45                         }
46                         m[colc,col]<-(ta[2,2]/(ta[1,2]+ta[2,1]+ta[2,2]))*100
47                         #m[colc,col]<-(length(which((a[,col]==1) & (a[,colc]==1)))/(eff[col]+eff[colc]-length(which((a[,col]==1) & (a[,colc]==1)))))*100
48                         m[col,colc]<-m[colc,col]
49                 }
50         }
51         out<-list(mat=m,eff=eff)
52 }
54 makesimipond<-function(dm) {
55         a<-dm
56         m<-matrix(0,ncol(dm),ncol(dm))
57         rownames(m)<-colnames(dm)
58         colnames(m)<-colnames(dm)
59         eff<-colSums(a)
60         #a<-t(a)
61         #print(a)
62         #lt<-list()
63         for (col in 1:(ncol(a)-1)){
64                 for (colc in (col+1):ncol(a)){
65                         m[colc,col]<-length(which((a[,col]>1) & (a[,colc]>1)))
66                         m[col,colc]<-m[colc,col]
67                 }
68         }
69         out<-list(mat=m,eff=eff)
70 }
72 BuildProf01<-function(x,classes) {
73         #x : donnees en 0/1
74         #classes : classes de chaque lignes de x
75         dm<-cbind(x,cl=classes)
76         clnb=length(summary(as.data.frame(as.character(classes)),max=100))
77         print(clnb)
78         print(summary(as.data.frame(as.character(classes)),max=100))
79         mat<-matrix(0,ncol(x),clnb)
80         #print(mat)
81         rownames(mat)<-colnames(x)
82         for (i in 1:clnb) {
83                 dtmp<-dm[which(dm\$cl==i),]
84                 for (j in 1:(ncol(dtmp)-1)) {
85                         #print(rownames(dtmp[j,]))
86                         mat[j,i]<-sum(dtmp[,j])
87                 }
88         }
89         mat
90 }
91 ###################################################################
93 source('/home/pierre/workspace/iramuteq/Rscripts/chdfunct.R')
95 #cinf<-ncol(info)
97 #cbib<-ncol(biblio)
99 #crech<-ncol(rechdoc)
101 ######################@@
102 #MV
103 #########################
105 ##cchaud<-ncol(chaud)
107 ##cop<-ncol(op)
109 ##csoud<-ncol(soud)
111 ##cmindus<-ncol(mindus)
113 ##cinfor<-ncol(infor)
115 ##ctrav<-ncol(trav)
116 #tot<-cbind(chaud,op)
117 #tot<-cbind(tot,soud)
118 #tot<-cbind(tot,indus)
119 ##
120 #list_data<-list('a'=chaud, 'b'=soud,'c'=infor,'d'=trav)
121 #tot<-cbind(chaud,op)
122 #tot<-chaud
123 ##tot<-cbind(tot,infor)
124 ##tot<-cbind(tot,trav)
126 #mv<-mv[,-ncol(mv)]
128 #tab<-tot
130 print('passe ici')
131 #tot<-mv[,-ncol(mv)]
132 #tot<-trav
133 #################################################
134 #AGIR
136 #cag<-ncol(ag)
139 ###############################################################
140 #Vero
142 #grp<-vector(mode='integer',length=ncol(tot))
143 #grp[1:54]<-1
144 #grp[55:108]<-2
145 #grp[109:162]<-3
146 #prof<-BuildProf01(tot,grp[,1])
147 ##prof<-prof[-nrow(prof),]
148 #outp<-AsLexico(prof)
149 #chistabletot<-outp[[2]]
151 ###################################################################
152 #Steph
155 #tot<-tot[,-ncol(tot)]
156 #grp<-vector(mode='integer',length=nrow(tot))
157 #grp[1:245]<-1
158 #grp[246:490]<-2
159 #prof<-BuildProf01(tot,grp)
160 #print(nrow(prof))
161 ##print(prof)
162 #outp<-AsLexico(prof)
163 #chistabletot<-outp[[2]]
166 #print(tot[,ncol(tot)])
167 #tot<-tot[,-ncol(tot)]
168 #grp<-vector(mode='integer',length=nrow(tot))
169 #grp[1:175]<-1
170 #grp[176:350]<-2
171 #prof<-BuildProf01(tot,grp)
172 #outp<-AsLexico(prof)
173 #chistabletot<-outp[[2]]
176 #print(tot[,ncol(tot)])
177 #tot<-tot[,-ncol(tot)]
178 #grp<-vector(mode='integer',length=nrow(tot))
179 #grp[1:245]<-1
180 #grp[246:419]<-2
181 #prof<-BuildProf01(tot,grp)
182 #outp<-AsLexico(prof)
183 #chistabletot<-outp[[2]]
185 #######################################################
186 #grp ideal 2008
188 #print(tot[,ncol(tot)])
189 #grp<-vector(mode='integer',length=ncol(tot))
190 #grp[1:10]<-1
191 #grp[11:20]<-2
192 #prof<-BuildProf01(tot,grp)
193 #outp<-AsLexico(prof)
194 #chistabletot<-outp[[2]]
197 #eff<-colSums(ministre)
198 #ministre<-ministre[,-which(eff<100)]
199 #
200 ##ministre<-(ministre/colSums(ministre))*1000
201 #print(ncol(ministre))
202 #pm<-t(ministre)
203 #outp<-AsLexico(pm)
204 #chistabletot<-outp[[2]]
207 #ministre<-ministre[,-which(eff<200)]
209 #uc<-matrix(0,nrow(ministre),1)
210 #uc<-list()
211 #print(uce)
212 #print(nrow(n1))
213 #for (i in 1:nrow(uce)) {
214 #    uc[[as.integer(uce[i,2])+1]]<-n1[i,ncol(n1)]
215 #}
216 #print(nrow(ministre))
217 #grp<-unlist(uc)
218 #prof<-BuildProf01(ag,n1[,ncol(n1)])
219 #outp<-AsLexico(prof)
220 #chistabletot<-outp[[2]]
222 #######################
223 #Steph
224 #########################
227 #cpriv<-ncol(priv)
228 #tot<-cbind(priv,pro)
230 #print('tot')
231 #print(ncol(tot))
234 #grp<-vector(mode='integer',length=nrow(tot))
235 #grp[1:245]<-1
236 #grp[246:nrow(tot)]<-2
237 #grp[491:635]<-3
238 #prof<-BuildProf01(tot,grp)
239 #prof<-prof[,-4]
240 #print(prof)
241 #print(nrow(prof))
242 #outp<-AsLexico(prof)
243 #chistabletot<-outp[[2]]
244 #cs<-colSums(prof)
245 #prof<-prof/cs
246 #l<-vector(mode='integer',length=nrow(prof))
247 #for (line in 1:nrow(prof)) {
248 #    l[line]<-as.integer(which.max(prof[line,1:2]))
249 #}
250 print('lecture')
251 #chistabletot<-chistabletot[1:ncol(ministre),]
252 #print(nrow(chistabletot))
253 #sc<-colSums(as.matrix(ministre))
254 #print(length(sc))
255 #outc<-which(sc>0)
256 #print(length(outc))
257 #ministre<-ministre[,outc]
258 #print(ncol(ministre))
259 #prof<-BuildProf01(ministre,grp)
260 #outp<-AsLexico(prof)
261 #chistabletot<-outp[[2]]
262 #chistabletot<-chistabletot[outc,]
263 #print(nrow(chistabletot))
266 #chistabletot<-chistabletot[1:cag,]
268 #print(grp)
269 #grp<-as.character(grp[,1])
270 #titre<-c("chaudronnier","soudeur","informaticien","travail")
271 #count<-0
272 #split.screen(c(2,2))
273 #for (tab in list_data) {
274 #count<-count+1
275 #screen(count)
276 #par(cex=0.7)
277 #grp<-rbind(grp,grp)
278 #grp<-rbind(grp,grp)
279 #print(ncol(tab))
281 #####################################################################
282 #suede enfance en danger
285 #prof<-BuildProf01(tab,grp[,1])
286 #outp<-AsLexico(prof)
287 #chistabletot<-outp[[2]]
289 #print('liste des classes')
290 #listclasse<-vector(mode='integer',length=ncol(tab))
291 #for (line in 1:nrow(chistabletot)) {
292 #    if (max(chistabletot[line,])>0) {
293 #        listclasse[line]<-as.vector(which.max(chistabletot[line,]))
294 #    } else {
295 #        listclasse[line]<-3
296 #    }
297 #}
298 #classes<-listclasse
299 #classes<-classes[1:cag]
300 #print(classes)
301 #tot<-cbind(info,biblio)
302 #tot<-cbind(tot,rechdoc)
303 listclasse<-vector(mode='integer',length=ncol(dt))
304 for (line in 1:nrow(chistabletot)) {
305         if ((max(chistabletot[line,])>3.84) || (min(prof[line,])==0)) {
306                 if (max(chistabletot[line,])>3.84) {
307                         listclasse[line]<-as.vector(which.max(chistabletot[line,]))
308                 }
309                 if (min(prof[line,])==0) {
310                         print('zero')
311                         listclasse[line]<-as.vector(which.max(prof[line,]))
312                 }
313         } else {
314                 listclasse[line]<-3
315         }
316 }
318 print('matrice de similitude')
319 mindus<-makesimi(tot)
320 m<-mindus\$m
321 eff<-mindus\$eff
323 #mateff<-makesimipond(ministre)
324 #mateff<-makesimi(tot)
325 #mateff<-makejac(tot)
326 #m<-mateff\$mat
327 #eff<-mateff\$eff
328 #m<-as.matrix(dist(t(ministre),method='binary',upper=TRUE, diag=TRUE))
329 #m<-as.matrix(simil(ministre), method='Jaccard', upper=TRUE, diag=TRUE, by_rows=FALSE)
330 #print(nrow(m))
331 #print(ncol(m))
332 #print(length(colnames(ministre)))
333 #colnames(m)<-colnames(ministre)
334 #rownames(m)<-colnames(ministre)
335 #eff<-colSums(ministre)
336 #mateffp<-makesimi(ministre)
337 #mateffp<-makesimipond(ministre)
338 #m<-mateffp\$mat
339 #eff<-mateffp\$eff
341 #matave<-makesimi(ministre)
342 #m<-matave\$m
343 #eff<-matave\$eff
345 print('couleur')
346 #rain<-rainbow(3)
347 #append(rain,'black')
348 rain<-c("green","red","white")#"yellow","pink","black")#green","blue","red","black")
349 vcol<-vector(mode='integer',length=length(eff))
350 vcolb<-vector(mode='integer',length=length(eff))
351 #classes<-classes[1:93]
352 #classes<-grp
353 #for (i in 1:length(eff)){
354 #    vcol[i]<-rain[as.integer(classes[i])]
355 #       vcolb[i]<-"black"
356 #}
357 #ll<-which(effp>=0.5)
358 #for (i in which(effp>=0.5)) {
359 #       if (i<=10) {
360 #               vcol[i]<-"blue"
361 #       } else {
362 #               vcol[i]<-"pink"
363 #       }
364 #}
365 #print('length(vcol)')
366 #print(length(vcol))
367 #vcol[1:cchaud]<-rain[1]
368 #vcol[(cchaud+1):(cchaud+cop)]<-rain[2]
369 #vcol[(cchaud+cop+1):length(eff)]<-rain[3]
370 #print(classes)
371 print('premier graph')
372 library(igraph)
373 #sink('graph.txt')
376 #maxtree<-maxgraph(g1)
377 #plot(maxtree, layout=layout.circle)
378 #lo<-layout.circle(g1)
379 eff<-(eff/max(eff))
380 weori<-get.edge.attribute(g1,'weight')
381 #tdel<-which(weori<3)
382 we<-(weori/max(weori))*4
383 print('arbre maximum')
384 invw<-1/weori
385 E(g1)\$weight<-invw
386 g3<-minimum.spanning.tree(g1)
387 E(g3)\$weight<-1/E(g3)\$weight
388 #print(E(g3)\$weight)
389 #sink()
390 #g3<-g1
391 wev<-eff*20
392 wee<-(E(g3)\$weight/max(E(g3)\$weight))*10
393 weori<-E(g3)\$weight
394 print('layout')
396 lo<-layout.fruchterman.reingold(g3,dim=3)
397 print('lo')
398 #print(nrow(lo))
399 #lo<-layout.sphere(g3)
400 #lo<-cbind(lo,eff)
401 vsize<-vector(mode='integer',length=nrow(lo))
402 #print(we)
403 #ecount(g1)
404 #g2<-simplify(g1)
405 #g2<-delete.edges(g2,tdel-1)
406 #tmax<-clusters(g1)
407 #print(tmax)
408 #we<-we[-tdel]
409 #weori<-weori[-tdel]
410 #plot(g1,vertex.label=colnames(m),edge.width=get.edge.attribute(g1,'weight'),layout=layout.circle,vertex.shape='none')
411 #igraph.par('print.edge.attributes',TRUE)
412 #plot(g2,vertex.label=colnames(m),vertex.size=vsize,vertex.color=vcol,edge.width=we,layout=lo)#,vertex.shape='none')#,edge.label=weori)
413 #rglplot(g3,vertex.label=colnames(m),edge.width=we,vertex.size=vsize,vertex.label.color=vcol,layout=lo,vertex.shape='none')#,edge.label=weori)
414 print('plot')
415 tkplot(g3,vertex.label=colnames(m),edge.width=wee,vertex.size=wev,vertex.label.color="black",layout=lo)#,vcolb vertex.label.dist=1)#,vertex.shape='none')#,edge.label=weori)
416 #},vertex.color=vcol
417 #rgl.bg(sphere=FALSE,color=c("black","white"))
418 #vertex.color=vcol,vertex.label.color=vcol,edge.label=weori,
419 #rgl.viewpoint(zoom=0.6)
420 #movie3d(spin3d(axis=c(0,1,0),rpm=6),10,dir='/home/pierre/workspace/iramuteq/corpus/',movie="vero_cooc_explo",clean=TRUE,convert=TRUE,fps=20)
421 #tkplot(g1,vertex.label=colnames(m),layout=layout.circle,vertex.shape='rectangle')
422 #rglplot(g1,vertex.label=colnames(m),layout=layout.circle)
423 #g1<-graph(m)
424 #tkplot(g1)
430 #Ministre
431 autre :
434 #------------------------------------------------------
435 #selectionner
436 chimax<-as.matrix(apply(chistabletot,1,max))
437 chimax<-as.matrix(chimax[,1][1:nrow(dm)])
438 chimax<-cbind(chimax,1:nrow(dm))
439 order_chi<-as.matrix(chimax[order(chimax[,1],decreasing = TRUE),])
440 elim<-which(rownames(dm) == 'faire')
441 dm<-dm[-elim,]
442 dm<-dm[chimax[,2][1:300],]
443 #-------------------------------------------------------
444 limit<-nrow(dm)
445 distm<-dist(dm,diag=TRUE)
446 distm<-as.matrix(distm)
448 g1<-minimum.spanning.tree(g1)
450 mc<-rainbow(ncol(chistabletot))
451 chistabletot<-chistabletot[-elim,]
452 cc<-vector()
453 for (i in 1:limit) {
454         cc<-append(cc,which.max(chistabletot[i,]))
455 }
456 cc<-mc[cc]
457 mass<-rowSums(dm)/100
458 rglplot(g1,vertex.label = rownames(dm),vertex.label.color=cc,vertex.color=cc,vertex.size = mass, layout=lo)
462 autre :
464 mat<-matrix(0,ncol=ncol(dm),nrow=ncol(dm))
465 for (i in 1:(ncol(dm)-1)) {
466         for (j in (i+1):ncol(dm)){
467         tab<-table(dm[,i],dm[,j])
468         chi<-chisq.test(tab)
469         mat[i,j]<-chi\$statistic
470         mat[j,i]<-chi\$statistic
471         }
472 }
473 mat<-ifelse(mat>3.84,mat,0)
474 mat<-ifelse(is.na(mat),0,mat)
475 mat<-ifelse(is.infinite(mat),0,mat)
476 cs<-colSums(mat)
477 tovire<-which(cs==0)
478 if (!is.integer(tovire)){
479 mat<-mat[-tovire,]
480 mat<-mat[,-tovire]
481 }
482 cn<-colnames(dm)
483 if (!is.integer(tovire)) cn<-cn[-tovire]
485 lo<-layout.fruchterman.reingold(g1,dim=2)
486 wei<-E(g1)\$weight
487 plot(g1,vertex.label=cn,vertex.size=0.1,edge.width=wei,edge.label=round(wei,2),layout=lo)
491 levels.n<-mj\$levels.n
492 levelnames<-mj\$levelnames
493 cn<-mj\$colnames
494 count<-0
495 for (j in 1:ncol(dm)) {
496         for (i in 1:levels.n[j]) {
497                 count<-count+1
498                 print(paste(cn[j],'\\.',sep=''))
499                 levelnames[count]<-gsub(paste(cn[j],'\\.',sep=''),'',levelnames[count])
500         }
501 }