X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2FRgraph.R;h=4d94e3590cbafe7ad91b4102540f9a499e3ab752;hp=2ea1c3803e62f1a94c171fa9ad0d3c5815acb39e;hb=5d84083b41b807307732adb78e1be7fd3e3ff004;hpb=0c8c6509adbec7ffb2ee844aea5e92b0e021a82d

diff --git a/Rscripts/Rgraph.R b/Rscripts/Rgraph.R
index 2ea1c38..4d94e35 100644
--- a/Rscripts/Rgraph.R
+++ b/Rscripts/Rgraph.R
@@ -43,7 +43,7 @@ PlotDendroCut <- function(chd,filename,reso,clusternb) {
 #	dev.off()
 #}
 
-PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axetoplot=c(1,2), deb=0,fin=0, width=900, height=900, quality=100, reso=200, parcex=PARCEX, xlab = NULL, ylab = NULL, xmin=NULL, xmax=NULL, ymin=NULL, ymax=NUL) {
+PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axetoplot=c(1,2), deb=0,fin=0, width=900, height=900, quality=100, reso=200, parcex=PARCEX, xlab = NULL, ylab = NULL, xmin=NULL, xmax=NULL, ymin=NULL, ymax=NULL) {
 	if (col) {
 		if (what == 'coord') {
 			rowcoord <- as.matrix(afc$colcoord)
@@ -75,7 +75,7 @@ PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axeto
 	if (!col) {
         classes <- as.matrix(apply(chitable,1,which.max))
         cex.par <- norm.vec(apply(chitable,1,max), 0.8,3)
-        row.keep <- select.chi.classe(chitable, 60)
+        row.keep <- select.chi.classe(chitable, 80)
         rowcoord <- rowcoord[row.keep,]
         classes <- classes[row.keep]
         cex.par <- cex.par[row.keep]
@@ -83,6 +83,15 @@ PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axeto
         classes <- 1:clnb
         cex.par <- rep(1,clnb)
     }
+    if (is.null(xmin)) {
+        table.in <- rowcoord
+        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)))
+        xmin <- xminmax[1]
+        xmax <- xminmax[2]
+        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)))
+        ymin <- yminmax[1]
+        ymax <- yminmax[2]
+     }
 	#ntabtot <- cbind(rowcoord, classes)
 	#if (!col) ntabtot <- ntabtot[row_keep,]
     xlab <- paste('facteur ', x, ' -')
@@ -94,15 +103,20 @@ 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.out <- stopoverlap(table.in, cex.par=cex.par, xlim = c(xmin,xmax), ylim = c(ymin,ymax))
+    table.in <- table.out$toplot
+    notplot <- table.out$notplot
+    if (! is.null(notplot)) {
+        write.csv2(notplot, file = paste(filename, '_notplotted.csv', sep = ''))
+    }
     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))
-    
+    xyminmax <- list(yminmax = c(ymin,ymax), xminmax = c(xmin,xmax))
+    xyminmax 
 	#plot(rowcoord[,x],rowcoord[,y], pch='', xlab = xlab, ylab = ylab)
 	#abline(h=0,v=0)
 	#for (i in 1:clnb) {
@@ -173,7 +187,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"
@@ -182,9 +196,10 @@ stopoverlap <- function(x, cex.par = NULL) {
     thetaStep <- .1
     rStep <- .5
     toplot <- NULL
+    notplot <- 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 +217,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,8 +226,9 @@ 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."))
+                    notplot <- rbind(notplot,c(words[i], x[i,1], x[i,2]))
 					isOverlaped <- FALSE
 				}
 				theta <- theta+thetaStep
@@ -225,7 +239,7 @@ stopoverlap <- function(x, cex.par = NULL) {
 		}
     }
     row.names(toplot) <- words[toplot[,4]]
-    return(toplot)
+    return(list(toplot = toplot, notplot = notplot))
 }
 ###############################################################################
 
@@ -428,13 +442,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) + (0.1 * min(toplot[,1], na.rm = TRUE)), max(toplot[,1], na.rm = TRUE) + (0.1 * max(toplot[,1], na.rm = TRUE)))
-    }
-    if (is.null(yminmax)) {
-        yminmax <- c(min(toplot[,2], na.rm = TRUE) + (0.1 * min(toplot[,2], na.rm = TRUE)), max(toplot[,2], na.rm = TRUE) + (0.1 * max(toplot[,2], na.rm = TRUE)))
-    }
-	rain <- rainbow(clnb)
+    
+    rain <- rainbow(clnb)
     compt <- 1
     tochange <- NULL
     for (my.color in rain) {