#Author: Pierre Ratinaud
#Copyright (c) 20010-2013 Pierre Ratinaud
-#Lisense: GNU/GPL
+#License: GNU/GPL
#fichier genere par IRaMuTeq
if (exists('afctable')) {
eff <- rowSums(afctable)
} else {
- eff <- afctable$rowmass
+ eff <- afc$rowmass
}
if (!is.null(debsup)) {
cex.par <- eff[debsup:(debet-1)]
}
if ( qui == 2 ) {
+ fin <- nrow(table.in)
table.in <- table.in[debet:nrow(table.in),]
tablechi <- tablechi[debet:nrow(tablechi),]
- cex.par <- eff[debet:nrow(afctable)]
+ cex.par <- eff[debet:fin]
}
}
cex.par <- eff
}
} else {
+ fin <- nrow(table.in)
table.in <- table.in[debet:nrow(table.in),]
tablechi <- tablechi[debet:nrow(tablechi),]
- cex.par <- eff[debet:nrow(afctable)]
+ cex.par <- eff[debet:fin]
}
}
table.in <- table.in[row.keep,]
tablechi <- tablechi[row.keep,]
} else if (do.select.chi.classe) {
- row.keep <- select.chi.classe(tablechi, ptbycluster)
+ row.keep <- select.chi.classe(tablechi, ptbycluster, active=FALSE)
table.in <- table.in[row.keep,]
tablechi <- tablechi[row.keep,]
} else {
yminmax <- c(min(table.in[,2], na.rm = TRUE) + ((max(cex.par)/10) * min(table.in[,2], na.rm = TRUE)), max(table.in[,2], na.rm = TRUE) + ((max(cex.par)/10) * max(table.in[,2], na.rm = TRUE)))
}
-if (typegraph == 0) {
+if (typegraph == 0 || typegraph == 2) {
open_file_graph(fileout, width = width, height = height, svg = do.svg)
parcex <- taillecar/10
par(cex = parcex)
if (over) {
- table.in <- table.in[order(cex.par, decreasing = TRUE),]
- classes <- classes[order(cex.par, decreasing = TRUE)]
- cex.par <- cex.par[order(cex.par, decreasing = TRUE)]
- table.in <- stopoverlap(table.in, cex.par=cex.par, xlim = xminmax, ylim = yminmax)
- classes <- classes[table.in[,4]]
- cex.par <- cex.par[table.in[,4]]
+ table.in <- table.in[order(cex.par, decreasing = TRUE),]
+ classes <- classes[order(cex.par, decreasing = TRUE)]
+ cex.par <- cex.par[order(cex.par, decreasing = TRUE)]
+ table.out <- stopoverlap(table.in, cex.par=cex.par, xlim = xminmax, ylim = yminmax)
+ table.in <- table.out$toplot
+ notplot <- table.out$notplot
+ if (! is.null(notplot)) {
+ write.csv2(notplot, file = paste(fileout,'_notplotted.csv', sep=''))
+ }
+ classes <- classes[table.in[,4]]
+ cex.par <- cex.par[table.in[,4]]
+ }
+ if (typegraph == 0) {
+ make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax)
+ } else {
+ dev.off()
+ require(rgexf)
+ nodes.attr <- make.afc.attributes(rownames(table.in), afc_table, afctable, clnb)
+ if (qui != 3) {
+ tokeep <- rownames(chistabletot) %%in%% rownames(table.in)
+ chis <- chistabletot[tokeep,]
+ chis<-chis[rownames(table.in),]
+ nodes.attr$chiclasse <- chis
+ } else {
+ chis <- NULL
+ }
+ afctogexf(fileout, table.in, classes, clnb, cex.par, nodes.attr = nodes.attr)
}
- make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax)
} else {
library(rgl)
rain = rainbow(clnb)
colors = rain[classes]
#rn <- rownames(table.in)
- rgl.open()
+ #rgl.open()
+
text3d(table.in[,1], table.in[,2], table.in[,3], rn, col = colors , cex = cex.par)
rgl.bg(col = c('white', "#99bb99"), front = "lines", box=FALSE, sphere = TRUE)
+ par3d('userMatrix' = matrix(c(1,0,0,0, 0,1,0,0,0,0,1,0,0,0,0,1), ncol=4, nrow = 4))
par3d(cex=0.7)
#par3d(windowRect = c(100,100,600,600))
rgl.lines(c(rx), c(0, 0), c(0, 0), col = "#000000")
ReturnVal <- tkmessageBox(title="RGL 3 D",message="Fini !",icon="info",type="ok")
}
- require(tcltk)
- ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
+ if (typegraph == 1) {
+ require(tcltk)
+ ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
+ } else {
+ writeWebGL(dir = fileout, width = width, height= height)
+ }
rgl.close()
}