# -*- coding: utf-8 -*-
#Author: Pierre Ratinaud
#Copyright (c) 2008-2011 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
import tempfile
from chemins import ffr
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
}
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, DicoPath['uce'], 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']
+ """ % 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)
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)
""" % (DicoPath['dendro2'], DicoPath['arbre2'])
txt += """
- save.image(file="%s")
- """ % DicoPath['RData']
+
+ #save.image(file="%s")
+ """ % (DicoPath['RData'])
+
fileout = open(DicoPath['Rchdtxt'], 'w')
fileout.write(txt)
fileout.close()
chd.result<-Rchdquest("%s","%s","%s", nbt = nbt, mincl = mincl)
n1 <- chd.result$n1
classeuce1 <- chd.result$cuce1
- """ % (DicoPath['mat01'], DicoPath['listeuce1'], DicoPath['uce'])
+ """ % (DicoPath['mat01.csv'], DicoPath['listeuce1'], DicoPath['uce'])
txt += """
tree_tot1 <- make_tree_tot(chd.result$chd)
txt = "clnb<-%i\n" % clnb
txt += """
source("%s")
-load("%s")
-""" % (RscriptsPath['chdfunct'], DictChdTxtOut['RData'])
+#load("%s")
+n1 <- read.csv2("%s")
+""" % (RscriptsPath['chdfunct'], DictChdTxtOut['RData'], 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')
xyminmax <- PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='coord', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab)
""" % (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])
+ 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'])
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])
+ 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'])
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])
+ 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'])
# txt += """
# PlotAfc2dCoul(afc, as.data.frame(chistabletot), "%s", what='crl', deb=1, fin=(debsup-1), xlab = xlab, ylab = ylab)
""" % (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
""" % (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))
- 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))
- if (length(toinf)) {
- coordinf <- coord[toinf]
- valinf <- di[toinf]
- text(x=coordinf, y=valinf + 0.1, 'i')
- }
- 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)
+ 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'):
dm <-readMM(dm.path)
cn <- read.table(cn.path, sep='\t', quote='"')
colnames(dm) <- cn[,1]
- sel.col <- read.csv2(selected.col, header = FALSE)
- sel.col <- sel.col[,1] + 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 {
txt += """
dm <-read.csv2(dm.path)
dm <- as.matrix(dm)
- sel.col <- read.csv2(selected.col, header = FALSE)
- sel.col <- sel.col[,1] + 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 {
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'
"""
txt += """
seuil <- %s
+ if (!is.null(seuil)) {
+ if (method!='cooc') {
+ seuil <- seuil/100
+ }
+ }
""" % seuil
txt += """
"""
else :
txt+="""
- label.cex <- NULL
+ label.cex <- cex
"""
if self.parametres.get('sfromchi', False) :
txt += """
vertex.size <- NULL
"""
else :
- if self.parametres['type'] == 'clustersimitxt' :
+ #print self.parametres
+ if (self.parametres['type'] == 'clustersimitxt' and self.parametres.get('tmpchi', False)) or (self.parametres['type'] == 'simimatrix' and 'tmpchi' in self.parametres):
txt += """
lchi <- read.table("%s")
lchi <- lchi[,1]
else :
txt += """
if (is.null(vcexminmax[1])) {
- label.cex <- NULL
+ label.cex <- cex
} else {
label.cex <- graph.simi$label.cex
}
"""
- if self.parametres['type'] == 'clustersimitxt' and self.parametres.get('sfromchi', False) :
+ if (self.parametres['type'] == 'clustersimitxt' or self.parametres['type'] == 'simimatrix') and self.parametres.get('sfromchi', False):
txt += """
vertex.size <- norm.vec(lchi, minmaxeff[1], minmaxeff[2])
if (!length(vertex.size)) vertex.size <- 0
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=600, width=600)
- prototypical(mat, mfreq = %s, mrank = %s, cloud = FALSE, cexrange=c(1,2.4), cexalpha= c(0.4, 1))
+ 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()
- """ % (self.analyse.pathout['table.csv'], self.analyse.pathout['proto.png'], self.parametres['limfreq'], self.parametres['limrang'])
+ """ % (self.analyse.pathout['table.csv'], 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 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)
+ """ % self.pathout['tgenspec.csv']
+ self.add(txt)
+
projects / iramuteq / blobdiff