iramuteq.org Git - iramuteq/blob - Rscripts/multipam.R

   1 library(cluster)
   2
   3 #data<-read.table('output/corpus_bin.csv',header=TRUE,sep='\t')
   4
   5 multipam<-function(data,x=9){
   6         dataori=data
   7         dtable=data
   8         a<-0
   9         for (m in 1:length(dtable)) {
  10             if (sum(dtable[m-a])==0) {
  11                 print('colonne vide')
  12                 dtable<-dtable[,-(m-a)]
  13                 a<-a+1
  14             }
  15         }
  16         for (i in 1:x) {
  17                 clnb<-(i*2)
  18                 #construction de la matrice des distances
  19         dissmat<-dist(dtable,method='binary')#FIXME: rendre optionnelle la methode
  20         #bipartition
  21         pm<-pam(dissmat,diss=TRUE,k=2)
  22                 print(pm)
  23                 #listclasse<-ifelse(coordrow<0,paste('CLASSE',clnb,sep=''),paste('CLASSE',clnb+1,sep=''))
  24         #selection de la classe la moins homogène
  25         clusinf<-pm$clusinfo
  26                 if (i==1){
  27                 listclust<-clusinf[,2]
  28                 } else {
  29                         listclust<-rbind(listclust,clusinf[,2])
  30                 }
  31
  32         listclasse=as.data.frame(pm$clustering)[,1]
  33         #ajout du classement au tableau
  34                 dtable<-transform(dtable,cl1=listclasse)
  35                 print(dtable)
  36                 #lignes concernees
  37                 listrownamedtable<-rownames(dtable)
  38                 listrownamedtable<-as.integer(listrownamedtable)
  39         newcol<-vector(length=nrow(dataori))
  40                 #remplissage de la nouvelle colonne avec les nouvelles classes
  41                 num<-0
  42                 for (ligne in listrownamedtable) {
  43                         num<-num+1
  44                         newcol[ligne]<-as.vector(dtable$cl1[num])[1]
  45                 }
  46                 #recuperation de la classe precedante pour les cases vides
  47                 matori<-as.matrix(dataori)
  48         if (i!=1) {
  49         #    options(warn=-1)
  50             for (ligne in 1:length(newcol)) {
  51          #       print(newcol[ligne])
  52                 if (newcol[ligne]==0) { # ce test renvoie un warning
  53                     newcol[ligne]<-matori[ligne,length(matori[1,])]
  54                 }
  55             }
  56          #   options(warn=0)
  57         }
  58         #print(newcol)
  59                 #???????????????????????????????????
  60                 #je ne comprends pas : j'ai vraiment besoin de faire ces deux actions  pour ajouter la nouvelle colonne aux donnees ?
  61                 #si je ne le fais pas, ca plante...
  62                 dataori<-cbind(dataori,newcol)
  63                 dataori<-transform(dataori,newcol=newcol)
  64                 #???????????????????????????????????
  65
  66                 #liste des noms de colonne
  67                 #colname<-colnames(dataori)
  68                 #nom de la derniere colonne
  69                 #colname<-colname[length(dataori)]
  70                 #la derniere colonne
  71                 colclasse<-as.character(dataori[,ncol(dataori)])
  72                 #print(colclasse)
  73         #les modalites de la derniere colonne
  74                 classes<-levels(as.factor(colclasse))
  75                 print(classes)
  76                 #determination de la classe la plus grande
  77                 tailleclasse<-paste(NULL,1:length(classes))
  78                 b<-0
  79                 for (classe in classes) {
  80                    b<-b+1
  81                    dtable<-dataori[dataori[length(dataori)]==classe,]
  82                    tailleclasse[b]<-length(dtable[,1])
  83                 }
  84                 tailleclasse<-as.integer(tailleclasse)
  85                 print(tailleclasse)
  86                 plusgrand<-which(tailleclasse==max(tailleclasse))
  87
  88                 #???????????????????????????????????
  89                 #Si 2 classes ont des effectifs egaux, on prend la premiere de la liste...
  90                 if (length(plusgrand)>1) {
  91                         plusgrand<-plusgrand[1]
  92                 }
  93                 #????????????????????????????????????
  94
  95                 #constuction du prochain tableau a analyser
  96                 classe<-classes[plusgrand]
  97                 dtable<-dataori[dataori[length(dataori)]==classe,]
  98                 dtable<-dtable[,1:(length(dtable)-i)]
  99                 #elimination des colonnes ne contenant que des 0
 100                 a<-0
 101                 for (m in 1:length(dtable)) {
 102                         if (sum(dtable[m-a])==0) {
 103                                 dtable<-dtable[,-(m-a)]
 104                                 a<-a+1
 105                         }
 106                 }
 107         }
 108         dataori[(length(dataori)-x+1):length(dataori)]
 109 }
 110
 111 dm<-read.csv2('/home/pierre/fac/maitrise/classification/simi01.csv',row.names=1)
 112 multipam(dm)
 113 #dataout<-CHD(data,9)
 114
 115 #library(cluster)
 116 #dissmat<-daisy(dataout, metric = 'gower', stand = FALSE)
 117 #chd<-diana(dissmat,diss=TRUE,)
 118
 119
 120 #pour tester le type, passer chaque colonne en matice et faire mode(colonne)
 121 #for (i in 1:13) {tmp<-as.matrix(data[i]);print(mode(tmp))}