「Twitter関連タグ検索」……RStudio Shiny製のTwitterツール。指定のキーワードに関連するコメントからタグを抽出・整理・表示する。

Readme.R

# Rコンソールで下記コマンドを実行すると、ツールが起動する。
#   ※本ツールのRソースのダウンロードは下記コマンドで行う為、不要となる。
#   ※Windows環境下では文字化けを起こす。その時はブラウザのエンコード指定を[UTF-8]から[SHIFT-JIS]に変える必要がある。
install.packages("shiny")
library(shiny)
options(encoding = "UTF-8")
shiny::runGist("4702281")

# ツールを終了する時はRコンソールでESCキーを押す。
# その後、下記コマンドを実行する。
options(encoding = "native.enc")

global.R

CRITERIA.RATE <- "0"
CRITERIA.COUNT <- "1"
PACKAGES <- installed.packages()[,"Package"]

# パッケージをインストールする
InstallPackages <- function(package){
  if(length(grep(paste("^",package,"$",sep=""),PACKAGES)) < 1){
    # 未インストールの場合
    install.packages(package)
  }
}

server.R

library(shiny)
InstallPackages("twitteR")
library(twitteR)

# サーバ処理
shinyServer(function(input, output) {
  
  # コメントを取得する
  getComments <- reactive(function() {
    searchTwitter(tolower(strtrim(input$keyword,width=280)),n = input$maxComments)
  })
  
  # コメント数を取得する
  countComments <- reactive(function() {
    length(getComments())
  })
  
  # タグ別ヒット数を取得する 
  countHitPerTag <- reactive(function() {
    comments <- getComments()
    nComments <- countComments()
    tags <- NULL
    if(0 < nComments){
      # コメントを取得できた場合
      for(i in 1:nComments){
        commentText <- comments[[i]]$text
        idxTags <- gregexpr("(#|＃){1}[[:alnum:]]+",commentText)[[1]]
        if(-1 < idxTags[[1]]){
          # コメント内にタグがある場合
          tags <- append(list(tolower(substring(commentText,idxTags,idxTags + attr(idxTags, 'match.length') - 1))),tags)
        }
      }
    }
    if(0 < length(tags)){
      # タグを取得できた場合
      tagsMap <- data.frame(key = unlist(tags),count = 1)
      nHitPerTag <- rowsum(tagsMap[,2],tagsMap[,1])
      sapply(nHitPerTag[order(nHitPerTag, decreasing = TRUE),1],as.integer)
    }else{
      # タグを取得できなかった場合
      c(0)
    }
  })
  
  # タグ別ヒット数を表示分取得する 
  countHitPerTag4Disp <- reactive(function() {
    nHitPerTag <- countHitPerTag()
    maxTags <- min(input$maxTags,100)
    nTag <- length(nHitPerTag)
    if(nTag < maxTags){
      # 指定したタグ数より取得したタグ数が少ない場合
      nTag4Disp <- nTag
    }else{
      # 上記以外の場合
      nTag4Disp <- maxTags
    }
    nHitPerTag[1:nTag4Disp]
  })
  
  # タグ別ヒット率を表示分取得する 
  getHitRatePerTag4Disp <- reactive(function() {
    countHitPerTag4Disp()/countComments()
  })
  
  # タグ別グラフデータを取得する
  getGraphData <- reactive(function() {
    if(input$criteria == CRITERIA.RATE){ 
      # ヒット率が選択された場合
      getHitRatePerTag4Disp()
    }else{
      # 上記以外の場合
      countHitPerTag4Disp()
    }
  })
  
  # タグ別表データを取得する
  getTableData <- reactive(function() {    
    if(input$criteria == CRITERIA.RATE){ 
      # ヒット率が選択された場合
      getHitRatePerTag4Disp()
    }else{
      # 上記以外の場合
      countHitPerTag4Disp()
    }
  })
  
  # 表の縦幅を取得する
  getYlim <- reactive(function() {
    nComments <- countComments()
    if(input$criteria == CRITERIA.RATE){ 
      # ヒット率が選択された場合
      1
    }else{
      # 上記以外の場合
      if(0 < nComments){
        # コメントを取得できた場合
        nComments
      }else{
        # コメントを取得できなかった場合
        1
      }
    }
  })
  
  # 結果表示タイトル
  output$title <- reactiveText(function() {
    paste("Twitterタグ別の検索キーワードでのヒット率 (検索コメント数：",countComments(),"個)")
  })
  
  # 棒グラフ
  output$barplot <- reactivePlot(function() {
    barplot(getGraphData(),xlab = "Twitterタグ",ylab = "ヒット率",ylim = c(0,getYlim()))
  })
  
  # 表
  output$table <- reactiveTable(function() {
    data.frame(x = getTableData())
  })
  
})

ui.R

library(shiny)

# 画面処理
shinyUI(pageWithSidebar(
  
  # アプリ名
  headerPanel("Twitter関連タグ検索"),
  
  # 管理フォーム
  sidebarPanel(
    textInput("keyword", 
              "検索キーワード:",
              value="#Twitter"),
    selectInput("maxComments", 
                 "検索コメント数(最大):",
                choices = c(20,50,100,200,300,500,1000,1500)),
    numericInput("maxTags", 
                 "表示タグ数(最大):",
                 min = 1,
                 max = 100,
                 value = 7),
    radioButtons("criteria", "結果の表示基準:",
                 c("ヒット率" = CRITERIA.RATE,
                   "ヒット数" = CRITERIA.COUNT)),
    br(),
    submitButton("更新")
  ),
  
  # 表示フォーム
  mainPanel(
    h4(textOutput("title")), 
    br(),
    tabsetPanel(    
      tabPanel("棒グラフ", plotOutput("barplot")),
      tabPanel("表", tableOutput('table'))
    )
  )
))