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
29 makesimip<-function(dm){
30         a<-dm
31         m<-matrix(0,ncol(dm),ncol(dm))
32         rownames(m)<-colnames(a)
33         colnames(m)<-colnames(a)
34         eff<-colSums(a)
35         for (col in 1:(ncol(a)-1)){
36                 for (colc in (col+1):ncol(a)){
37                         ta<-table(a[,col],a[,colc])
38                         if (ncol(ta)==1 & colnames(ta)[1]=='0') {
39                                 ta<-cbind(ta,'1'=c(0,0))
40                         } else if (ncol(ta)==1 & colnames(ta)[1]=='1') {
41                                 ta<-cbind('0'=c(0,0),t)
42                         } else if (nrow(ta)==1 & rownames(ta)[1]=='0'){
43                                 ta<-rbind(ta,'1'=c(0,0))
44                         } else if (nrow(ta)==1 & rownames(ta)[1]=='1') {
45                                 ta<-rbind('0'=c(0,0),ta)
46                         }
47                         #m[colc,col]<-length(which((a[,col]==1) & (a[,colc]==1)))
48                         m[colc,col]<-ta[2,2]
49                         m[col,colc]<-m[colc,col]
50                 }
51         }
52         m<-round((m/nrow(a))*100,digits=0)
53         out<-list(mat=m,eff=eff)
54 }
57 makejac<-function(dm){
58         a<-dm
59         m<-matrix(0,ncol(dm),ncol(dm))
60         rownames(m)<-colnames(a)
61         colnames(m)<-colnames(a)
62         eff<-colSums(a)
63         for (col in 1:(ncol(a)-1)){
64                 for (colc in (col+1):ncol(a)){
65                         ta<-table(a[,col],a[,colc])
66                         if (ncol(ta)==1 & colnames(ta)[1]=='0') {
67                                 ta<-cbind(ta,'1'=c(0,0))
68                         } else if (ncol(ta)==1 & colnames(ta)[1]=='1') {
69                                 ta<-cbind('0'=c(0,0),t)
70                         } else if (nrow(ta)==1 & rownames(ta)[1]=='0'){
71                                 ta<-rbind(ta,'1'=c(0,0))
72                         } else if (nrow(ta)==1 & rownames(ta)[1]=='1') {
73                                 ta<-rbind('0'=c(0,0),ta)
74                         }
75                         m[colc,col]<-(ta[2,2]/(ta[1,2]+ta[2,1]+ta[2,2]))*100
76                         #m[colc,col]<-(length(which((a[,col]==1) & (a[,colc]==1)))/(eff[col]+eff[colc]-length(which((a[,col]==1) & (a[,colc]==1)))))*100
77                         m[col,colc]<-m[colc,col]
78                 }
79         }
80         out<-list(mat=m,eff=eff)
81 }
83 makesimipond<-function(dm) {
84         a<-dm
85         m<-matrix(0,ncol(dm),ncol(dm))
86         rownames(m)<-colnames(dm)
87         colnames(m)<-colnames(dm)
88         eff<-colSums(a)
89         #a<-t(a)
90         #print(a)
91         #lt<-list()
92         for (col in 1:(ncol(a)-1)){
93                 for (colc in (col+1):ncol(a)){
94                         m[colc,col]<-length(which((a[,col]>1) & (a[,colc]>1)))
95                         m[col,colc]<-m[colc,col]
96                 }
97         }
98         out<-list(mat=m,eff=eff)
99 }
101 BuildProf01<-function(x,classes) {
102         #x : donnees en 0/1
103         #classes : classes de chaque lignes de x
104         dm<-cbind(x,cl=classes)
105         clnb=length(summary(as.data.frame(as.character(classes)),max=100))
106         print(clnb)
107         print(summary(as.data.frame(as.character(classes)),max=100))
108         mat<-matrix(0,ncol(x),clnb)
109         #print(mat)
110         rownames(mat)<-colnames(x)
111         for (i in 1:clnb) {
112                 dtmp<-dm[which(dm\$cl==i),]
113                 for (j in 1:(ncol(dtmp)-1)) {
114                         #print(rownames(dtmp[j,]))
115                         mat[j,i]<-sum(dtmp[,j])
116                 }
117         }
118         mat
119 }
120 ###################################################################
122 source('/home/pierre/workspace/iramuteq/Rscripts/chdfunct.R')
124 #}
125 print('lecture')
128 #####################################################################
129 #suede enfance en danger
133 #ed<-ed[,-ncol(ed)]
134 #coop<-coop[,-ncol(coop)]
135 #as<-as[,-ncol(as)]
136 ##tot<-tot[,-ncol(tot)]
137 #tot<-cbind(ed,coop)
138 #tot<-cbind(tot,as)
139 #tot<-as
140 #
143 ##print(tot)
144 #tot<-tot[,-ncol(tot)]
145 #pn<-tot[nrow(tot),]
146 #tot<-tot[-nrow(tot),]
147 #prof<-BuildProf01(tab,grp[,1])
148 #outp<-AsLexico(prof)
149 #chistabletot<-outp[[2]]
151 ##########################################################
152 #SUP
156 ens<-ens[,-ncol(ens)]
157 vp<-vp[,-ncol(vp)]
158 tot<-tt[,-ncol(tt)]
159 print(nrow(tot))
160 gr<-vector(mode='integer',length=nrow(tot))
161 gr[1:41]<-1
162 gr[42:82]<-2
164 mat<-BuildProf01(tot,cl=gr)
165 prof<-AsLexico(mat)
166 chis<-prof[[2]]
167 print(chis)
168 #tot<-tot[,-ncol(tot)]
169 #print(tot)
170 #as<-vector(mode='integer',length=ncol(tot))
171 #as[1:ncol(ens)]<-'red'
172 #as[ncol(ens)+1:ncol(tot)]<-'green'
173 #print('liste des classes')
174 #listclasse<-vector(mode='integer',length=ncol(tab))
175 for (line in 1:nrow(chistabletot)) {
176     if (max(chistabletot[line,])>2) {
177         listclasse[line]<-as.vector(which.max(chistabletot[line,]))
178     } else {
179         listclasse[line]<-3
180     }
181 }
182 #classes<-listclasse
183 #classes<-classes[1:cag]
184 #print(classes)
185 #tot<-cbind(info,biblio)
186 #tot<-cbind(tot,rechdoc)
190 print('matrice de similitude')
191 mindus<-makesimip(tot)
192 m<-mindus\$m
193 eff<-mindus\$eff
195 cn<-paste(colnames(m),eff,sep=' ')
196 #mateff<-makesimipond(ministre)
197 #mateff<-makesimi(tot)
198 #mateff<-makejac(tot)
199 #m<-mateff\$mat
200 #eff<-mateff\$eff
201 #m<-as.matrix(dist(t(ministre),method='binary',upper=TRUE, diag=TRUE))
202 #m<-as.matrix(simil(ministre), method='Jaccard', upper=TRUE, diag=TRUE, by_rows=FALSE)
203 #print(nrow(m))
204 #print(ncol(m))
205 #print(length(colnames(ministre)))
206 #colnames(m)<-colnames(ministre)
207 #rownames(m)<-colnames(ministre)
208 #eff<-colSums(ministre)
209 #mateffp<-makesimi(ministre)
210 #mateffp<-makesimipond(ministre)
211 #m<-mateffp\$mat
212 #eff<-mateffp\$eff
214 #matave<-makesimi(ministre)
215 #m<-matave\$m
216 #eff<-matave\$eff
218 print('couleur')
219 #rain<-rainbow(3)
220 #append(rain,'black')
221 rain<-c("green","red","white","blue")#"yellow","pink","black")#green","blue","red","black")
222 vcol<-vector(mode='integer',length=length(eff))
223 vcolb<-vector(mode='integer',length=length(eff))
224 #classes<-classes[1:93]
225 #classes<-grp
226 for (i in 1:nrow(chis)) {
227         vcolb[i]<-which.max(chis[i,])
228 }
229 print(vcolb)
230 for (i in 1:length(eff)){
231         #if (as.integer(pn[i])==0){
232         #       pn[i]<-4
233         #       print('zero')
234         #}
235     #vcol[i]<-rain[as.integer(pn[i])]
236         vcol[i]<-rain[as.integer(vcolb[i])]
237         }
238 #ll<-which(effp>=0.5)
239 #for (i in which(effp>=0.5)) {
240 #       if (i<=10) {
241 #               vcol[i]<-"blue"
242 #       } else {
243 #               vcol[i]<-"pink"
244 #       }
245 #}
246 #print('length(vcol)')
247 #print(length(vcol))
248 #vcol[1:cchaud]<-rain[1]
249 #vcol[(cchaud+1):(cchaud+cop)]<-rain[2]
250 #vcol[(cchaud+cop+1):length(eff)]<-rain[3]
251 #print(classes)
252 print('premier graph')
253 library(igraph)
254 #sink('graph.txt')
257 #maxtree<-maxgraph(g1)
258 #plot(maxtree, layout=layout.circle)
259 #lo<-layout.circle(g1)
260 eff<-(eff/max(eff))
261 weori<-get.edge.attribute(g1,'weight')
262 #tdel<-which(weori<3)
263 we<-(weori/max(weori))*4
264 print('arbre maximum')
265 invw<-1/weori
266 E(g1)\$weight<-invw
267 g3<-minimum.spanning.tree(g1)
268 E(g3)\$weight<-1/E(g3)\$weight
269 #print(E(g3)\$weight)
270 #sink()
271 #g3<-g1
272 wev<-eff*30
273 wee<-(E(g3)\$weight/max(E(g3)\$weight))*10
274 weori<-E(g3)\$weight
275 print('layout')
277 lo<-layout.fruchterman.reingold(g3,dim=3)
278 print('lo')
279 #print(nrow(lo))
280 #lo<-layout.sphere(g3)
281 #lo<-cbind(lo,eff)
282 vsize<-vector(mode='integer',length=nrow(lo))
283 #print(we)
284 #ecount(g1)
285 #g2<-simplify(g1)
286 #g2<-delete.edges(g2,tdel-1)
287 #tmax<-clusters(g1)
288 #print(tmax)
289 #we<-we[-tdel]
290 #weori<-weori[-tdel]
291 #plot(g1,vertex.label=colnames(m),edge.width=get.edge.attribute(g1,'weight'),layout=layout.circle,vertex.shape='none')
292 #igraph.par('print.edge.attributes',TRUE)
293 #plot(g2,vertex.label=colnames(m),vertex.size=vsize,vertex.color=vcol,edge.width=we,layout=lo)#,vertex.shape='none')#,edge.label=weori)
294 #rglplot(g3,vertex.label=colnames(m),edge.width=we,vertex.size=vsize,vertex.label.color=vcol,layout=lo,vertex.shape='none')#,edge.label=weori)
295 print('plot')
296 tkplot(g3,vertex.label=cn,edge.width=wee,vertex.size=wev,vertex.color=vcol,vertex.label.color="black",edge.label=weori,layout=lo)#,vcolb vertex.label.dist=1)#,vertex.shape='none')#,edge.label=weori)
297 #},vertex.color=vcol
298 #rgl.bg(sphere=FALSE,color=c("black","white"))
299 #vertex.color=vcol,vertex.label.color=vcol,edge.label=weori,
300 #rgl.viewpoint(zoom=0.6)
301 #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)
302 #tkplot(g1,vertex.label=colnames(m),layout=layout.circle,vertex.shape='rectangle')
303 #rglplot(g1,vertex.label=colnames(m),layout=layout.circle)
304 #g1<-graph(m)
305 #tkplot(g1)
311 #Ministre