X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=PrintRScript.py;h=af4a9bfa91f9b45dfcf080aecf228ea3aec0b46f;hp=7a847a63dd8903e79eef23fd0d52c690bb94469e;hb=cae026cb9d5c6997818bff728f382f55a1d73acf;hpb=ebaa7c5d0ddfb75fb535f8383acb37beafd91993 diff --git a/PrintRScript.py b/PrintRScript.py index 7a847a6..af4a9bf 100644 --- a/PrintRScript.py +++ b/PrintRScript.py @@ -1,10 +1,10 @@ # -*- coding: utf-8 -*- #Author: Pierre Ratinaud #Copyright (c) 2008-2011 Pierre Ratinaud -#Lisense: GNU/GPL +#License: GNU/GPL import tempfile -from chemins import ffr +from chemins import ffr, PathOut import os import locale from datetime import datetime @@ -18,12 +18,13 @@ class PrintRScript : self.pathout = analyse.pathout self.analyse = analyse self.parametres = analyse.parametres + #self.scriptout = ffr(self.pathout['lastRscript.R']) self.scriptout = self.pathout['temp'] - self.script = u"#Script genere par IRaMuTeQ - %s" % datetime.now().ctime() - + self.script = u"#Script genere par IRaMuTeQ - %s\n" % datetime.now().ctime() + def add(self, txt) : self.script = '\n'.join([self.script, txt]) - + def defvar(self, name, value) : self.add(' <- '.join([name, value])) @@ -33,7 +34,7 @@ class PrintRScript : def sources(self, lsources) : for source in lsources : - self.add('source("%s")' % source) + self.add('source("%s", encoding = \'utf8\')' % ffr(source)) def packages(self, lpks) : for pk in lpks : @@ -41,7 +42,7 @@ class PrintRScript : def load(self, l) : for val in l : - self.add('load("%s")' % val) + self.add('load("%s")' % ffr(val)) def write(self) : with open(self.scriptout, 'w') as f : @@ -109,13 +110,13 @@ class Alceste2(PrintRScript) : # -def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, libsvdc = False, libsvdc_path = None, R_max_mem = False): +def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'svdR', libsvdc = False, libsvdc_path = None, R_max_mem = False, mode_patate = False): txt = """ source("%s") source("%s") source("%s") source("%s") - """ % (RscriptPath['CHD'], RscriptPath['chdtxt'], RscriptPath['anacor'], RscriptPath['Rgraph']) + """ % (ffr(RscriptPath['CHD']), ffr(RscriptPath['chdtxt']), ffr(RscriptPath['anacor']), ffr(RscriptPath['Rgraph'])) if R_max_mem : txt += """ memory.limit(%i) @@ -124,94 +125,117 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, libsvdc = False txt += """ nbt <- %i """ % nbt - if libsvdc : + if svdmethod == 'svdlibc' and libsvdc : txt += """ - libsvdc <- TRUE + svd.method <- 'svdlibc' libsvdc.path <- "%s" """ % ffr(libsvdc_path) + elif svdmethod == 'irlba' : + txt += """ + library(irlba) + svd.method <- 'irlba' + libsvdc.path <- NULL + """ else : txt += """ - libsvdc <- FALSE + svd.method = 'svdR' libsvdc.path <- NULL """ - + if mode_patate : + txt += """ + mode.patate = TRUE + """ + else : + txt += """ + mode.patate = FALSE + """ txt +=""" library(Matrix) data1 <- readMM("%s") data1 <- as(data1, "dgCMatrix") row.names(data1) <- 1:nrow(data1) - """ % DicoPath['TableUc1'] - + """ % ffr(DicoPath['TableUc1']) + if classif_mode == 0: txt += """ data2 <- readMM("%s") data2 <- as(data2, "dgCMatrix") row.names(data2) <- 1:nrow(data2) - """ % DicoPath['TableUc2'] + """ % ffr(DicoPath['TableUc2']) txt += """ - chd1<-CHD(data1, x = nbt, libsvdc = libsvdc, libsvdc.path = libsvdc.path) - """ - + log1 <- "%s" + chd1<-CHD(data1, x = nbt, mode.patate = mode.patate, svd.method = + svd.method, libsvdc.path = libsvdc.path, log.file = log1) + """ % ffr(DicoPath['log-chd1.txt']) + if classif_mode == 0: txt += """ - chd2<-CHD(data2, x = nbt, libsvdc = libsvdc, libsvdc.path = libsvdc.path) - """ - else: - txt += """ - chd2<-chd1 - """ - + log2 <- "%s" + chd2<-CHD(data2, x = nbt, mode.patate = mode.patate, svd.method = + svd.method, libsvdc.path = libsvdc.path) log.file = log2) + """ % ffr(DicoPath['log-chd2.txt']) + txt += """ #lecture des uce listuce1<-read.csv2("%s") - """ % DicoPath['listeuce1'] - + """ % ffr(DicoPath['listeuce1']) + if classif_mode == 0: txt += """ listuce2<-read.csv2("%s") - """ % DicoPath['listeuce2'] - + """ % ffr(DicoPath['listeuce2']) + txt += """ -# rm(data1) + rm(data1) """ - + if classif_mode == 0: txt += """ -# rm(data2) + rm(data2) """ txt += """ - chd.result <- Rchdtxt("%s",mincl=%i,classif_mode=%i, nbt = nbt) + classif_mode <- %i + mincl <- %i + uceout <- "%s" + if (classif_mode == 0) { + chd.result <- Rchdtxt(uceout, chd1, chd2 = chd2, mincl = mincl,classif_mode = classif_mode, nbt = nbt) + } else { + chd.result <- Rchdtxt(uceout, chd1, chd2 = chd1, mincl = mincl,classif_mode = classif_mode, nbt = nbt) + } n1 <- chd.result$n1 classeuce1 <- chd.result$cuce1 - classeuce2 <- chd.result$cuce2 - """ % (DicoPath['uce'], mincl, classif_mode) - + classes<-n1[,ncol(n1)] + write.csv2(n1, file="%s") + rm(n1) + """ % (classif_mode, mincl, ffr(DicoPath['uce']), ffr(DicoPath['n1.csv'])) + txt += """ tree.tot1 <- make_tree_tot(chd1) # open_file_graph("%s", widt = 600, height=400) # plot(tree.tot1$tree.cl) # dev.off() - """%DicoPath['arbre1'] - + """ % ffr(DicoPath['arbre1']) + if classif_mode == 0: txt += """ + classeuce2 <- chd.result$cuce2 tree.tot2 <- make_tree_tot(chd2) # open_file_graph("%s", width = 600, height=400) # plot(tree.tot2$tree.cl) # dev.off() - """ % DicoPath['arbre2'] - + """ % ffr(DicoPath['arbre2'] ) + txt += """ tree.cut1 <- make_dendro_cut_tuple(tree.tot1$dendro_tuple, chd.result$coord_ok, classeuce1, 1, nbt) save(tree.cut1, file="%s") - classes<-n1[,ncol(n1)] + open_file_graph("%s", width = 600, height=400) - plot.dendropr(tree.cut1$tree.cl,classes) + plot.dendropr(tree.cut1$tree.cl,classes, histo=TRUE) open_file_graph("%s", width = 600, height=400) plot(tree.cut1$dendro_tot_cl) dev.off() - """ % (DicoPath['Rdendro'], DicoPath['dendro1'], DicoPath['arbre1']) - + """ % (ffr(DicoPath['Rdendro']), ffr(DicoPath['dendro1']), ffr(DicoPath['arbre1'])) + if classif_mode == 0: txt += """ tree.cut2 <- make_dendro_cut_tuple(tree.tot2$dendro_tuple, chd.result$coord_ok, classeuce2, 2, nbt) @@ -219,21 +243,22 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, libsvdc = False plot(tree.cut2$tree.cl) dev.off() open_file_graph("%s", width = 600, height=400) - plot(tree.cut1$dendro_tot_cl) + plot(tree.cut2$dendro_tot_cl) dev.off() - """ % (DicoPath['dendro2'], DicoPath['arbre2']) - + """ % (ffr(DicoPath['dendro2']), ffr(DicoPath['arbre2'])) + txt += """ - save.image(file="%s") - """ % DicoPath['RData'] + + #save.image(file="%s") + """ % (ffr(DicoPath['RData'])) + fileout = open(DicoPath['Rchdtxt'], 'w') fileout.write(txt) fileout.close() def RPamTxt(corpus, RscriptPath): - DicoPath = corpus.dictpathout - param = corpus.parametre - print param + DicoPath = corpus.pathout + param = corpus.parametres txt = """ source("%s") """ % (RscriptPath['pamtxt']) @@ -263,7 +288,7 @@ def RchdQuest(DicoPath, RscriptPath, nbcl = 10, mincl = 10): source("%s") source("%s") source("%s") - """ % (RscriptPath['CHD'], RscriptPath['chdquest'], RscriptPath['anacor'],RscriptPath['Rgraph']) + """ % (ffr(RscriptPath['CHD']), ffr(RscriptPath['chdquest']), ffr(RscriptPath['anacor']),ffr(RscriptPath['Rgraph'])) txt += """ nbt <- %i - 1 @@ -274,14 +299,14 @@ def RchdQuest(DicoPath, RscriptPath, nbcl = 10, mincl = 10): chd.result<-Rchdquest("%s","%s","%s", nbt = nbt, mincl = mincl) n1 <- chd.result$n1 classeuce1 <- chd.result$cuce1 - """ % (DicoPath['Act01'], DicoPath['listeuce1'], DicoPath['uce']) + """ % (ffr(DicoPath['mat01.csv']), ffr(DicoPath['listeuce1']), ffr(DicoPath['uce'])) txt += """ tree_tot1 <- make_tree_tot(chd.result$chd) open_file_graph("%s", width = 600, height=400) plot(tree_tot1$tree.cl) dev.off() - """%DicoPath['arbre1'] + """ % ffr(DicoPath['arbre1']) txt += """ tree_cut1 <- make_dendro_cut_tuple(tree_tot1$dendro_tuple, chd.result$coord_ok, classeuce1, 1, nbt) @@ -289,27 +314,28 @@ def RchdQuest(DicoPath, RscriptPath, nbcl = 10, mincl = 10): save(tree.cut1, file="%s") open_file_graph("%s", width = 600, height=400) classes<-n1[,ncol(n1)] - plot.dendropr(tree_cut1$tree.cl,classes) - """ % (DicoPath['Rdendro'],DicoPath['dendro1']) + plot.dendropr(tree_cut1$tree.cl,classes, histo = TRUE) + """ % (ffr(DicoPath['Rdendro']), ffr(DicoPath['dendro1'])) txt += """ save.image(file="%s") - """ % DicoPath['RData'] + """ % ffr(DicoPath['RData']) fileout = open(DicoPath['Rchdquest'], 'w') fileout.write(txt) fileout.close() -def AlcesteTxtProf(DictChdTxtOut, RscriptsPath, clnb, taillecar): +def ReinertTxtProf(DictChdTxtOut, RscriptsPath, clnb, taillecar): txt = "clnb<-%i\n" % clnb txt += """ source("%s") -load("%s") -""" % (RscriptsPath['chdfunct'], DictChdTxtOut['RData']) +#load("%s") +n1 <- read.csv2("%s") +""" % (ffr(RscriptsPath['chdfunct']), ffr(DictChdTxtOut['RData']), ffr(DictChdTxtOut['n1.csv'])) txt += """ dataact<-read.csv2("%s", header = FALSE, sep = ';',quote = '\"', row.names = 1, na.strings = 'NA') datasup<-read.csv2("%s", header = FALSE, sep = ';',quote = '\"', row.names = 1, na.strings = 'NA') dataet<-read.csv2("%s", header = FALSE, sep = ';',quote = '\"', row.names = 1, na.strings = 'NA') -""" % (DictChdTxtOut['Contout'], DictChdTxtOut['ContSupOut'], DictChdTxtOut['ContEtOut']) +""" % (ffr(DictChdTxtOut['Contout']), ffr(DictChdTxtOut['ContSupOut']), ffr(DictChdTxtOut['ContEtOut'])) txt += """ tablesqrpact<-BuildProf(as.matrix(dataact),n1,clnb) tablesqrpsup<-BuildProf(as.matrix(datasup),n1,clnb) @@ -317,7 +343,7 @@ tablesqrpet<-BuildProf(as.matrix(dataet),n1,clnb) """ txt += """ PrintProfile(n1,tablesqrpact[4],tablesqrpet[4],tablesqrpact[5],tablesqrpet[5],clnb,"%s","%s",tablesqrpsup[4],tablesqrpsup[5]) -""" % (DictChdTxtOut['PROFILE_OUT'], DictChdTxtOut['ANTIPRO_OUT']) +""" % (ffr(DictChdTxtOut['PROFILE_OUT']), ffr(DictChdTxtOut['ANTIPRO_OUT'])) txt += """ colnames(tablesqrpact[[2]])<-paste('classe',1:clnb,sep=' ') colnames(tablesqrpact[[1]])<-paste('classe',1:clnb,sep=' ') @@ -334,7 +360,7 @@ write.csv2(chistabletot,file="%s") write.csv2(ptabletot,file="%s") gbcluster<-n1 write.csv2(gbcluster,file="%s") -""" % (DictChdTxtOut['chisqtable'], DictChdTxtOut['ptable'], DictChdTxtOut['SbyClasseOut']) +""" % (ffr(DictChdTxtOut['chisqtable']), ffr(DictChdTxtOut['ptable']), ffr(DictChdTxtOut['SbyClasseOut'])) if clnb > 2 : txt += """ library(ca) @@ -354,7 +380,7 @@ write.csv2(gbcluster,file="%s") #FIXME : split this!!! txt += """ source("%s") - """ % RscriptsPath['Rgraph'] + """ % ffr(RscriptsPath['Rgraph']) txt += """ afc <- summary.ca.dm(afc) @@ -362,36 +388,31 @@ write.csv2(gbcluster,file="%s") write.csv2(afc_table$facteur, file = "%s") write.csv2(afc_table$colonne, file = "%s") write.csv2(afc_table$ligne, file = "%s") - """ % (DictChdTxtOut['afc_facteur'], DictChdTxtOut['afc_col'], DictChdTxtOut['afc_row']) - - txt += """ - xlab <- paste('facteur 1 - ', round(afc$facteur[1,2],2), sep = '') - ylab <- paste('facteur 2 - ', round(afc$facteur[2,2],2), sep = '') - xlab <- paste(xlab, ' %', sep = '') - ylab <- paste(ylab, ' %', sep = '') - """ + """ % (ffr(DictChdTxtOut['afc_facteur']), ffr(DictChdTxtOut['afc_col']), ffr(DictChdTxtOut['afc_row'])) txt += """ PARCEX<-%s """ % taillecar txt += """ - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DL_OUT']) + xyminmax <- PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab) + """ % (ffr(DictChdTxtOut['AFC2DL_OUT'])) txt += """ - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=debsup, fin=(debet-1), xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DSL_OUT']) + PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=debsup, fin=(debet-1), xlab = xlab, ylab = ylab, xmin = xyminmax$xminmax[1], xmax = xyminmax$xminmax[2], ymin = xyminmax$yminmax[1], ymax = xyminmax$yminmax[2], active=FALSE) + """ % (ffr(DictChdTxtOut['AFC2DSL_OUT'])) txt += """ - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=debet, fin=fin, xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DEL_OUT']) - txt += """ - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", col=TRUE, what='coord', xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DCL_OUT']) + if ((fin - debet) > 2) { + PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=debet, fin=fin, xlab = xlab, ylab = ylab, xmin = xyminmax$xminmax[1], xmax = xyminmax$xminmax[2], ymin = xyminmax$yminmax[1], ymax = xyminmax$yminmax[2], active = FALSE) + } + """ % (ffr(DictChdTxtOut['AFC2DEL_OUT'])) txt += """ - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab) - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=debsup, fin=(debet-1), xlab = xlab, ylab = ylab) - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=debet, fin=fin, xlab = xlab, ylab = ylab) - PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", col=TRUE, what='crl', xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DCoul'], DictChdTxtOut['AFC2DCoulSup'], DictChdTxtOut['AFC2DCoulEt'], DictChdTxtOut['AFC2DCoulCl']) + PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", col=TRUE, what='coord', xlab = xlab, ylab = ylab, xmin = xyminmax$xminmax[1], xmax = xyminmax$xminmax[2], ymin = xyminmax$yminmax[1], ymax = xyminmax$yminmax[2], active=FALSE) + """ % (ffr(DictChdTxtOut['AFC2DCL_OUT'])) +# txt += """ + # PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab) + # PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=debsup, fin=(debet-1), xlab = xlab, ylab = ylab) + # PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=debet, fin=fin, xlab = xlab, ylab = ylab) + # PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", col=TRUE, what='crl', xlab = xlab, ylab = ylab) + # """ % (DictChdTxtOut['AFC2DCoul'], DictChdTxtOut['AFC2DCoulSup'], DictChdTxtOut['AFC2DCoulEt'], DictChdTxtOut['AFC2DCoulCl']) txt += """ #rm(dataact) @@ -401,7 +422,7 @@ rm(tablesqrpact) rm(tablesqrpsup) rm(tablesqrpet) save.image(file="%s") -""" % DictChdTxtOut['RData'] +""" % ffr(DictChdTxtOut['RData']) file = open(DictChdTxtOut['RTxtProfGraph'], 'w') file.write(txt) file.close() @@ -417,17 +438,23 @@ def write_afc_graph(self): if self.param['do_select_chi'] : do_select_chi = 'TRUE' else : do_select_chi = 'FALSE' + if self.param['do_select_chi_classe'] : do_select_chi_classe = 'TRUE' + else : do_select_chi_classe = 'FALSE' + if self.param['cex_txt'] : cex_txt = 'TRUE' else : cex_txt = 'FALSE' if self.param['tchi'] : tchi = 'TRUE' else : tchi = 'FALSE' + if self.param['svg'] : svg = 'TRUE' + else : svg = 'FALSE' + with open(self.RscriptsPath['afc_graph'], 'r') as f: txt = f.read() # self.DictPathOut['RData'], \ - scripts = txt % (self.RscriptsPath['Rgraph'],\ + scripts = txt % (ffr(self.RscriptsPath['Rgraph']),\ self.param['typegraph'], \ self.param['what'], \ self.param['facteur'][0],\ @@ -438,6 +465,8 @@ def write_afc_graph(self): self.param['select_nb'], \ do_select_chi, \ self.param['select_chi'], \ + do_select_chi_classe, \ + self.param['nbchic'], \ cex_txt, \ self.param['txt_min'], \ self.param['txt_max'], \ @@ -450,7 +479,8 @@ def write_afc_graph(self): tchi,\ self.param['tchi_min'],\ self.param['tchi_max'],\ - ffr(os.path.dirname(self.fileout))) + ffr(os.path.dirname(self.fileout)),\ + svg) return scripts def print_simi3d(self): @@ -460,10 +490,12 @@ def print_simi3d(self): movie = "'" + ffr(os.path.dirname(self.DictPathOut['RData'])) + "'" else : movie = 'NULL' - if self.section == 'chd_dist_quest' : - header = 'TRUE' - else : - header = 'FALSE' + + #if self.corpus.parametres['type'] == 'corpus' : + # header = 'TRUE' + #else : + # header = 'FALSE' + header = 'FALSE' txt += """ dm<-read.csv2("%s",row.names=1,header = %s) load("%s") @@ -510,66 +542,110 @@ def dendroandbarplot(table, rownames, colnames, rgraph, tmpgraph, intxt = False, """ % (ffr(dendro),ffr(rgraph), ffr(tmpgraph)) return txt -def barplot(table, rownames, colnames, rgraph, tmpgraph, intxt = False) : +def barplot(table, parametres, intxt = False) : if not intxt : txttable = 'c(' + ','.join([','.join(line) for line in table]) + ')' #width = 100 + (15 * len(rownames)) + (100 * len(colnames)) #height = len(rownames) * 15 - rownb = len(rownames) + rownb = len(parametres['rownames']) #if height < 400 : # height = 400 - rownames = 'c("' + '","'.join(rownames) + '")' - colnames = 'c("' + '","'.join(colnames) + '")' + rownames = 'c("' + '","'.join(parametres['rownames']) + '")' + colnames = 'c("' + '","'.join(parametres['colnames']) + '")' + if not intxt : #FIXME txt = """ - inf <- NA di <- matrix(data=%s, nrow=%i, byrow = TRUE) - di[is.na(di)] <- max(di, na.rm=TRUE) + 2 + toinf <- which(di == Inf) + tominf <- which(di == -Inf) + if (length(toinf)) { + di[toinf] <- NA + valmax <- max(di, na.rm = TRUE) + if (valmax <= 0) { + valmax <- 2 + } else { + valmax <- valmax + 2 + } + di[toinf] <- valmax + } + if (length(tominf)) { + di[tominf] <- NA + valmin <- min(di, na.rm = TRUE) + if (valmin >=0) { + valmin <- -2 + } else { + valmin <- valmin - 2 + } + di[tominf] <- valmin + } rownames(di)<- %s colnames(di) <- %s """ % (txttable, rownb, rownames, colnames) else : txt = intxt - txt += """ - source("%s") - color = rainbow(nrow(di)) - width <- 100 + (20*length(rownames(di))) + (100 * length(colnames(di))) - height <- nrow(di) * 15 - if (height < 400) { height <- 400} - open_file_graph("%s",width = width, height = height) - par(mar=c(0,0,0,0)) - layout(matrix(c(1,2),1,2, byrow=TRUE),widths=c(3,lcm(7))) - par(mar=c(2,2,1,0)) - coord <- barplot(as.matrix(di), beside = TRUE, col = color, space = c(0.1,0.6)) - c <- colMeans(coord) - c1 <- c[-1] - c2 <- c[-length(c)] - cc <- cbind(c1,c2) - lcoord <- apply(cc, 1, mean) - abline(v=lcoord) - if (min(di) < 0) { - amp <- abs(max(di) - min(di)) - } else { - amp <- max(di) - } - if (amp < 10) { - d <- 2 - } else { - d <- signif(amp%%/%%10,1) - } - mn <- round(min(di)) - mx <- round(max(di)) - for (i in mn:mx) { - if ((i/d) == (i%%/%%d)) { - abline(h=i,lty=3) + if not 'tree' in parametres : + txt += """ + source("%s") + color = rainbow(nrow(di)) + width <- %i + height <- %i + open_file_graph("%s",width = width, height = height, svg = %s) + par(mar=c(0,0,0,0)) + layout(matrix(c(1,2),1,2, byrow=TRUE),widths=c(3,lcm(7))) + par(mar=c(8,4,1,0)) + yp = ifelse(length(toinf), 0.2, 0) + ym = ifelse(length(tominf), 0.2, 0) + ymin <- ifelse(!length(which(di < 0)), 0, min(di) - ym) + coord <- barplot(as.matrix(di), beside = TRUE, col = color, space = c(0.1,0.6), ylim=c(ymin, max(di) + yp), las = 2) + if (length(toinf)) { + coordinf <- coord[toinf] + valinf <- di[toinf] + text(x=coordinf, y=valinf + 0.1, 'i') } - } - par(mar=c(0,0,0,0)) - plot(0, axes = FALSE, pch = '') - legend(x = 'center' , rownames(di), fill = color) - dev.off() - """ % (rgraph, ffr(tmpgraph)) + if (length(tominf)) { + coordinf <- coord[toinf] + valinf <- di[toinf] + text(x=coordinf, y=valinf - 0.1, 'i') + } + c <- colMeans(coord) + c1 <- c[-1] + c2 <- c[-length(c)] + cc <- cbind(c1,c2) + lcoord <- apply(cc, 1, mean) + abline(v=lcoord) + if (min(di) < 0) { + amp <- abs(max(di) - min(di)) + } else { + amp <- max(di) + } + if (amp < 10) { + d <- 2 + } else { + d <- signif(amp%%/%%10,1) + } + mn <- round(min(di)) + mx <- round(max(di)) + for (i in mn:mx) { + if ((i/d) == (i%%/%%d)) { + abline(h=i,lty=3) + } + } + par(mar=c(0,0,0,0)) + plot(0, axes = FALSE, pch = '') + legend(x = 'center' , rownames(di), fill = color) + dev.off() + """ % (ffr(parametres['rgraph']), parametres['width'], parametres['height'], ffr(parametres['tmpgraph']), parametres['svg']) + else : + txt += """ + load("%s") + library(ape) + source("%s") + width = %i + height = %i + open_file_graph("%s", width=width, height=height, svg = %s) + plot.dendro.lex(tree.cut1$tree.cl, di) + """ % (ffr(parametres['tree']), ffr(parametres['rgraph']), parametres['width'], parametres['height'], ffr(parametres['tmpgraph']), parametres['svg']) return txt #def RAfcUci(DictAfcUciOut, nd=2, RscriptsPath='', PARCEX='0.8'): @@ -632,29 +708,94 @@ class PrintSimiScript(PrintRScript) : self.txtgraph = '' self.packages(['igraph', 'proxy', 'Matrix']) self.sources([self.analyse.parent.RscriptsPath['simi'], self.analyse.parent.RscriptsPath['Rgraph']]) - txt = """ - dm.path <- "%s" - cn.path <- "%s" - selected.col <- "%s" - """ % (self.pathout['mat01.csv'], self.pathout['actives.csv'], self.pathout['selected.csv']) - txt += """ - dm <-readMM(dm.path) - cn <- read.table(cn.path, sep=';', quote='"') - colnames(dm) <- cn[,1] - sel.col <- read.csv2(selected.col) - dm <- dm[, sel.col[,1] + 1] - """ - - if self.parametres['coeff'] == 0 : - method = 'cooc' + txt = '' + if not self.parametres['keep_coord'] and not (self.parametres['type'] == 'simimatrix' or self.parametres['type'] == 'simiclustermatrix') : + txt += """ + dm.path <- "%s" + cn.path <- "%s" + selected.col <- "%s" + """ % (ffr(self.pathout['mat01.csv']), ffr(self.pathout['actives.csv']), ffr(self.pathout['selected.csv'])) + if 'word' in self.parametres : + txt += """ + word <- TRUE + index <- %i + 1 + """ % self.parametres['word'] + else : + txt += """ + word <- FALSE + """ txt += """ - method <- 'cooc' - mat <- make.a(dm) + dm <-readMM(dm.path) + cn <- read.table(cn.path, sep='\t', quote='"') + colnames(dm) <- cn[,1] + if (file.exists(selected.col)) { + sel.col <- read.csv2(selected.col, header = FALSE) + sel.col <- sel.col[,1] + 1 + } else { + sel.col <- 1:ncol(dm) + } + if (!word) { + dm <- dm[, sel.col] + } else { + forme <- colnames(dm)[index] + if (!index %in% sel.col) { + sel.col <- append(sel.col, index) + } + dm <- dm[, sel.col] + index <- which(colnames(dm) == forme) + } """ - else : + elif not self.parametres['keep_coord'] and (self.parametres['type'] == 'simimatrix' or self.parametres['type'] == 'simiclustermatrix'): + txt += """ + dm.path <- "%s" + selected.col <- "%s" + """ % (ffr(self.pathout['mat01.csv']), ffr(self.pathout['selected.csv'])) + if 'word' in self.parametres : + txt += """ + word <- TRUE + index <- %i + 1 + """ % self.parametres['word'] + else : + txt += """ + word <- FALSE + """ txt += """ + dm <-read.csv2(dm.path) dm <- as.matrix(dm) + if (file.exists(selected.col)) { + sel.col <- read.csv2(selected.col, header = FALSE) + sel.col <- sel.col[,1] + 1 + } else { + sel.col <- 1:ncol(dm) + } + if (!word) { + dm <- dm[, sel.col] + } else { + forme <- colnames(dm)[index] + if (!index %in% sel.col) { + sel.col <- append(sel.col, index) + } + dm <- dm[, sel.col] + index <- which(colnames(dm) == forme) + } """ + else : + txt += """ + load("%s") + """ % ffr(self.pathout['RData.RData']) + + if self.parametres['coeff'] == 0 : + method = 'cooc' + if not self.parametres['keep_coord'] : + txt += """ + method <- 'cooc' + mat <- make.a(dm) + """ + else : + if not self.parametres['keep_coord'] : + txt += """ + dm <- as.matrix(dm) + """ if self.parametres['coeff'] == 1 : method = 'prcooc' txt += """ @@ -663,37 +804,89 @@ class PrintSimiScript(PrintRScript) : """ elif self.analyse.indices[self.parametres['coeff']] == 'binomial' : method = 'binomial' - txt += """ - method <- 'binomial' - mat <- binom.sim(dm) - """ + if not self.parametres['keep_coord'] : + txt += """ + method <- 'binomial' + mat <- binom.sim(dm) + """ elif self.parametres['coeff'] != 0 : method = self.analyse.indices[self.parametres['coeff']] + if not self.parametres['keep_coord'] : + txt += """ + method <-"%s" + mat <- simil(dm, method = method, diag = TRUE, upper = TRUE, by_rows = FALSE) + """ % self.analyse.indices[self.parametres['coeff']] + if not self.parametres['keep_coord'] : txt += """ - method <-"%s" - mat <- simil(dm, method = method, diag = TRUE, upper = TRUE, by_rows = FALSE) - """ % self.analyse.indices[self.parametres['coeff']] - txt += """ - mat <- as.matrix(stats::as.dist(mat,diag=TRUE,upper=TRUE)) - mat[is.na(mat)] <- 0 - mat[is.infinite(mat)] <- 0 - """ + mat <- as.matrix(stats::as.dist(mat,diag=TRUE,upper=TRUE)) + mat[is.na(mat)] <- 0 + if (length(which(mat == Inf))) { + infp <- which(mat == Inf) + mat[infp] <- NA + maxmat <- max(mat, na.rm = TRUE) + if (maxmat > 0) { + maxmat <- maxmat + 1 + } else { + maxmat <- 0 + } + mat[infp] <- maxmat + } + if (length(which(mat == -Inf))) { + infm <- which(mat == -Inf) + mat[infm] <- NA + minmat <- min(mat, na.rm = TRUE) + if (maxmat < 0) { + minmat <- minmat - 1 + } else { + minmat <- 0 + } + mat[infm] <- minmat + } + """ + if 'word' in self.parametres and not self.parametres['keep_coord'] : + txt += """ + mat <- graph.word(mat, index) + cs <- colSums(mat) + if (length(cs)) mat <- mat[,-which(cs==0)] + rs <- rowSums(mat) + if (length(rs)) mat <- mat[-which(rs==0),] + if (length(cs)) dm <- dm[, -which(cs==0)] + """ + if self.parametres['layout'] == 0 : layout = 'random' if self.parametres['layout'] == 1 : layout = 'circle' if self.parametres['layout'] == 2 : layout = 'frutch' if self.parametres['layout'] == 3 : layout = 'kawa' if self.parametres['layout'] == 4 : layout = 'graphopt' + self.filename='' if self.parametres['type_graph'] == 0 : type = 'tkplot' if self.parametres['type_graph'] == 1 : graphnb = 1 type = 'nplot' - dirout = os.path.dirname(self.pathout['mat01']) + dirout = os.path.dirname(self.pathout['mat01.csv']) while os.path.exists(os.path.join(dirout,'graph_simi_'+str(graphnb)+'.png')): graphnb +=1 self.filename = ffr(os.path.join(dirout,'graph_simi_'+str(graphnb)+'.png')) if self.parametres['type_graph'] == 2 : type = 'rgl' + if self.parametres['type_graph'] == 3 : + graphnb = 1 + type = 'web' + dirout = os.path.dirname(self.pathout['mat01.csv']) + while os.path.exists(os.path.join(dirout,'web_'+str(graphnb))): + graphnb +=1 + self.filename = ffr(os.path.join(dirout,'web_'+str(graphnb))) + os.mkdir(self.filename) + self.filename = os.path.join(self.filename, 'gexf.gexf') + if self.parametres['type_graph'] == 4 : + graphnb = 1 + type = 'rglweb' + dirout = os.path.dirname(self.pathout['mat01.csv']) + while os.path.exists(os.path.join(dirout,'webrgl_'+str(graphnb))): + graphnb +=1 + self.filename = ffr(os.path.join(dirout,'webrgl_'+str(graphnb))) + os.mkdir(self.filename) if self.parametres['arbremax'] : arbremax = 'TRUE' @@ -721,7 +914,16 @@ class PrintSimiScript(PrintRScript) : if self.parametres['seuil_ok'] : seuil = str(self.parametres['seuil']) else : seuil = 'NULL' - + + if not self.parametres.get('edgecurved', False) : + ec = 'FALSE' + else : + ec = 'TRUE' + + txt += """ + edge.curved <- %s + """ % ec + cols = str(self.parametres['cols']).replace(')',', max=255)') cola = str(self.parametres['cola']).replace(')',',max=255)') @@ -738,13 +940,18 @@ class PrintSimiScript(PrintRScript) : if self.parametres['film'] : txt += """ film <- "%s" - """ % self.pathout['film'] + """ % ffr(self.pathout['film']) else : txt += """ film <- NULL """ txt += """ seuil <- %s + if (!is.null(seuil)) { + if (method!='cooc') { + seuil <- seuil/1000 + } + } """ % seuil txt += """ @@ -781,13 +988,13 @@ class PrintSimiScript(PrintRScript) : txt += """ et <- list() """ - for i,et in enumerate(self.tableau.etline) : + for i, line in enumerate(self.parametres['listet']) : txt+= """ et[[%i]] <- c(%s) - """ % (i+1, ','.join(et[1:])) + """ % (i+1, ','.join([`val + 1` for val in line])) txt+= """ unetoile <- c('%s') - """ % ("','".join([val[0] for val in self.tableau.etline])) + """ % ("','".join([val for val in self.parametres['selectedstars']])) txt += """ fsum <- NULL rs <- rowSums(dm) @@ -812,7 +1019,7 @@ class PrintSimiScript(PrintRScript) : cols <- vertex.label.color chivertex.size <- norm.vec(toblack, vcexminmax[1], vcexminmax[2]) - """ % (self.parent.RscriptsPath['chdfunct']) + """ % (ffr(self.analyse.parent.RscriptsPath['chdfunct'])) else : txt += """ vertex.label.color <- 'black' @@ -842,10 +1049,22 @@ class PrintSimiScript(PrintRScript) : # g.toplot <- g.ori # } # """ + if self.parametres['com'] : + com = `self.parametres['communities']` + else : + com = 'NULL' + if self.parametres['halo'] : + halo = 'TRUE' + else : + halo = 'FALSE' + txt += """ + communities <- %s + halo <- %s + """ % (com, halo) txt += """ eff <- colSums(dm) x <- list(mat = mat, eff = eff) - graph.simi <- do.simi(x, method='%s', seuil = seuil, p.type = '%s', layout.type = '%s', max.tree = %s, coeff.vertex=%s, coeff.edge = %s, minmaxeff = minmaxeff, vcexminmax = vcexminmax, cex = cex, coords = coords) + graph.simi <- do.simi(x, method='%s', seuil = seuil, p.type = '%s', layout.type = '%s', max.tree = %s, coeff.vertex=%s, coeff.edge = %s, minmaxeff = minmaxeff, vcexminmax = vcexminmax, cex = cex, coords = coords, communities = communities, halo = halo) """ % (method, type, layout, arbremax, coeff_tv, coeff_te) if self.parametres.get('bystar',False) : @@ -855,7 +1074,7 @@ class PrintSimiScript(PrintRScript) : """ else : txt+=""" - label.cex <- NULL + label.cex <- cex """ if self.parametres.get('sfromchi', False) : txt += """ @@ -866,46 +1085,61 @@ class PrintSimiScript(PrintRScript) : vertex.size <- NULL """ else : - #FIXME - tmpchi = False - if tmpchi : + #print self.parametres + if (self.parametres['type'] == 'clustersimitxt' and self.parametres.get('tmpchi', False)) or (self.parametres['type'] in ['simimatrix','simiclustermatrix'] and 'tmpchi' in self.parametres): txt += """ lchi <- read.table("%s") lchi <- lchi[,1] - """ % ffr(tmpchi) - if 'selected_col' in dir(self.tableau) : - txt += """ - lchi <- lchi[c%s+1] - """ % datas - if tmpchi and self.parametres.get('cexfromchi', False) : + """ % ffr(self.parametres['tmpchi']) + txt += """ + lchi <- lchi[sel.col] + """ + if self.parametres['type'] in ['clustersimitxt', 'simimatrix', 'simiclustermatrix'] and self.parametres.get('cexfromchi', False) : txt += """ label.cex <- norm.vec(lchi, vcexminmax[1], vcexminmax[2]) """ else : txt += """ if (is.null(vcexminmax[1])) { - label.cex <- NULL + label.cex <- cex } else { label.cex <- graph.simi$label.cex } """ - if tmpchi and self.parametres.get('sfromchi', False) : + if (self.parametres['type'] in ['clustersimitxt', 'simimatrix', 'simiclustermatrix']) and self.parametres.get('sfromchi', False): txt += """ vertex.size <- norm.vec(lchi, minmaxeff[1], minmaxeff[2]) + if (!length(vertex.size)) vertex.size <- 0 """ else : txt += """ if (is.null(minmaxeff[1])) { - vertex.size <- NULL + vertex.size <- 0 } else { vertex.size <- graph.simi$eff } """ - txt += """ vertex.size <- NULL """ + #txt += """ vertex.size <- NULL """ + if self.parametres['svg'] : svg = 'TRUE' + else : svg = 'FALSE' + txt += """ + svg <- %s + """ % svg txt += """ - coords <- plot.simi(graph.simi, p.type='%s',filename="%s", vertex.label = label.v, edge.label = label.e, vertex.col = cols, vertex.label.color = vertex.label.color, vertex.label.cex=label.cex, vertex.size = vertex.size, edge.col = cola, leg=leg, width = width, height = height, alpha = alpha, movie = film) + vertex.col <- cols + if (!is.null(graph.simi$com)) { + com <- graph.simi$com + colm <- rainbow(length(com)) + if (vertex.size != 0 || graph.simi$halo) { + vertex.label.color <- 'black' + vertex.col <- colm[membership(com)] + } else { + vertex.label.color <- colm[membership(com)] + } + } + coords <- plot.simi(graph.simi, p.type='%s',filename="%s", vertex.label = label.v, edge.label = label.e, vertex.col = vertex.col, vertex.label.color = vertex.label.color, vertex.label.cex=label.cex, vertex.size = vertex.size, edge.col = cola, leg=leg, width = width, height = height, alpha = alpha, movie = film, edge.curved = edge.curved, svg = svg) save.image(file="%s") - """ % (type, self.filename, self.pathout['RData']) + """ % (type, self.filename, ffr(self.pathout['RData'])) self.add(txt) self.write() @@ -916,16 +1150,324 @@ class WordCloudRScript(PrintRScript) : self.packages(['wordcloud']) bg_col = Rcolor(self.parametres['col_bg']) txt_col = Rcolor(self.parametres['col_text']) + if self.parametres['svg'] : + svg = 'TRUE' + else : + svg = 'FALSE' txt = """ + svg <- %s + """ % svg + txt += """ act <- read.csv2("%s", header = FALSE, row.names=1, sep='\t') selected.col <- read.table("%s") toprint <- as.matrix(act[selected.col[,1] + 1,]) rownames(toprint) <- rownames(act)[selected.col[,1] + 1] - open_file_graph("%s", width = %i, height = %i) + maxword <- %i + if (nrow(toprint) > maxword) { + toprint <- as.matrix(toprint[order(toprint[,1], decreasing=TRUE),]) + toprint <- as.matrix(toprint[1:maxword,]) + } + open_file_graph("%s", width = %i, height = %i , svg = svg) par(bg=rgb%s) wordcloud(row.names(toprint), toprint[,1], scale=c(%f,%f), random.order=FALSE, colors=rgb%s) dev.off() - """ % (ffr(self.analyse.pathout['actives_eff.csv']), ffr(self.analyse.pathout['selected.csv']), - ffr(self.parametres['graphout']), self.parametres['width'], self.parametres['height'], bg_col, self.parametres['maxcex'], self.parametres['mincex'], txt_col) + """ % (ffr(self.analyse.pathout['actives_eff.csv']), ffr(self.analyse.pathout['selected.csv']), self.parametres['maxword'], ffr(self.parametres['graphout']), self.parametres['width'], self.parametres['height'], bg_col, self.parametres['maxcex'], self.parametres['mincex'], txt_col) self.add(txt) self.write() + +class ProtoScript(PrintRScript) : + def make_script(self) : + self.sources([self.analyse.parent.RscriptsPath['Rgraph'], self.analyse.parent.RscriptsPath['prototypical.R']]) + self.packages(['wordcloud']) + if self.parametres.get('cloud', False) : + cloud = 'TRUE' + else : + cloud = 'FALSE' + txt = """ + errorn <- function(x) { + qnorm(0.975)*sd(x)/sqrt(lenght(n)) + } + errort <- function(x) { + qt(0.975,df=lenght(x)-1)*sd(x)/sqrt(lenght(x)) + } + mat <- read.csv2("%s", header = FALSE, row.names=1, sep='\t', quote='"', dec='.') + open_file_graph("%s",height=800, width=1000) + prototypical(mat, mfreq = %s, mrank = %s, cloud = FALSE, cexrange=c(1,2.4), cexalpha= c(0.4, 1), type = '%s') + dev.off() + """ % (ffr(self.analyse.pathout['table.csv']), ffr(self.analyse.pathout['proto.png']), self.parametres['limfreq'], self.parametres['limrang'], self.parametres['typegraph']) + self.add(txt) + self.write() + + +class ExportAfc(PrintRScript) : + def make_script(self) : + self.source([self.analyse.parent.RscriptsPath['Rgraph']]) + self.packages(['rgexf']) + txt = """ + """ + +class MergeGraphes(PrintRScript) : + def __init__(self, analyse): + self.script = u"#Script genere par IRaMuTeQ - %s\n" % datetime.now().ctime() + self.pathout = PathOut() + self.parametres = analyse.parametres + self.scriptout = self.pathout['temp'] + self.analyse = analyse + + def make_script(self) : + #FIXME + + txt = """ + library(igraph) + library(Matrix) + graphs <- list() + """ + load = """ + load("%s") + g <- graph.simi$graph + V(g)$weight <- (graph.simi$mat.eff/nrow(dm))*100 + graphs[['%s']] <- g + """ + for i, graph in enumerate(self.parametres['graphs']) : + path = os.path.dirname(graph) + gname = ''.join(['g', `i`]) + RData = os.path.join(path,'RData.RData') + txt += load % (ffr(RData), gname) + self.add(txt) + self.sources([self.analyse.parent.RscriptsPath['simi']]) + txt = """ + ng <- merge.graph(graphs) + ngraph <- list(graph=ng, layout=layout.fruchterman.reingold(ng, dim=3), labex.cex=V(ng)$weight) + write.graph(ng, "%s", format = 'graphml') + """ % ffr(self.parametres['grapheout']) + self.add(txt) + +class TgenSpecScript(PrintRScript): + def make_script(self): + self.packages(['textometry']) + txt = """ + tgen <- read.csv2("%s", row.names = 1, sep = '\\t') + """ % ffr(self.parametres['tgeneff']) + txt += """ + tot <- tgen[nrow(tgen), ] + result <- NULL + tgen <- tgen[-nrow(tgen),] + for (i in 1:nrow(tgen)) { + mat <- rbind(tgen[i,], tot - tgen[i,]) + specmat <- specificities(mat) + result <- rbind(result, specmat[1,]) + } + colnames(result) <- colnames(tgen) + row.names(result) <- rownames(tgen) + write.table(result, file = "%s", sep='\\t', col.names = NA) + """ % ffr(self.pathout['tgenspec.csv']) + self.add(txt) + +class TgenProfScript(PrintRScript): + def make_script(self): + self.sources([self.analyse.ira.RscriptsPath['chdfunct']]) + txt = """ + tgen <- read.csv2("%s", row.names = 1, sep = '\\t') + """ % ffr(self.parametres['tgeneff']) + txt += """ + tgenlem <- read.csv2("%s", row.names = 1, sep = '\\t') + """ % ffr(self.parametres['tgenlemeff']) + txt += """ + res <- build.prof.tgen(tgen) + write.table(res$chi2, file = "%s", sep='\\t', col.names = NA) + write.table(res$pchi2, file = "%s", sep='\\t', col.names = NA) + """ % (ffr(self.pathout['tgenchi2.csv']), ffr(self.pathout['tgenpchi2.csv'])) + txt += """ + reslem <- build.prof.tgen(tgenlem) + write.table(reslem$chi2, file = "%s", sep='\\t', col.names = NA) + write.table(reslem$pchi2, file = "%s", sep='\\t', col.names = NA) + """ % (ffr(self.pathout['tgenlemchi2.csv']), ffr(self.pathout['tgenlempchi2.csv'])) + self.add(txt) + +class FreqMultiScript(PrintRScript): + def make_script(self): + self.sources([self.analyse.parent.RscriptsPath['Rgraph']]) + txt = """ + freq <- read.csv2("%s", row.names=1, sep='\\t', dec='.') + """ % ffr(self.pathout['frequences.csv']) + txt += """ + toplot <- freq[order(freq[,2]) ,2] + toplot.names = rownames(freq)[order(freq[,2])] + h <- 80 + (20 * nrow(freq)) + open_file_graph("%s",height=h, width=500) + par(mar=c(3,20,3,3)) + barplot(toplot, names = toplot.names, horiz=TRUE, las =1, col = rainbow(nrow(freq))) + dev.off() + """ % ffr(self.pathout['barplotfreq.png']) + txt += """ + toplot <- freq[order(freq[,4]) ,4] + toplot.names = rownames(freq)[order(freq[,4])] + open_file_graph("%s",height=h, width=500) + par(mar=c(3,20,3,3)) + barplot(toplot, names = toplot.names, horiz=TRUE, las =1, col = rainbow(nrow(freq))) + dev.off() + """ % ffr(self.pathout['barplotrow.png']) + self.add(txt) + self.write() + +class LabbeScript(PrintRScript) : + def make_script(self) : + self.sources([self.analyse.parent.RscriptsPath['distance-labbe.R'], + self.analyse.parent.RscriptsPath['Rgraph']]) + txt = """ + tab <- read.csv2("%s", header=TRUE, sep=';', row.names=1) + """ % (self.pathout['tableafcm.csv']) + txt += """ + dist.mat <- dist.labbe(tab) + dist.mat <- as.dist(dist.mat, upper=F, diag=F) + write.table(as.matrix(dist.mat), "%s", sep='\t') + library(cluster) + library(ape) + chd <- hclust(dist.mat, method="ward.D2") + open_file_graph("%s", width=1000, height=1000, svg=F) + par(cex=1.2) + plot.phylo(as.phylo(chd), type='unrooted', lab4ut="axial") + dev.off() + """ % (self.pathout['distmat.csv'], self.pathout['dist-labbe.png']) + self.add(txt) + self.write() + +class ChronoChi2Script(PrintRScript) : + def make_script(self) : + self.sources([self.analyse.parent.RscriptsPath['Rgraph']]) + print self.parametres + txt = """ + inRData <- "%s" + dendrof <- "%s" + load(inRData) + load(dendrof) + """ % (ffr(self.pathout['RData.RData']), ffr(self.pathout['dendrogramme.RData'])) + txt += """ + svg <- %s + """ % self.parametres['svg'] + txt += """ + tc <- which(grepl("%s",rownames(chistabletot))) + rn <- rownames(chistabletot)[tc] + tc <- tc[order(rn)] + dpt <- chistabletot[tc,] + tot <- afctable[tc,] + tcp <- rowSums(tot) + ptc <- tcp/sum(tcp) + dpt <- t(dpt) + dd <- dpt + """ % self.parametres['var'].replace(u'*', u"\\\\*") + txt += """ + classes <- n1[,ncol(n1)] + tcl <- table(classes) + if ('0' %in% names(tcl)) { + to.vire <- which(names(tcl) == '0') + tcl <- tcl[-to.vire] + } + tclp <- tcl/sum(tcl) + + #chi2 colors + library(ape) + k <- 1e-02 + lcol <- NULL + lk <- k + for (i in 1:5) { + lcol <- c(lcol, qchisq(1-k,1)) + k <- k/10 + lk <- c(lk,k) + } + lcol <- c(3.84, lcol) + lcol <- c(-Inf,lcol) + lcol <- c(lcol, Inf) + lk <- c(0.05,lk) + breaks <- lcol + alphas <- seq(0,1, length.out=length(breaks)) + clod <- rev(as.numeric(tree.cut1$tree.cl$tip.label)) + #end + """ + txt += """ + open_file_graph("%s", w=%i, h=%i, svg=svg) + """ % (ffr(self.parametres['tmpgraph']), self.parametres['width'], self.parametres['height']) + txt += """ + par(mar=c(3,3,3,3)) + mat.graphic <- matrix(c(rep(1,nrow(dd)),c(2:(nrow(dd)+1))), ncol=2) + mat.graphic <- rbind(mat.graphic, c(max(mat.graphic) + 1 , max(mat.graphic) + 2)) + hauteur <- tclp[clod] * 0.9 + heights.graphic <- append(hauteur, 0.1) + layout(mat.graphic, heights=heights.graphic, widths=c(0.15,0.85)) + par(mar=c(0,0,0,0)) + tree.toplot <- tree.cut1$tree.cl + tree.toplot$tip.label <- paste('classe ', tree.toplot$tip.label) + plot.phylo(tree.toplot,label.offset=0.1, cex=1.1, no.margin=T) + for (i in clod) { + print(i) + par(mar=c(0,0,0,0)) + lcol <- cut(dd[i,], breaks, include.lowest=TRUE) + ulcol <- names(table(lcol)) + lcol <- as.character(lcol) + for (j in 1:length(ulcol)) { + lcol[which(lcol==ulcol[j])] <- j + } + lcol <- as.numeric(lcol) + mcol <- rainbow(nrow(dd))[i] + last.col <- NULL + for (k in alphas) { + last.col <- c(last.col, rgb(r=col2rgb(mcol)[1]/255, g=col2rgb(mcol)[2]/255, b=col2rgb(mcol)[3]/255, a=k)) + } + #print(last.col) + + 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)) + } + plot(0,type='n',axes=FALSE,ann=FALSE) + label.coords <- barplot(rep(1, ncol(dd)), width=ptc, names.arg = F, las=2, axes=F, ylim=c(0,1), plot=T, col='white') + text(x=label.coords, y=0.5, labels=rn[order(rn)], srt=90) + dev.off() + """ + self.add(txt) + self.write() + +class ChronoPropScript(PrintRScript) : + def make_script(self) : + self.sources([self.analyse.parent.RscriptsPath['Rgraph']]) + print self.parametres + txt = """ + inRData <- "%s" + dendrof <- "%s" + load(inRData) + load(dendrof) + """ % (ffr(self.pathout['RData.RData']), ffr(self.pathout['dendrogramme.RData'])) + txt += """ + svg <- %s + """ % self.parametres['svg'] + txt += """ + tc <- which(grepl("%s",rownames(chistabletot))) + rn <- rownames(chistabletot)[tc] + tc <- tc[order(rn)] + dpt <- chistabletot[tc,] + tot <- afctable[tc,] + tcp <- rowSums(tot) + ptc <- tcp/sum(tcp) + dpt <- t(dpt) + dd <- dpt + """ % self.parametres['var'].replace(u'*', u"\\\\*") + txt += """ + classes <- n1[,ncol(n1)] + tcl <- table(classes) + if ('0' %in% names(tcl)) { + to.vire <- which(names(tcl) == '0') + tcl <- tcl[-to.vire] + } + tclp <- tcl/sum(tcl) + """ + txt += """ + open_file_graph("%s", w=%i, h=%i, svg=svg) + """ % (ffr(self.parametres['tmpgraph']), self.parametres['width'], self.parametres['height']) + txt+= """ + ptt <- prop.table(as.matrix(tot), 1) + par(mar=c(10,2,2,2)) + 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) + dev.off() + """ + self.add(txt) + self.write() + +