X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=PrintRScript.py;h=fbcf5cf4f19a33df557c27de79441405494fc117;hp=757bd1e558a04e70a711a28824c6408906cc6c0a;hb=5249c446f605b92824c1b12fe390563450d90f3f;hpb=a6c0faa62f33e5e64ad7eab5b9d804be99c6759a diff --git a/PrintRScript.py b/PrintRScript.py index 757bd1e..fbcf5cf 100644 --- a/PrintRScript.py +++ b/PrintRScript.py @@ -33,7 +33,7 @@ class PrintRScript : def sources(self, lsources) : for source in lsources : - self.add('source("%s", encoding = \'utf8\')' % source) + self.add('source("%s", encoding = \'utf8\')' % ffr(source)) def packages(self, lpks) : for pk in lpks : @@ -41,7 +41,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 : @@ -115,7 +115,7 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'sv 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) @@ -153,14 +153,14 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'sv 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, mode.patate = mode.patate, svd.method = svd.method, libsvdc.path = libsvdc.path) """ @@ -169,20 +169,16 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'sv txt += """ chd2<-CHD(data2, x = nbt, mode.patate = mode.patate, svd.method = svd.method, libsvdc.path = libsvdc.path) """ - else: - txt += """ - chd2<-chd1 - """ 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) @@ -203,34 +199,37 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'sv } n1 <- chd.result$n1 classeuce1 <- chd.result$cuce1 - classeuce2 <- chd.result$cuce2 - """ % (classif_mode, mincl, DicoPath['uce']) + 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, 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 += """ @@ -239,13 +238,15 @@ def RchdTxt(DicoPath, RscriptPath, mincl, classif_mode, nbt = 9, svdmethod = 'sv 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() @@ -282,7 +283,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 @@ -293,14 +294,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['mat01.csv'], 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) @@ -309,26 +310,27 @@ def RchdQuest(DicoPath, RscriptPath, nbcl = 10, mincl = 10): open_file_graph("%s", width = 600, height=400) classes<-n1[,ncol(n1)] plot.dendropr(tree_cut1$tree.cl,classes, histo = TRUE) - """ % (DicoPath['Rdendro'],DicoPath['dendro1']) + """ % (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) @@ -336,7 +338,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=' ') @@ -353,7 +355,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) @@ -373,7 +375,7 @@ write.csv2(gbcluster,file="%s") #FIXME : split this!!! txt += """ source("%s") - """ % RscriptsPath['Rgraph'] + """ % ffr(RscriptsPath['Rgraph']) txt += """ afc <- summary.ca.dm(afc) @@ -381,25 +383,25 @@ 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']) + """ % (ffr(DictChdTxtOut['afc_facteur']), ffr(DictChdTxtOut['afc_col']), ffr(DictChdTxtOut['afc_row'])) txt += """ PARCEX<-%s """ % taillecar txt += """ xyminmax <- PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab) - """ % (DictChdTxtOut['AFC2DL_OUT']) + """ % (ffr(DictChdTxtOut['AFC2DL_OUT'])) txt += """ 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) - """ % (DictChdTxtOut['AFC2DSL_OUT']) + """ % (ffr(DictChdTxtOut['AFC2DSL_OUT'])) txt += """ 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) } - """ % (DictChdTxtOut['AFC2DEL_OUT']) + """ % (ffr(DictChdTxtOut['AFC2DEL_OUT'])) txt += """ 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) - """ % (DictChdTxtOut['AFC2DCL_OUT']) + """ % (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) @@ -415,7 +417,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() @@ -447,7 +449,7 @@ def write_afc_graph(self): 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],\ @@ -702,12 +704,12 @@ class PrintSimiScript(PrintRScript) : self.packages(['igraph', 'proxy', 'Matrix']) self.sources([self.analyse.parent.RscriptsPath['simi'], self.analyse.parent.RscriptsPath['Rgraph']]) txt = '' - if not self.parametres['keep_coord'] and not self.parametres['type'] == 'simimatrix': + 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" - """ % (self.pathout['mat01.csv'], self.pathout['actives.csv'], self.pathout['selected.csv']) + """ % (ffr(self.pathout['mat01.csv']), ffr(self.pathout['actives.csv']), ffr(self.pathout['selected.csv'])) if 'word' in self.parametres : txt += """ word <- TRUE @@ -738,11 +740,11 @@ class PrintSimiScript(PrintRScript) : index <- which(colnames(dm) == forme) } """ - elif not self.parametres['keep_coord'] and self.parametres['type'] == 'simimatrix' : + elif not self.parametres['keep_coord'] and (self.parametres['type'] == 'simimatrix' or self.parametres['type'] == 'simiclustermatrix'): txt += """ dm.path <- "%s" selected.col <- "%s" - """ % (self.pathout['mat01.csv'], self.pathout['selected.csv']) + """ % (ffr(self.pathout['mat01.csv']), ffr(self.pathout['selected.csv'])) if 'word' in self.parametres : txt += """ word <- TRUE @@ -775,7 +777,7 @@ class PrintSimiScript(PrintRScript) : else : txt += """ load("%s") - """ % self.pathout['RData.RData'] + """ % ffr(self.pathout['RData.RData']) if self.parametres['coeff'] == 0 : method = 'cooc' @@ -907,7 +909,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)') @@ -931,9 +942,11 @@ class PrintSimiScript(PrintRScript) : """ txt += """ seuil <- %s - if (method!='cooc') { - seuil <- seuil/100 - } + if (!is.null(seuil)) { + if (method!='cooc') { + seuil <- seuil/100 + } + } """ % seuil txt += """ @@ -1001,7 +1014,7 @@ class PrintSimiScript(PrintRScript) : cols <- vertex.label.color chivertex.size <- norm.vec(toblack, vcexminmax[1], vcexminmax[2]) - """ % (self.analyse.parent.RscriptsPath['chdfunct']) + """ % (ffr(self.analyse.parent.RscriptsPath['chdfunct'])) else : txt += """ vertex.label.color <- 'black' @@ -1068,7 +1081,7 @@ class PrintSimiScript(PrintRScript) : """ else : #print self.parametres - if (self.parametres['type'] == 'clustersimitxt' and self.parametres.get('tmpchi', False)) or (self.parametres['type'] == 'simimatrix' and 'tmpchi' in 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] @@ -1076,7 +1089,7 @@ class PrintSimiScript(PrintRScript) : txt += """ lchi <- lchi[sel.col] """ - if self.parametres['type'] == 'clustersimitxt' and self.parametres.get('cexfromchi', False) : + if self.parametres['type'] in ['clustersimitxt', 'simimatrix', 'simiclustermatrix'] and self.parametres.get('cexfromchi', False) : txt += """ label.cex <- norm.vec(lchi, vcexminmax[1], vcexminmax[2]) """ @@ -1088,7 +1101,7 @@ class PrintSimiScript(PrintRScript) : label.cex <- graph.simi$label.cex } """ - if (self.parametres['type'] == 'clustersimitxt' or self.parametres['type'] == 'simimatrix') 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 @@ -1119,9 +1132,9 @@ class PrintSimiScript(PrintRScript) : 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, svg = svg) + 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() @@ -1161,6 +1174,10 @@ 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)) @@ -1170,9 +1187,9 @@ class ProtoScript(PrintRScript) : } 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)) + prototypical(mat, mfreq = %s, mrank = %s, cloud = FALSE, cexrange=c(1,2.4), cexalpha= c(0.4, 1), type = '%s') dev.off() - """ % (self.analyse.pathout['table.csv'], self.analyse.pathout['proto.png'], self.parametres['limfreq'], self.parametres['limrang']) + """ % (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() @@ -1189,7 +1206,7 @@ class TgenSpecScript(PrintRScript): self.packages(['textometry']) txt = """ tgen <- read.csv2("%s", row.names = 1, sep = '\\t') - """ % self.parametres['tgeneff'] + """ % ffr(self.parametres['tgeneff']) txt += """ tot <- tgen[nrow(tgen), ] result <- NULL @@ -1202,6 +1219,44 @@ class TgenSpecScript(PrintRScript): colnames(result) <- colnames(tgen) row.names(result) <- rownames(tgen) write.table(result, file = "%s", sep='\\t', col.names = NA) - """ % self.pathout['tgenspec.csv'] + """ % 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 += """ + 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'])) 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() \ No newline at end of file