From 7f5e0ba6ece181a04d872a7b6eeb2f13b33aa455 Mon Sep 17 00:00:00 2001 From: Pierre Date: Tue, 8 Jan 2013 17:30:16 +0100 Subject: [PATCH] afc --- Rscripts/Rgraph.R | 20 ++++++-------------- Rscripts/afc_graph.R | 16 ++++++++++------ 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/Rscripts/Rgraph.R b/Rscripts/Rgraph.R index 6abd55e..b0b555c 100644 --- a/Rscripts/Rgraph.R +++ b/Rscripts/Rgraph.R @@ -94,11 +94,10 @@ PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axeto open_file_graph(filename, width = width, height = height) par(cex=PARCEX) - table.in <- rowcoord[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) + table.in <- stopoverlap(table.in, cex.par=cex.par, xlim = c(xmin,xmax), ylim = c(ymin,ymax)) classes <- classes[table.in[,4]] cex.par <- cex.par[table.in[,4]] make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax=c(xmin,xmax), yminmax=c(ymin,ymax)) @@ -173,7 +172,7 @@ overlap <- function(x1, y1, sw1, sh1, boxes) { .Call("is_overlap",x11,y11,sw11,sh11,boxes1) } ######################################################## -stopoverlap <- function(x, cex.par = NULL) { +stopoverlap <- function(x, cex.par = NULL, xlim = NULL, ylim = NULL) { #from wordcloud library(wordcloud) tails <- "g|j|p|q|y" @@ -184,7 +183,7 @@ stopoverlap <- function(x, cex.par = NULL) { toplot <- NULL # plot.new() - plot(x[,1],x[,2], pch='') + plot(x[,1],x[,2], pch='', xlim = xlim, ylim = ylim) words <- rownames(x) if (is.null(cex.par)) { @@ -202,8 +201,6 @@ stopoverlap <- function(x, cex.par = NULL) { y1<- x[i,2] wid <- strwidth(words[i],cex=size[i]) ht <- strheight(words[i],cex=size[i]) - ht <- (ht + ht*.08) - wid <- (wid + wid*.15) isOverlaped <- TRUE while(isOverlaped){ if(!overlap(x1-.5*wid,y1-.5*ht,wid,ht, boxes)) { #&& @@ -213,7 +210,7 @@ stopoverlap <- function(x, cex.par = NULL) { boxes[[length(boxes)+1]] <- c(x1-.5*wid,y1-.5*ht,wid,ht) isOverlaped <- FALSE } else { - if(r>sqrt(.1)){ + if(r>sqrt(.5)){ print(paste(words[i], "could not be fit on page. It will not be plotted.")) isOverlaped <- FALSE } @@ -428,13 +425,8 @@ create_afc_table <- function(x) { } make_afc_graph <- function(toplot, classes, clnb, xlab, ylab, cex.txt = NULL, leg = FALSE, cmd = FALSE, black = FALSE, xminmax=NULL, yminmax=NULL) { - if (is.null(xminmax)) { - xminmax <- c(min(toplot[,1], na.rm = TRUE) + ((max(cex.txt)/10) * min(toplot[,1], na.rm = TRUE)), max(toplot[,1], na.rm = TRUE) + ((max(cex.txt)/10) * max(toplot[,1], na.rm = TRUE))) - } - if (is.null(yminmax)) { - yminmax <- c(min(toplot[,2], na.rm = TRUE) + ((max(cex.txt)/10) * min(toplot[,2], na.rm = TRUE)), max(toplot[,2], na.rm = TRUE) + ((max(cex.txt)/10) * max(toplot[,2], na.rm = TRUE))) - } - rain <- rainbow(clnb) + + rain <- rainbow(clnb) compt <- 1 tochange <- NULL for (my.color in rain) { diff --git a/Rscripts/afc_graph.R b/Rscripts/afc_graph.R index 017b782..ffca92a 100644 --- a/Rscripts/afc_graph.R +++ b/Rscripts/afc_graph.R @@ -31,10 +31,8 @@ tchi <- %s tchi.min <- %i tchi.max <- %i dirout <- '%s' -#xmin <- xmin -#xmax <- xmax -#ymin <- ymin -#ymax <- ymax +xminmax <- NULL +yminmax <- NULL xlab <- paste('facteur ', x, ' -') ylab <- paste('facteur ', y, ' -') @@ -149,6 +147,12 @@ if ( qui == 3 ) { } } +if (is.null(xminmax)) { + xminmax <- c(min(table.in[,1], na.rm = TRUE) + ((max(cex.par)/10) * min(table.in[,1], na.rm = TRUE)), max(table.in[,1], na.rm = TRUE) + ((max(cex.par)/10) * max(table.in[,1], na.rm = TRUE))) + } + if (is.null(yminmax)) { + 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) { @@ -159,11 +163,11 @@ if (typegraph == 0) { 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) + 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]] } - make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par) + make_afc_graph(table.in, classes, clnb, xlab, ylab, cex.txt = cex.par, xminmax = xminmax, yminmax = yminmax) } else { -- 2.7.4