cambiar el color específico de la palabra en wordcloud

Question

Me gustaría construir una nube de palabras con R (lo he hecho con el paquete wordcloud) y luego colorear palabras específicas de un cierto color. Actualmente el comportamiento de la función es colorear palabras de acuerdo a la frecuencia (que puede ser útil), pero el tamaño de la palabra ya lo hace, así que me gustaría utilizar el color para un significado adicional.

¿Alguna idea sobre cómo colorear palabras específicas en wordcloud? (Si hay otra función wordcloud en R, no estoy al tanto de que esté más que dispuesta a seguir esa ruta.)

Un ejemplo falso y mi intento (traté de tratar el argumento del color de la misma manera en que lo haría) trama regular a partir de la función de parcela):

library(wordcloud) 

x <- paste(rep("how do keep the two words as one chunk in the word cloud", 3), 
      collapse = " ") 
X <- data.frame(table(strsplit(x, " "))) 
COL <- ifelse(X$Var1 %in% c("word", "cloud", "words"), "red", "black") 
wordcloud(X$Var1, X$Freq, color=COL) 

EDIT: me gustaría añadir que la nueva versión de wordcloud (10 Ene del 2010; versión 2.0) [Gracias Ian Fellows & David Robinson] ahora era esta característica junto con algunas otras increíbles adiciones. Este es el código para lograr la meta original dentro de wordcloud:

wordcloud(X$Var1, X$Freq, color=COL, ordered.colors=TRUE, random.color=FALSE) 

Answer 1

EDIT: Como se describe en los comentarios, la función se describe a continuación ha sido añadido a la biblioteca wordcloud.

---

Mi enfoque era tomar el código de la función R y personalizarlo. Se requirió cambiar solo unas pocas líneas, y ahora puede tomar un único color o un vector de colores de la misma longitud que words.

library(wordcloud) 

colored.wordcloud <- function(words,freq,scale=c(4,.5),min.freq=3,max.words=Inf,random.order=TRUE,random.color=FALSE, 
     rot.per=.1,colors="black",ordered.colors=FALSE,use.r.layout=FALSE,...) { 
    tails <- "g|j|p|q|y" 
    last <- 1 
    nc<- length(colors) 

    if (ordered.colors) { 
     if (length(colors) != 1 && length(colors) != length(words)) { 
      stop(paste("Length of colors does not match length of words", 
         "vector")) 
     } 
    } 

    overlap <- function(x1, y1, sw1, sh1) { 
     if(!use.r.layout) 
      return(.overlap(x1,y1,sw1,sh1,boxes)) 
     s <- 0 
     if (length(boxes) == 0) 
      return(FALSE) 
     for (i in c(last,1:length(boxes))) { 
      bnds <- boxes[[i]] 
      x2 <- bnds[1] 
      y2 <- bnds[2] 
      sw2 <- bnds[3] 
      sh2 <- bnds[4] 
      if (x1 < x2) 
       overlap <- x1 + sw1 > x2-s 
      else 
       overlap <- x2 + sw2 > x1-s 

      if (y1 < y2) 
       overlap <- overlap && (y1 + sh1 > y2-s) 
      else 
       overlap <- overlap && (y2 + sh2 > y1-s) 
      if(overlap){ 
       last <<- i 
       return(TRUE) 
      } 
     } 
     FALSE 
    } 

    ord <- rank(-freq, ties.method = "random") 
    words <- words[ord<=max.words] 
    freq <- freq[ord<=max.words] 
    if (ordered.colors) { 
     colors <- colors[ord<=max.words] 
    } 

    if(random.order) 
     ord <- sample.int(length(words)) 
    else 
     ord <- order(freq,decreasing=TRUE) 
    words <- words[ord] 
    freq <- freq[ord] 
    words <- words[freq>=min.freq] 
    freq <- freq[freq>=min.freq] 
    if (ordered.colors) { 
     colors <- colors[ord][freq>=min.freq] 
    } 

    thetaStep <- .1 
    rStep <- .05 
    plot.new() 
    op <- par("mar") 
    par(mar=c(0,0,0,0)) 
    plot.window(c(0,1),c(0,1),asp=1) 
    normedFreq <- freq/max(freq) 
    size <- (scale[1]-scale[2])*normedFreq + scale[2] 
    boxes <- list() 



    for(i in 1:length(words)){ 
     rotWord <- runif(1)<rot.per 
     r <-0 
     theta <- runif(1,0,2*pi) 
     x1<-.5 
     y1<-.5 
     wid <- strwidth(words[i],cex=size[i],...) 
     ht <- strheight(words[i],cex=size[i],...) 
     #mind your ps and qs 
     if(grepl(tails,words[i])) 
      ht <- ht + ht*.2 
     if(rotWord){ 
      tmp <- ht 
      ht <- wid 
      wid <- tmp 
     } 
     isOverlaped <- TRUE 
     while(isOverlaped){ 
      if(!overlap(x1-.5*wid,y1-.5*ht,wid,ht) && 
        x1-.5*wid>0 && y1-.5*ht>0 && 
        x1+.5*wid<1 && y1+.5*ht<1){ 
     if (!random.color) { 
       if (ordered.colors) { 
        cc <- colors[i] 
       } 
       else { 
        cc <- ceiling(nc*normedFreq[i]) 
        cc <- colors[cc] 
       } 
     } else { 
     cc <- colors[sample(1:nc,1)] 
     } 
       text(x1,y1,words[i],cex=size[i],offset=0,srt=rotWord*90, 
         col=cc,...) 
       #rect(x1-.5*wid,y1-.5*ht,x1+.5*wid,y1+.5*ht) 
       boxes[[length(boxes)+1]] <- c(x1-.5*wid,y1-.5*ht,wid,ht) 
       isOverlaped <- FALSE 
      }else{ 
       if(r>sqrt(.5)){ 
        warning(paste(words[i], 
            "could not be fit on page. It will not be plotted.")) 
        isOverlaped <- FALSE 
       } 
       theta <- theta+thetaStep 
       r <- r + rStep*thetaStep/(2*pi) 
       x1 <- .5+r*cos(theta) 
       y1 <- .5+r*sin(theta) 
      } 
     } 
    } 
    par(mar=op) 
    invisible() 
} 

algo de código para probarlo:

colors = c("blue", "red", "orange", "green") 
colored.wordcloud(colors, c(10, 5, 3, 9), colors=colors)