X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fprototypical.R;h=c4fc02fff177b865b8e60bd1b14f303bca2fe2a2;hp=dddd7cb0a0a67e48ee5d18c92b1bb0f40490c4e1;hb=f12da65c1895ecdd1b48109d7b1334181487a25f;hpb=54fef96ad151ba25920f3e589b39a83c3f62ae2c

diff --git a/Rscripts/prototypical.R b/Rscripts/prototypical.R
index dddd7cb..c4fc02f 100644
--- a/Rscripts/prototypical.R
+++ b/Rscripts/prototypical.R
@@ -13,7 +13,7 @@ norm.vec <- function(v, min, max) {
 
 #x a table with freq and rank, rownames are words
 
-prototypical <- function(x, mfreq = NULL, mrank = NULL, cexrange=c(0.8, 3), cexalpha = c(0.5, 1), labfreq = TRUE, labrank = TRUE, cloud = TRUE) {
+prototypical <- function(x, mfreq = NULL, mrank = NULL, cexrange=c(0.8, 3), cexalpha = c(0.5, 1), labfreq = TRUE, labrank = TRUE, cloud = TRUE, type = 'classical') {
     library(wordcloud)
     if (is.null(mfreq)) {
         mfreq <- sum(x[,1]) / nrow(x)
@@ -36,32 +36,46 @@ prototypical <- function(x, mfreq = NULL, mrank = NULL, cexrange=c(0.8, 3), cexa
     labcex <- norm.vec(x[,1], cexrange[1], cexrange[2])
     labalpha <- norm.vec(x[,2], cexalpha[2], cexalpha[1])
     labalpha <- rgb(0.1,0.2,0.1, labalpha)
-    par(oma=c(1,3,3,1))
-    layout(matrix(c(1,4,2,3), nrow=2))
+	labcol <- rep('black', nrow(x))
+	labcol[FP] <- 'red'
+	labcol[SP] <- 'green'
+	labcol[ZN] <- 'blue'
     ti <- c("Zone du noyau", "Première périphérie", "Seconde périphérie", "Elements contrastés")
-    for (i in 1:length(toplot)) {
-        rtoplot <- toplot[[i]]
-        if (length(rtoplot)) {
-            par(mar=c(0,0,2,0))
-            if (cloud) {
-                labels <- paste(rownames(x)[rtoplot], x[rtoplot,1], x[rtoplot,2], sep='-')
-                wordcloud(labels, x[rtoplot,1], scale = c(max(labcex[rtoplot]), min(labcex[rtoplot])), color = labalpha[rtoplot], random.order=FALSE, rot.per = 0)
-                box()
-            } else {
-                yval <- 1.1
-                plot(0,0,pch='', axes = FALSE)
-                k<- 0
-                for (val in rtoplot) {
-                    yval <- yval-(strheight(rownames(x)[val],cex=labcex[val])+0.02)
-                    text(-0.9, yval, paste(rownames(x)[val], x[val,1], x[val,2], sep = '-'), cex = labcex[val], col = labalpha[val], adj=0)
-                }
-                box()
-            }
-            title(ti[i])
-        }
-    }
-    mtext(paste('<', mfreq, '  Fréquences  ', '>=', mfreq, sep = ' '), side=2, line=1, cex=1, col="red", outer=TRUE)
-    mtext(paste('<=', mrank,  '  Rangs  ', '>', mrank, sep = ' '), side=3, line=1, cex=1, col="red", outer=TRUE)
+	if (type == 'classical') {
+	    par(oma=c(1,3,3,1))
+	    layout(matrix(c(1,4,2,3), nrow=2))
+	    for (i in 1:length(toplot)) {
+	        rtoplot <- toplot[[i]]
+	        if (length(rtoplot)) {
+	            par(mar=c(0,0,2,0))
+	            if (cloud) {
+	                labels <- paste(rownames(x)[rtoplot], x[rtoplot,1], x[rtoplot,2], sep='-')
+	                wordcloud(labels, x[rtoplot,1], scale = c(max(labcex[rtoplot]), min(labcex[rtoplot])), color = labalpha[rtoplot], random.order=FALSE, rot.per = 0)
+	                box()
+	            } else {
+	                yval <- 1.1
+	                plot(0,0,pch='', axes = FALSE)
+	                k<- 0
+	                for (val in rtoplot) {
+	                    yval <- yval-(strheight(rownames(x)[val],cex=labcex[val])+0.02)
+	                    text(-0.9, yval, paste(rownames(x)[val], x[val,1], x[val,2], sep = '-'), cex = labcex[val], col = labalpha[val], adj=0)
+	                }
+	                box()
+	            }
+	            title(ti[i])
+	        }
+	    }
+	    mtext(paste('<', mfreq, '  Fréquences  ', '>=', mfreq, sep = ' '), side=2, line=1, cex=1, col="red", outer=TRUE)
+	    mtext(paste('<=', mrank,  '  Rangs  ', '>', mrank, sep = ' '), side=3, line=1, cex=1, col="red", outer=TRUE)
+	} else if (type == 'plan') {
+		par(oma=c(3,3,1,1))
+		textplot(x[,1], x[,2], rownames(x), cex=labcex, xlim=c(min(x[,1])-nrow(x)/3, max(x[,1])+5), ylim = c(min(x[,2])-0.2, max(x[,2])+0.5), col=labcol, xlab="", ylab="")
+	    abline(v=mfreq)
+		abline(h=mrank)
+		legend('topright', ti, fill=c('blue', 'red', 'green', 'black'))
+		mtext(paste('<', mfreq, '  Fréquences  ', '>=', mfreq, sep = ' '), side=1, line=1, cex=1, col="red", outer=TRUE)
+		mtext(paste('<=', mrank,  '  Rangs  ', '>', mrank, sep = ' '), side=2, line=1, cex=1, col="red", outer=TRUE)		
+	}
 }
 
 intervalle.freq <- function(x, SX=NULL) {