translators

[iramuteq] / Rscripts / prototypical.R

diff --git a/Rscripts/prototypical.R b/Rscripts/prototypical.R
index dddd7cb..c4fc02f 100644 (file)
--- 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) {