1 #############################################################
2 makesimi<-function(dm){
4 m<-matrix(0,ncol(dm),ncol(dm))
5 rownames(m)<-colnames(a)
6 colnames(m)<-colnames(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)
20 #m[colc,col]<-length(which((a[,col]==1) & (a[,colc]==1)))
22 m[col,colc]<-m[colc,col]
25 out<-list(mat=m,eff=eff)
29 makesimip<-function(dm){
31 m<-matrix(0,ncol(dm),ncol(dm))
32 rownames(m)<-colnames(a)
33 colnames(m)<-colnames(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)
47 #m[colc,col]<-length(which((a[,col]==1) & (a[,colc]==1)))
49 m[col,colc]<-m[colc,col]
52 m<-round((m/nrow(a))*100,digits=0)
53 out<-list(mat=m,eff=eff)
57 makejac<-function(dm){
59 m<-matrix(0,ncol(dm),ncol(dm))
60 rownames(m)<-colnames(a)
61 colnames(m)<-colnames(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)
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]
80 out<-list(mat=m,eff=eff)
83 makesimipond<-function(dm) {
85 m<-matrix(0,ncol(dm),ncol(dm))
86 rownames(m)<-colnames(dm)
87 colnames(m)<-colnames(dm)
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]
98 out<-list(mat=m,eff=eff)
101 BuildProf01<-function(x,classes) {
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))
107 print(summary(as.data.frame(as.character(classes)),max=100))
108 mat<-matrix(0,ncol(x),clnb)
110 rownames(mat)<-colnames(x)
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])
120 ###################################################################
122 source('/home/pierre/workspace/iramuteq/Rscripts/chdfunct.R')
128 #####################################################################
129 #suede enfance en danger
130 #ed<-read.csv2('/home/pierre/fac/suede/resultats/enfance_en_danger01.csv')
131 #coop<-read.csv2('/home/pierre/fac/suede/resultats/cooperation01.csv')
132 #as<-read.csv2('/home/pierre/fac/suede/resultats/as01.csv')
134 #coop<-coop[,-ncol(coop)]
136 ##tot<-tot[,-ncol(tot)]
141 #tot<-read.csv2('/home/pierre/fac/suede/resultats/as_catper01.csv',row.names=1)
142 ##tot<-read.csv2('/home/pierre/fac/suede/resultats/swedish_as601.csv',row.names=1)
144 #tot<-tot[,-ncol(tot)]
146 #tot<-tot[-nrow(tot),]
147 #prof<-BuildProf01(tab,grp[,1])
148 #outp<-AsLexico(prof)
149 #chistabletot<-outp[[2]]
151 ##########################################################
153 ens<-read.csv2('/home/pierre/fac/SUP/resultats/enseignant01.csv',row.names=1)
154 vp<-read.csv2('/home/pierre/fac/SUP/resultats/vieprivee01.csv',row.names=1)
155 tt<-read.csv2('/home/pierre/fac/SUP/resultats/asso_ens_vp01.csv',row.names=1)
156 ens<-ens[,-ncol(ens)]
160 gr<-vector(mode='integer',length=nrow(tot))
164 mat<-BuildProf01(tot,cl=gr)
168 #tot<-tot[,-ncol(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,]))
183 #classes<-classes[1:cag]
185 #tot<-cbind(info,biblio)
186 #tot<-cbind(tot,rechdoc)
190 print('matrice de similitude')
191 mindus<-makesimip(tot)
195 cn<-paste(colnames(m),eff,sep=' ')
196 #mateff<-makesimipond(ministre)
197 #mateff<-makesimi(tot)
198 #mateff<-makejac(tot)
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)
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)
214 #matave<-makesimi(ministre)
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]
226 for (i in 1:nrow(chis)) {
227 vcolb[i]<-which.max(chis[i,])
230 for (i in 1:length(eff)){
231 #if (as.integer(pn[i])==0){
235 #vcol[i]<-rain[as.integer(pn[i])]
236 vcol[i]<-rain[as.integer(vcolb[i])]
238 #ll<-which(effp>=0.5)
239 #for (i in which(effp>=0.5)) {
246 #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]
252 print('premier graph')
255 g1<-graph.adjacency(m,mode="lower",weighted=TRUE)
257 #maxtree<-maxgraph(g1)
258 #plot(maxtree, layout=layout.circle)
259 #lo<-layout.circle(g1)
261 weori<-get.edge.attribute(g1,'weight')
262 #tdel<-which(weori<3)
263 we<-(weori/max(weori))*4
264 print('arbre maximum')
267 g3<-minimum.spanning.tree(g1)
268 E(g3)$weight<-1/E(g3)$weight
273 wee<-(E(g3)$weight/max(E(g3)$weight))*10
276 #lo<-layout.kamada.kawai(g3,dim=3)
277 lo<-layout.fruchterman.reingold(g3,dim=3)
280 #lo<-layout.sphere(g3)
282 vsize<-vector(mode='integer',length=nrow(lo))
286 #g2<-delete.edges(g2,tdel-1)
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)
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)
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)