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')
7 dpt <- chistabletot[tc,]
8 #dpt <- chistabletot[debet:nrow(chistabletot),]
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))
16 #tot <- afctable[debet:nrow(afctable),]
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))
27 tt <- apply(tt, 2, as.numeric)
32 ptt <- prop.table(as.matrix(tt), 1)
35 z <- which(names(tcl)=="0")
36 if (length(z) != 0) {tcl <- tcl[-z]}
43 dd <- apply(dd,2, as.numeric)
51 tree1 <- tree.cut1$tree.cl
52 tree1 <- compute.brlen(tree1)
53 tree1 <- as.hclust(tree1)
60 cc[which(dd <= (-3.84))] <- 1
61 cc[which((dd > (-3.84)) & (dd < 3.84))] <- 2
62 cc[which(dd >= 3.84)] <- 3
64 #col <- brewer.pal(3, 'Reds')
65 #col <- c('red', 'green', 'blue')
66 col <- c('black', 'black', 'red')
67 col <- c('white', 'white', 'blue')
71 clod <- rev(as.numeric(tree.cut1$tree.cl$tip.label))
73 heatmap(as.matrix(dd[as.numeric(tree.cut1$tree.cl$tip.label),]), Colv=NA, Rowv=as.dendrogram(tree1), col=col)
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))
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))
81 plot.phylo(tree.cut1$tree.cl,label.offset=0.1)
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
91 lcol <- as.numeric(lcol)
93 #lcol[which(lcol <= 9)] <- 1
95 mcol <- rainbow(nrow(dd))[i]
98 last.col <- c(last.col, rgb(r=col2rgb(mcol)[1]/255, g=col2rgb(mcol)[2]/255, b=col2rgb(mcol)[3]/255, a=k))
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)
106 legend('right', as.character(lk), fill=last.col)
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))
113 plot.phylo(tree.cut1$tree.cl,label.offset=0.1)
114 ncol <- rainbow(nrow(dd))
118 barplot(dd[i,], width=ptc, names.arg=FALSE, axes=FALSE, col=ncol[i])
124 vcol <- rainbow(nrow(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)
131 for (i in 1:length(ulcol)) {
132 lcol[which(lcol==ulcol[i])] <- i
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)
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)
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)
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)) {
151 barplot(as.matrix(ptt[i,od], ncol=1), col=colod, axes=FALSE)
158 lcol <- c(lcol, qchisq(1-k,1))
162 lcol <- c(3.84, lcol)
166 #lcol <- c(-rev(lcol), lcol)
167 #lk <- c(-rev(lk), lk)
168 #lcol <- c(min(dd), lcol)
170 #breaks <- c(lcol, max(dd))
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
179 lcol <- as.numeric(lcol)
182 make.chi <- function(x) {
191 select.chi.classe <- function(tablechi, nb, active = TRUE) {
193 if (active & !is.null(debsup)) {
195 print('###############################################################@')
196 tablechi <- tablechi[1:(debsup-1),]
197 } else if (!active & !is.null(debsup)) {
198 tablechi <- tablechi[debsup:(debet-1),]
200 if (nb > nrow(tablechi)) {
203 for (i in 1:ncol(tablechi)) {
204 rowkeep <- append(rowkeep,order(tablechi[,i], decreasing = TRUE)[1:nb])
206 rowkeep <- unique(rowkeep)
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) {
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]))
221 tree.order<- as.numeric(tree$tip.label)
224 for (i in 1:length(sum.cl)) vec.mat<-append(vec.mat,1)
226 for (i in 1:length(sum.cl)) {
227 vec.mat<-append(vec.mat,v)
231 layout(matrix(vec.mat,length(sum.cl),2), heights=tclp[clod], widths=c(0.15,0.85))
233 row.keep <- select.chi.classe(chisqtable, nbbycl)
234 toplot <- chisqtable[row.keep,]
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
245 sup.keep <- select.chi.classe(chisqtable, nbbycl, active = FALSE)
246 toplot.sup <- chisqtable[debsup:(debet+1),]
247 toplot.sup <- toplot.sup[sup.keep, ]
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
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))
262 col <- rainbow(length(sum.cl))[as.numeric(tree$tip.label)]
263 colcloud <- rainbow(length(sum.cl))
268 tree$tip.label <- lab
270 tree[[2]]<-paste('classe ',tree[[2]])
272 plot.phylo(tree,label.offset=0.1,tip.col=col, type=type.dendro)
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])
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])
284 for (i in rev(tree.order)) {
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
292 lcol <- as.numeric(lcol)
294 #lcol[which(lcol <= 9)] <- 1
296 mcol <- rainbow(nrow(dd))[i]
299 last.col <- c(last.col, rgb(r=col2rgb(mcol)[1]/255, g=col2rgb(mcol)[2]/255, b=col2rgb(mcol)[3]/255, a=k))
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))
309 filename.to.svg <- function(filename) {
310 filename <- gsub('.png', '.svg', filename)
314 open_file_graph <- function (filename, width=800, height = 800, quality = 100, svg = FALSE) {
315 if (Sys.info()["sysname"] == 'Darwin') {
317 height <- height/74.97
319 quartz(file = filename, type = 'png', width = width, height = height)
321 svg(filename.to.svg(filename), width=width, height=height)
325 svg(filename.to.svg(filename), width=width/74.97, height=height/74.97)
327 png(filename, width=width, height=height)#, quality = quality)
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)