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

   1
   2
   3 load('mariagepourtousnov-jui_corpus_corpus_1/mariagepourtousnov-jui_corpus_alceste_2/RData.RData')
   4 load('mariagegaynov-jui_corpus_corpus_1/mariagegaynov-jui_corpus_alceste_3/RData.RData')
   5 load('mariagehomonov-jui_corpus_corpus_1/mariagehomonov-jui_corpus_alceste_2/RData.RData')
   6
   7 dpt <- chistabletot[tc,]
   8 #dpt <- chistabletot[debet:nrow(chistabletot),]
   9 dd <-rownames(dpt)
  10 dd <- strptime(dd, "*date_%Y-%m-%d")
  11 dd <- strptime(dd, "%Y-%m-%d")
  12 dd <- cbind(as.character(dd), dpt)
  13 dd <- dd[order(dd[,1]),]
  14 dd <- add.missing.date(dd,c.dates = 1, datedeb=c(07,11,2012), datefin=c(31,07,2013))
  15
  16 #tot <- afctable[debet:nrow(afctable),]
  17 tot <- afctable[tc,]
  18 tt <- rownames(tot)
  19 tt <- strptime(tt, "*date_%Y-%m-%d")
  20 tt <- strptime(tt, "%Y-%m-%d")
  21 tt <- cbind(as.character(tt), tot)
  22 tt <- tt[order(tt[,1]),]
  23 tt <- add.missing.date(tt, c.dates = 1, datedeb=c(07,11,2012), datefin=c(31,07,2013))
  24
  25 rn <- tt[,1]
  26 tt <- tt[,-1]
  27 tt <- apply(tt, 2, as.numeric)
  28 rownames(tt) <- rn
  29 tcp <- rowSums(tt)
  30 ptc <- tcp/sum(tcp)
  31
  32 ptt <- prop.table(as.matrix(tt), 1)
  33
  34 tcl <- table(classes)
  35 z <- which(names(tcl)=="0")
  36 if (length(z) != 0) {tcl <- tcl[-z]}
  37 tclp <- tcl/sum(tcl)
  38
  39
  40
  41 rn <- dd[,1]
  42 dd <- dd[,-1]
  43 dd <- apply(dd,2, as.numeric)
  44 rownames(dd) <- rn
  45
  46
  47
  48 library(ape)
  49
  50
  51 tree1 <- tree.cut1$tree.cl
  52 tree1 <- compute.brlen(tree1)
  53 tree1 <- as.hclust(tree1)
  54
  55
  56
  57 dd <- t(dd)
  58
  59 cc <- dd
  60 cc[which(dd <= (-3.84))] <- 1
  61 cc[which((dd > (-3.84)) & (dd < 3.84))] <- 2
  62 cc[which(dd >= 3.84)] <- 3
  63 library(RColorBrewer)
  64 #col <- brewer.pal(3, 'Reds')
  65 #col <- c('red', 'green', 'blue')
  66 col <- c('black', 'black', 'red')
  67 col <- c('white', 'white', 'blue')
  68 col <- col[cc]
  69
  70
  71 clod <- rev(as.numeric(tree.cut1$tree.cl$tip.label))
  72
  73 heatmap(as.matrix(dd[as.numeric(tree.cut1$tree.cl$tip.label),]), Colv=NA, Rowv=as.dendrogram(tree1), col=col)
  74
  75 png('cl_dates_homo.png', h=1000, w=2500)
  76 alphas <- seq(0,1, length.out=length(breaks))
  77 #par(mfrow=c(nrow(dd),1))
  78 par(mar=c(3,3,3,3))
  79 layout(matrix(c(rep(1,nrow(dd)),c(2:(nrow(dd)+1)),c(rep(nrow(dd)+2, nrow(dd)))),ncol=3), heights=tclp[clod], widths=c(0.05,0.92,0.03))
  80 par(mar=c(0,0,0,0))
  81 plot.phylo(tree.cut1$tree.cl,label.offset=0.1)
  82 for (i in clod) {
  83     print(i)
  84     par(mar=c(0,0,0,0))
  85     lcol <- cut(dd[i,], breaks, include.lowest=TRUE)
  86     ulcol <- names(table(lcol))
  87     lcol <- as.character(lcol)
  88     for (j in 1:length(ulcol)) {
  89         lcol[which(lcol==ulcol[j])] <- j
  90     }
  91     lcol <- as.numeric(lcol)
  92
  93     #lcol[which(lcol <= 9)] <- 1
  94
  95     mcol <- rainbow(nrow(dd))[i]
  96     last.col <- NULL
  97     for (k in alphas) {
  98         last.col <- c(last.col, rgb(r=col2rgb(mcol)[1]/255, g=col2rgb(mcol)[2]/255, b=col2rgb(mcol)[3]/255, a=k))
  99     }
 100     print(last.col)
 101
 102     barplot(rep(1,ncol(dd)), width=ptc, names.arg=FALSE, axes=FALSE, col=last.col[lcol], border=rgb(r=0, g=0, b=0, a=0.3))
 103 #val2col(dd[i,], col=heat.colors(30)), border=NA)
 104 }
 105 plot.new()
 106 legend('right', as.character(lk), fill=last.col)
 107
 108 dev.off()
 109
 110
 111 layout(matrix(c(rep(1,nrow(dd)),c(2:(nrow(dd)+1)),c(rep(nrow(dd)+2, nrow(dd)))),ncol=3), heights=tclp[clod], widths=c(0.05,0.92,0.03))
 112 par(mar=c(0,0,0,0))
 113 plot.phylo(tree.cut1$tree.cl,label.offset=0.1)
 114 ncol <- rainbow(nrow(dd))
 115 for (i in clod) {
 116     print(i)
 117     par(mar=c(0,0,0,0))
 118     barplot(dd[i,], width=ptc, names.arg=FALSE, axes=FALSE, col=ncol[i])
 119 }
 120
 121
 122
 123
 124 vcol <- rainbow(nrow(dd))
 125 ncoli <- dd
 126 for (i in 1:nrow(dd)) {
 127     lcol <- cut(dd[1,], breaks, include.lowest=TRUE)
 128     ulcol <- names(table(lcol))
 129     lcol <- as.character(lcol)
 130     rlcol <- rank()
 131     for (i in 1:length(ulcol)) {
 132         lcol[which(lcol==ulcol[i])] <- i
 133     }
 134     lcol <- as.numeric(lcol)
 135     for (j in 1:ncol(dd)) {
 136         if (dd[i,j] < 3.84) {
 137             ncoli[i,j] <- rgb(r=col2rgb(vcol[i])[1]/255, g=col2rgb(vcol[i])[2]/255, b=col2rgb(vcol[i])[3]/255, a=0.2)
 138         } else {
 139             ncoli[i,j] <- rgb(r=col2rgb(vcol[i])[1]/255, g=col2rgb(vcol[i])[2]/255, b=col2rgb(vcol[i])[3]/255, a=1)
 140         }
 141     }
 142 }
 143
 144 barplot(t(ptt)[as.numeric(tree.cut1$tree.cl$tip.label),], col=rainbow(ncol(ptt))[as.numeric(tree.cut1$tree.cl$tip.label)], width=ptc, las=3, space=0.05, cex.axis=0.7, border=NA)
 145
 146 layout(matrix(c(1:nrow(ptt)), nrow=1),  widths=ptc)
 147 od <- as.numeric(tree.cut1$tree.cl$tip.label)
 148 colod = rainbow(ncol(ptt))[od]
 149 for (i in 1:ncol(ptt)) {
 150     par(mar=c(0,0,0,0))
 151     barplot(as.matrix(ptt[i,od], ncol=1), col=colod, axes=FALSE)
 152 }
 153
 154 k <- 1e-02
 155 lcol <- NULL
 156 lk <- k
 157 for (i in 1:5) {
 158     lcol <- c(lcol, qchisq(1-k,1))
 159     k <- k/10
 160     lk <- c(lk,k)
 161 }
 162 lcol <- c(3.84, lcol)
 163 lcol <- c(-Inf,lcol)
 164 lcol <- c(lcol, Inf)
 165 lk <- c(0.05,lk)
 166 #lcol <- c(-rev(lcol), lcol)
 167 #lk <- c(-rev(lk), lk)
 168 #lcol <- c(min(dd), lcol)
 169 #lk <- c(1, lk)
 170 #breaks <- c(lcol, max(dd))
 171 breaks <- lcol
 172
 173 lcol <- cut(dd[1,], breaks)
 174 ulcol <- names(table(lcol))
 175 lcol <- as.character(lcol)
 176 for (i in 1:length(ulcol)) {
 177     lcol[which(lcol==ulcol[i])] <- i
 178 }
 179 lcol <- as.numeric(lcol)
 180
 181
 182 make.chi <- function(x) {
 183     rs <- rowSums(x)
 184     cs <- colSums(x)
 185     n <- sum(x)
 186
 187 }
 188
 189
 190
 191 select.chi.classe <- function(tablechi, nb, active = TRUE) {
 192     rowkeep <- NULL
 193     if (active & !is.null(debsup)) {
 194         print(debsup)
 195         print('###############################################################@')
 196         tablechi <- tablechi[1:(debsup-1),]
 197     } else if (!active & !is.null(debsup)) {
 198         tablechi <- tablechi[debsup:(debet-1),]
 199     }
 200     if (nb > nrow(tablechi)) {
 201         nb <- nrow(tablechi)
 202     }
 203     for (i in 1:ncol(tablechi)) {
 204         rowkeep <- append(rowkeep,order(tablechi[,i], decreasing = TRUE)[1:nb])
 205     }
 206     rowkeep <- unique(rowkeep)
 207     rowkeep
 208 }
 209
 210
 211 plot.dendro.cloud <- function(tree, classes, chisqtable, nbbycl = 60, type.dendro = "phylogram", max.cex=2, min.cex=0.3, from.cmd = FALSE, bw = FALSE, lab = NULL, do.cloud=FALSE) {
 212     library(wordcloud)
 213     library(ape)
 214     classes<-classes[classes!=0]
 215         classes<-as.factor(classes)
 216         sum.cl<-as.matrix(summary(classes, maxsum=1000000))
 217         sum.cl<-(sum.cl/colSums(sum.cl)*100)
 218         sum.cl<-round(sum.cl,2)
 219         sum.cl<-cbind(sum.cl,as.matrix(100-sum.cl[,1]))
 220     sum.cl <- sum.cl[,1]
 221     tree.order<- as.numeric(tree$tip.label)
 222         vec.mat<-NULL
 223
 224         for (i in 1:length(sum.cl)) vec.mat<-append(vec.mat,1)
 225         v<-2
 226         for (i in 1:length(sum.cl)) {
 227                 vec.mat<-append(vec.mat,v)
 228                 v<-v+1
 229         }
 230         if (!do.cloud) {
 231         layout(matrix(vec.mat,length(sum.cl),2), heights=tclp[clod], widths=c(0.15,0.85))
 232         } else {
 233                 row.keep <- select.chi.classe(chisqtable, nbbycl)
 234                 toplot <- chisqtable[row.keep,]
 235                 lclasses <- list()
 236                 for (classe in 1:length(sum.cl)) {
 237                         ntoplot <- toplot[,classe]
 238                         ntoplot <- ntoplot[order(ntoplot, decreasing = TRUE)]
 239                         ntoplot <- round(ntoplot, 0)
 240                         ntoplot <- ntoplot[1:nbbycl]
 241                         ntoplot <- ntoplot[order(ntoplot)]
 242                         #ntoplot <- ifelse(length(ntoplot) > nbbycl, ntoplot[1:nbbycl], ntoplot)
 243                         lclasses[[classe]] <- ntoplot
 244                 }
 245                 sup.keep <- select.chi.classe(chisqtable, nbbycl, active = FALSE)
 246                 toplot.sup <- chisqtable[debsup:(debet+1),]
 247                 toplot.sup <- toplot.sup[sup.keep, ]
 248                 lsup <- list()
 249                 for (classe in 1:length(sum.cl)) {
 250                         ntoplot <- toplot.sup[,classe]
 251                         ntoplot <- ntoplot[order(ntoplot, decreasing = TRUE)]
 252                         ntoplot <- round(ntoplot, 0)
 253                         ntoplot <- ntoplot[1:nbbycl]
 254                         ntoplot <- ntoplot[order(ntoplot)]
 255                         #ntoplot <- ifelse(length(ntoplot) > nbbycl, ntoplot[1:nbbycl], ntoplot)
 256                         lsup[[classe]] <- ntoplot
 257                 }
 258         layout(matrix(c(rep(1,nrow(dd)),c(2:(nrow(dd)+1)),c((nrow(dd)+2):(2*nrow(dd)+1)), c((2*nrow(dd)+2):(3*nrow(dd)+1))),ncol=4), heights=tclp[clod], widths=c(0.05,0.05,0.05, 0.85))
 259         }
 260
 261     if (! bw) {
 262         col <- rainbow(length(sum.cl))[as.numeric(tree$tip.label)]
 263         colcloud <- rainbow(length(sum.cl))
 264     }
 265     par(mar=c(0,0,0,0))
 266     label.ori<-tree[[2]]
 267     if (!is.null(lab)) {
 268         tree$tip.label <- lab
 269     } else {
 270             tree[[2]]<-paste('classe ',tree[[2]])
 271     }
 272         plot.phylo(tree,label.offset=0.1,tip.col=col, type=type.dendro)
 273         if (do.cloud) {
 274             for (i in rev(tree.order)) {
 275                 par(mar=c(0,0,1,0),cex=0.9)
 276                 wordcloud(names(lclasses[[i]]), lclasses[[i]], scale = c(max.cex, min.cex), random.order=FALSE, colors = colcloud[i])
 277             }
 278             for (i in rev(tree.order)) {
 279                 par(mar=c(0,0,1,0),cex=0.9)
 280                 wordcloud(names(lsup[[i]]), lsup[[i]], scale = c(max.cex, min.cex), random.order=FALSE, colors = colcloud[i])
 281             }
 282         }
 283
 284     for (i in rev(tree.order)) {
 285         par(mar=c(0,0,0,0))
 286         lcol <- cut(dd[i,], breaks, include.lowest=TRUE)
 287         ulcol <- names(table(lcol))
 288         lcol <- as.character(lcol)
 289         for (j in 1:length(ulcol)) {
 290             lcol[which(lcol==ulcol[j])] <- j
 291         }
 292         lcol <- as.numeric(lcol)
 293
 294         #lcol[which(lcol <= 9)] <- 1
 295
 296         mcol <- rainbow(nrow(dd))[i]
 297         last.col <- NULL
 298         for (k in alphas) {
 299             last.col <- c(last.col, rgb(r=col2rgb(mcol)[1]/255, g=col2rgb(mcol)[2]/255, b=col2rgb(mcol)[3]/255, a=k))
 300         }
 301         print(last.col)
 302
 303         barplot(rep(1,ncol(dd)), width=ptc, names.arg=FALSE, axes=FALSE, col=last.col[lcol], border=rgb(r=0, g=0, b=0, a=0.3))
 304
 305     }
 306 }
 307
 308
 309 filename.to.svg <- function(filename) {
 310         filename <- gsub('.png', '.svg', filename)
 311         return(filename)
 312 }
 313
 314 open_file_graph <- function (filename, width=800, height = 800, quality = 100, svg = FALSE) {
 315         if (Sys.info()["sysname"] == 'Darwin') {
 316         width <- width/74.97
 317         height <- height/74.97
 318         if (!svg) {
 319                     quartz(file = filename, type = 'png', width = width, height = height)
 320         } else {
 321             svg(filename.to.svg(filename), width=width, height=height)
 322         }
 323         } else {
 324         if (svg) {
 325             svg(filename.to.svg(filename), width=width/74.97, height=height/74.97)
 326         } else {
 327                     png(filename, width=width, height=height)#, quality = quality)
 328         }
 329         }
 330 }
 331
 332
 333
 334 open_file_graph('cl_cloud_dates_gay.png', height=900, width=2500, svg=TRUE)
 335 plot.dendro.cloud(tree.cut1$tree.cl, classes, chistabletot, from.cmd=TRUE)
 336
 337 dev.off()