www.iramuteq.org Git - iramuteq/blob - Rscripts/simied.R

   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 }
  27
  28
  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 }
  55
  56
  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 }
  82
  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 }
 100
 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 ###################################################################
 121
 122 source('/home/pierre/workspace/iramuteq/Rscripts/chdfunct.R')
 123
 124 #}
 125 print('lecture')
 126
 127
 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')
 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 #
 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)
 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]]
 150
 151 ##########################################################
 152 #SUP
 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)]
 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
 163
 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)
 187
 188
 189
 190 print('matrice de similitude')
 191 mindus<-makesimip(tot)
 192 m<-mindus$m
 193 eff<-mindus$eff
 194
 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
 213
 214 #matave<-makesimi(ministre)
 215 #m<-matave$m
 216 #eff<-matave$eff
 217
 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')
 255 g1<-graph.adjacency(m,mode="lower",weighted=TRUE)
 256
 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')
 276 #lo<-layout.kamada.kawai(g3,dim=3)
 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)
 306
 307
 308
 309
 310
 311 #Ministre