Lecture 9 (その１): wordcloud

準備：getFreqMtxDir.Rに関数の追加

getFreq <- function(txt, relative = FALSE) {

    wordLst <- strsplit(txt, "[[:space:]]|[[:punct:]]")
    wordLst <- unlist(wordLst)
    wordLst <- tolower(wordLst)
    wordLst <- wordLst[wordLst != ""]

    freq <- sort(table(wordLst), decreasing = TRUE)
    if (relative == TRUE) {
        freq <- round(freq/sum(freq), 3)
    }
    freqMtx <- data.frame(freq)
    return(freqMtx)
}

getFreqMtxDir.Rの読み込み

source("getFreqMtxDir.R")

univ頻度行列

univ <- getFreqMtxDir("../univ")
univ[1:3, ]

##     hiroshima kufs kyoto osaka osakaNew tokyo waseda
## 000         0    0     0     0        0     0      2
## 1           0    0     0     1        0     0      1
## 10          0    0     1     0        0     0      1

最初の文字が数字で始まるものを排除

tmp <- univ[grep(rownames(univ), pattern = "^[[:alpha:]]"), ]
univ <- univ[rownames(univ) %in% rownames(tmp), ]
univ[1:3, ]

##           hiroshima kufs kyoto osaka osakaNew tokyo waseda
## a                 4   12    21     8       14    10     24
## abilities         0    0     0     0        0     0      1
## ability           0    1     1     0        0     0      0

wordcloudパッケージのインストール

install.packages("wordcloud")

wordcloudのロード

library(wordcloud)

## Loading required package: Rcpp

## Warning: package 'Rcpp' was built under R version 2.15.3

## Loading required package: RColorBrewer

##　wordcloud()の実行例１ ###　wordcloud(words,freq, …)

wordcloud(rownames(univ), univ[, 1])

##　wordcloud()の実行例2

wordcloud(rownames(univ), univ[, 1], min.freq = 2, colors = rainbow(10))

##　色遊び：RColorBrewer

library(RColorBrewer)
binfo <- brewer.pal.info[]
binfo[binfo$maxcolors > 9, ]
col <- brewer.pal(10, "BrBG")
wordcloud(rownames(univ), univ[, 1], min.freq = 2, colors = col)

##　comparison.cloud()の実行例

hitoshima, kufs

comparison.cloud(univ[, 1:2])

##　comparison.cloud()の実行例

colnames(univ)
comparison.cloud(univ[, c(F, T, F, T, F, F, T, F)])

##　commonality.cloud()の実行例

commonality.cloud(univ)

shinyで実装

shinyのロード

library(shiny)

shiny作業フォルダの作成：wcould

ui.Rの作成

shinyUI(bootstrapPage(

  # Application title
  headerPanel("wordcloud"),

  # Sidebar
  sidebarPanel(

      uiOutput("controlUnivName"),
      uiOutput("controlColor"),

      sliderInput(inputId = "s1",
            label = "Scale size: ",
            min = 4, max = 10, value=4),
      sliderInput(inputId = "s2",
                  label = "Scale size: ",
                  min = 0.5, max = 1.0, value=0.5, step=0.1)
    ),

  # Show a plot of the generated distribution
  mainPanel(
    tabsetPanel(    
      tabPanel("wordcloud", plotOutput("wordCloud")),
      tabPanel("commonality cloud", plotOutput("commonalityCloud"))
    )
  )
))

server.R (枠組み)

library(wordcloud)
library(RColorBrewer)
univ <- getFreqMtxDir("univ")
tmp <- univ[grep(rownames(univ) , pattern = "^[[:alpha:]]"),]
univ <- univ[rownames(univ) %in% rownames(tmp),]

shinyServer(function(input, output) {

  output$wordCloud <- renderPlot({
    ...
  })

  output$commonalityCloud <- renderPlot({
    ...
  })

  output$controlColor <- renderUI({
    ...
  })

  output$controlUnivName <- renderUI({
    ...
  })
})

server.R (output$wordCloud)

output$wordCloud <- renderPlot({

    name <- input$univName
    # print(paste('univ',name, sep='$')) ex. univ$hiroshima
    freq <- eval(parse(text = paste("univ", name, sep = "$")))
    # freq<-univ[,colnames(univ)==input$univName]と同じ結果

    col <- brewer.pal(11, input$palet)
    wordcloud(rownames(univ), freq, colors = col, scale = c(input$s1, input$s2))
})

server.R (output$comparisonCloud)

output$comparisonCloud <- renderPlot({
    col <- brewer.pal(11, input$palet)
    comparison.cloud(univ[rowSums(univ) >= 10, ], colors = col, scale = c(input$s1, 
        input$s2))
})

server.R (output$commonalityCloud)

output$commonalityCloud <- renderPlot({
    col <- brewer.pal(11, input$palet)
    commonality.cloud(univ, colors = col, scale = c(input$s1, input$s2))
})

server.R (output$controlColor)

output$controlColor <- renderUI({
    binfo <- brewer.pal.info[]
    palets <- rownames(binfo[binfo$maxcolors > 9, ])

    selectInput(inputId = "palet", label = "Choose a palet", choices = palets, 
        selected = palets[1])
})

server.R (output$controlUnivName)

output$controlUnivName <- renderUI({
    selectInput(inputId = "univName", label = "Choose a university:", choices = colnames(univ), 
        selected = colnames(univ)[1])
})

wcloudアプリケーションの起動

runApp("wcloud")