www.iramuteq.org Git - iramuteq/blob - Rscripts/CHD.R.old

   1 #library(ca)
   2 #library(MASS)
   3 #source('/home/pierre/workspace/iramuteq/Rscripts/afc.R')
   4 #data<-read.table('output/corpus_bin.csv',header=TRUE,sep='\t')
   5 source('/home/pierre/workspace/iramuteq/Rscripts/anacor.R')
   6
   7 CHD<-function(data,x=9){
   8         dataori=data
   9         dtable=data
  10         listcol<-list()
  11         listmere<-list()
  12         a<-0
  13         print('vire colonnes vides en entree')#FIXME : il ne doit pas y avoir de colonnes vides en entree !!
  14         for (m in 1:length(dtable)) {
  15             if (sum(dtable[m-a])==0) {
  16                 print('colonne vide')
  17                         dtable<-dtable[,-(m-a)]
  18                         a<-a+1
  19             }
  20     }
  21         for (i in 1:x) {
  22                 clnb<-(i*2)
  23                 listmere[[clnb]]<-i
  24                 listmere[[clnb+1]]<-i
  25                 listcol[[clnb]]<-vector()
  26                 listcol[[clnb+1]]<-vector()
  27                 #extraction du premier facteur de l'afc
  28                 print('afc')
  29                 #afc<-ca(dtable,nd=1)
  30                 #afc<-corresp(dtable,nd=1)
  31                 #afc<-fca(dtable)
  32                 afc<-boostana(dtable,nd=1)
  33                 #coordonnees des colonnes sur le premier facteur
  34                 #coordrow=afc$rowcoord
  35                 #coordrow=as.matrix(afc$rscore)
  36                 #coordrow<-as.matrix(afc$rproj[,1])
  37                 coordrow<-as.matrix(afc$row.scores)
  38                 #row.names(coordrow)<-afc$rownames
  39                 row.names(coordrow)<-rownames(dtable)
  40                 #classement en fonction de la position sur le premier facteur
  41                 #listclasse<-ifelse(coordrow<0,paste('CLASSE',clnb,sep=''),paste('CLASSE',clnb+1,sep=''))
  42
  43                 print('deb recherche meilleur partition')
  44                 coordrow<-as.matrix(coordrow[order(coordrow[,1]),])
  45                 #print(rownames(coordrow))
  46                 zeropoint<-which.min(abs(coordrow))
  47                 print(zeropoint)
  48                 g<-length(coordrow[coordrow[,1]<coordrow[zeropoint]])
  49                 d<-length(coordrow[coordrow[,1]>coordrow[zeropoint]])
  50                 prct<-1
  51                 g<-round(g*prct)
  52                 d<-round(d*prct)
  53                 print(g)
  54                 print(d)
  55                 temptable<-as.matrix(coordrow[(zeropoint-g):(zeropoint+d)])
  56                 row.names(temptable)<-rownames(coordrow)[(zeropoint-g):(zeropoint+d)]
  57                 #print(temptable)
  58                 missing<-zeropoint-g
  59                 listchi<-vector()
  60                 chtable<-matrix(0,2,(ncol(dtable)))
  61                 totforme<-chtable[1,]
  62                 for (forme in 1:(ncol(dtable))) {
  63                         totforme[forme]<-sum(dtable[,forme])
  64                 }
  65                 chtable[2,]<-totforme
  66                 for (l in 1:length(temptable)) {
  67                 #       print(rownames(temptable)[l])
  68                         linetoswitch=as.matrix(dtable[rownames(temptable)[l],])
  69                 #       print(linetoswitch)
  70                         chtable[1,]<-chtable[1,]+linetoswitch
  71                         chtable[2,]<-chtable[2,]-linetoswitch
  72                         valchi<-chisq.test(chtable)$statistic
  73                         if (is.na(valchi)){
  74                                 valchi<-0
  75                         }
  76                         listchi<-append(listchi,valchi)
  77                 }
  78                 #listchi<-listchi[!is.na(listchi)]
  79                 maxchi<-which(listchi==max(listchi))
  80                 print(max(listchi))
  81                 print(maxchi)
  82                 maxchi<-maxchi+missing
  83                 #print(listchi)
  84                 #listclasse
  85                 print('liste classe')
  86                 print(coordrow[(maxchi)])
  87                 listclasse<-ifelse(coordrow<=coordrow[(maxchi)],clnb,clnb+1)
  88 #               listclasse<-ifelse(coordrow<0,clnb,clnb+1)
  89                 listchi<-as.matrix(listchi)
  90                 listchi<-cbind(listchi,temptable)
  91                 filename<-paste('graphechi',as.character(i))
  92                 filename<-paste(filename,'.jpeg')
  93                 jpeg(filename)
  94                 plot(listchi[,1]~listchi[,2])
  95                 abline(v=0)
  96                 print(coordrow[zeropoint-g])
  97                 abline(v=coordrow[zeropoint-g])
  98                 abline(v=coordrow[zeropoint+d])
  99                 abline(v=coordrow[(maxchi)])
 100                 dev.off()
 101
 102                 #ajout du classement au tableau
 103                 dtable<-transform(dtable,cl1=listclasse)
 104
 105                 #calcul de la specificite des colonnes
 106                 t1<-dtable[dtable$cl1==clnb,]
 107                 t2<-dtable[dtable$cl1==clnb+1,]
 108
 109                 for (k in 1:(ncol(dtable)-1)) {
 110                         t<-matrix(0,2,2)
 111                         t[1,1]<-sum(t1[,k])
 112                         t[1,2]<-sum(t2[,k])
 113                         t[2,1]<-nrow(t1)-t[1,1]
 114                         t[2,2]<-nrow(t2)-t[1,2]
 115                         chi<-chisq.test(t)
 116                         if (chi$statistic>6){#FIXME : valeur a mettre en option base :2.7
 117                                 if (chi$expected[1,1]<t[1,1]){
 118                                         listcol[[clnb+1]]<-append(listcol[[clnb+1]],k)
 119                                 } else {
 120                                         listcol[[clnb]]<-append(listcol[[clnb]],k)
 121                                 }
 122                         }
 123                 }
 124
 125                 #lignes concernees
 126                 listrownamedtable<-rownames(dtable)
 127                 listrownamedtable<-as.integer(listrownamedtable)
 128         newcol<-vector(length=nrow(dataori))
 129                 #remplissage de la nouvelle colonne avec les nouvelles classes
 130                 print('remplissage')
 131                 num<-0
 132                 for (ligne in listrownamedtable) {
 133                         num<-num+1
 134                         newcol[ligne]<-as.vector(dtable$cl1[num])[1]
 135                 }
 136                 #recuperation de la classe precedante pour les cases vides
 137                 print('recuperation classes precedentes')
 138                 matori<-as.matrix(dataori)
 139         if (i!=1) {
 140         #    options(warn=-1)
 141             for (ligne in 1:length(newcol)) {
 142          #       print(newcol[ligne])
 143                 if (newcol[ligne]==0) { # ce test renvoie un warning
 144                     newcol[ligne]<-matori[ligne,length(matori[1,])]
 145                 }
 146             }
 147          #   options(warn=0)
 148         }
 149                 #???????????????????????????????????
 150                 #je ne comprends pas : j'ai vraiment besoin de faire ces deux actions  pour ajouter la nouvelle colonne aux donnees ?
 151                 #si je ne le fais pas, ca plante...
 152                 dataori<-cbind(dataori,newcol)
 153                 dataori<-transform(dataori,newcol=newcol)
 154                 #???????????????????????????????????
 155
 156                 #liste des noms de colonne
 157                 #colname<-colnames(dataori)
 158                 #nom de la derniere colonne
 159                 #colname<-colname[length(dataori)]
 160                 #la derniere colonne
 161                 colclasse<-as.character(dataori[,ncol(dataori)])
 162                 #print(colclasse)
 163         #les modalites de la derniere colonne
 164                 classes<-levels(as.factor(colclasse))
 165                 print(classes)
 166                 #determination de la classe la plus grande
 167                 tailleclasse<-paste(NULL,1:length(classes))
 168                 b<-0
 169                 for (classe in classes) {
 170                    b<-b+1
 171                    dtable<-dataori[dataori[length(dataori)]==classe,]
 172                    tailleclasse[b]<-length(dtable[,1])
 173                 }
 174                 tailleclasse<-as.integer(tailleclasse)
 175                 print(tailleclasse)
 176                 plusgrand<-which(tailleclasse==max(tailleclasse))
 177
 178                 #???????????????????????????????????
 179                 #Si 2 classes ont des effectifs egaux, on prend la premiere de la liste...
 180                 if (length(plusgrand)>1) {
 181                         plusgrand<-plusgrand[1]
 182                 }
 183                 #????????????????????????????????????
 184
 185                 #constuction du prochain tableau a analyser
 186                 print('construction tableau suivant')
 187                 classe<-classes[plusgrand]
 188                 dtable<-dataori[dataori[length(dataori)]==classe,]
 189                 dtable<-dtable[,1:(length(dtable)-i)]
 190
 191
 192                 listcolelim<-listcol[[as.integer(classe)]]
 193                 mother<-listmere[[as.integer(classe)]]
 194                 while (mother!=1) {
 195                         listcolelim<-append(listcolelim,listcol[[mother]])
 196                         print(listcolelim)
 197                         mother<-listmere[[mother]]
 198                 }
 199
 200                 listcolelim<-sort(unique(listcolelim))
 201                 print(listcolelim)
 202                 print('avant')
 203                 print(ncol(dtable))
 204                 if (!is.logical(listcolelim)){
 205                         print('elimination colonne')
 206                         a<-0
 207                         for (col in listcolelim){
 208                                 dtable<-dtable[,-(col-a)]
 209                                 a<-a+1
 210                         }
 211                 }
 212                 print('apres')
 213                 print(ncol(dtable))
 214                 #elimination des colonnes ne contenant que des 0
 215                 print('vire colonne vide dans boucle')
 216                 a<-0
 217                 for (m in 1:ncol(dtable)) {
 218                         if (sum(dtable[,m-a])==0) {
 219                                 dtable<-dtable[,-(m-a)]
 220                                 a<-a+1
 221                         }
 222                 }
 223                 #elimination des lignes ne contenant que des 0
 224 #               print('vire ligne vide dans boucle')
 225 #               a<-0
 226 #               for (m in 1:nrow(dtable)) {
 227 #                       if (sum(dtable[m-a,])==0) {
 228 #                               print('ligne vide')
 229 #                               dtable<-dtable[-(m-a),]
 230 #                               a<-a+1
 231 #                       }
 232 #               }
 233         }
 234         dataori[(length(dataori)-x+1):length(dataori)]
 235 }
 236
 237 #dataout<-CHD(data,9)
 238
 239 #library(cluster)
 240 #dissmat<-daisy(dataout, metric = 'gower', stand = FALSE)
 241 #chd<-diana(dissmat,diss=TRUE,)
 242
 243
 244 #pour tester le type, passer chaque colonne en matice et faire mode(colonne)
 245 #for (i in 1:13) {tmp<-as.matrix(data[i]);print(mode(tmp))}