ワードクラウドで特定の単語の色を変更する

Question

私はRで単語の雲を作りたいと思っています（パッケージwordcloudでこれを行いました）。現在のところ、関数の振る舞いは周波数に応じて色を付けることです（これは有益かもしれません）が、単語サイズはすでにこれを行っていますので、追加の意味で色を使用したいと思います。

ワードクラウドで特定の単語をどのように色付けするかについてのアイデアはありますか？ （Rに別のワードクラウド機能がある場合は、私はそのルートに行くことを喜んでいます。）

私は、同じ魔法の色の引数を扱うことを試みました。プロット関数からの定期的なプロット）：

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) 

編集：私はwordcloudの新しいバージョン（2010年1月10日という追加したい、バージョン2.0）[あなたのイアン・フェローズ&デビッド・ロビンソンありがとう]は今、この機能でした他にもいくつか素晴らしい追加があります。

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

Answer 1

EDIT： はここwordcloud以内に当初の目標を達成するためのコードであるコメントで説明したように、以下で説明する機能は、今wordcloudライブラリに追加されました。

---

私のアプローチは、R関数のコードを受け取り、それをカスタマイズすることでした。数行しか変更する必要がなく、今度は単一の色か、同じ長さの色のベクトルを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() 
} 

それを試してみるために、いくつかのコード：

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