Lecture 8: shiny

準備

source("getFreqMtxDir.R")

library(manipulate)

前回の課題１

manipulateを利用して、頻度データ種類とTF-IDFの重み付けを選択可能にして、テキスト間の階層クラスタリングの結果を描画させなさい。

頻度データのオプション: raw, relative

Tf-Idf重み付けオプション: none(0), tf-idf1(1), tf-idf2(2)

使用データ：univフォルダのテキスト

距離行列オプション："euclidean",“canberra”,“manhattan”

クラスター手法：method=“ward”

結果出力イメージ

出力画面

manipulate({
    res <- getFreqMtxDir("../univ", rela = relative, tfidf = TFIDF)
    mtx <- t(res)
    hc <- hclust(dist(mtx, method = dist_method), method = "ward")
    plot(hc)
    rect.hclust(hc, k = clust_num, border = "red")
}, relative = checkbox(FALSE, "Relative Freq"), TFIDF = picker(0, 1, 2), dist_method = picker("euclidean", 
    "canberra", "manhattan"), clust_num = slider(2, 5))

shiny

shinyのインストール

install.packages("shiny")

shinyのロード

library(shiny)

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

テストui.R, server.R の作成

テストwww1アプリケーションの起動

runApp("www1")

wwwアプリケーションの終了: コンソールの右上"stop"ボタンを押す

練習１：前回の課題１をshinyで実装

作業フォルダの作成：www2

ui.Rの作成

shinyUI(bootstrapPage(

  # Application title
  headerPanel("前回の課題1"),

  # Sidebar
  sidebarPanel(
      #relative=checkbox(FALSE, "Relative Freq")
      checkboxInput(inputId = "relative",
                label = strong("Relative Freq"),
                value = FALSE),

      #TFIDF=picker(0,1,2)
      selectInput(inputId ="TFIDF", 
                  label = "Choose a TF-IDF option:", 
                  choices = c(0,1,2),
                  selected = 0),

      #dist_method=picker("euclidean","canberra","manhattan")
      selectInput(inputId ="dist_method", 
                  label = "Choose a distance method:", 
                  choices = c("euclidean","canberra","manhattan"),
                  selected = "canberra"),

      #clust_num=slider(2,5)
      sliderInput(inputId = "clust_num",
                  label = "Cluster num: ",
                  min = 2, max = 5, value = 2)
    ),

  # Show a plot of the generated distribution
  mainPanel(
    plotOutput("main_plot")
  )

))

server.R の作成

shinyServer(function(input, output) {

  output$main_plot <- renderPlot({

    res <- getFreqMtxDir("../univ", rela=input$relative, tfidf=input$TFIDF)
    mtx<-t(res) 
    hc <-hclust(dist(mtx, method=input$dist_method), method="ward")

    plot(hc) 
    rect.hclust(hc, k = input$clust_num, border = "red")
  })
})

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

runApp("www2")

wwwアプリケーションの終了: コンソールの右上"stop"ボタンを押す

考えて（苦しんで？）みましょう

練習２：前回の課題２をshinyで実装

前回の課題２

manipulateを利用して、頻度データを共通テキスト別に抽出し、単語間の階層クラスタリングの結果を描画させなさい。

共通テキストcommon_text: 4,5,6,7

使用データ：univフォルダのテキスト

距離行列オプション："euclidean",“canberra”,“manhattan”

クラスター手法オプション："ward",“complete”,“average”

manipulate({
    res <- getFreqMtxDir("../univ")
    mtx <- res[rownames(res) %in% names(df[df == common_text]), ]
    hc <- hclust(dist(mtx, method = dist_method), method = cluster_method)
    plot(hc)
}, common_text = slider(4, 7), dist_method = picker("euclidean", "canberra", 
    "manhattan"), cluster_method = picker("ward", "complete", "average"))

作業フォルダの作成：www3

ui.R, server.Rの作成: www2のファイルをコピーし, 適宜変更してください。

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

runApp("www3")

結果出力イメージ

出力画面

wwwアプリケーションの終了: コンソールの右上"stop"ボタンを押す

www2の拡張：rect.hclust(…)の制御

rect.hclust(hc, k = input$clust_num, border = “red”)

• コントローラーにクラスター枠描画チェックボックス(draw_rect)を追加

  ui.R(変更点)

  shinyUI(bootstrapPage(
  ....
  
  # Sidebar
  sidebarPanel(
    ....
    checkboxInput(inputId = "draw_rect",
                  label = strong("Draw Rectangles"),
                  value = FALSE),
  
    #clust_num=slider(2,5)
    ....
  ),
  
  ....
  ))
  

  server.R(変更点)

  if(input$draw_rect){
    rect.hclust(hc, k = input$clust_num, border = "red")
  }
  

• draw_rect “TRUE"のときに、clust_numスライダーを表示

  ui.R

  ui.R(変更点)

  shinyUI(bootstrapPage(
  ....
  
  # Sidebar
  sidebarPanel(
    ....
    #clust_num=slider(2,5)
    conditionalPanel(condition = "input.draw_rect == true", 
                     sliderInput(inputId = "clust_num",
                                 label = "Cluster num: ",
                                 min = 2, max = 5, value = 2))
    ....
  ),
  
  ....
  ))
  

  server.R(変更点なし)

• clust_numの上限をデータ依存に変更

ui.R(変更点)

shinyUI(bootstrapPage(
  ....

  # Sidebar
  sidebarPanel(
      ....
      conditionalPanel(condition = "input.draw_rect == true", 
                       uiOutput("cnumControls"))
      ....
    ),
  ....
))

server.R(変更点)

output$cnumControls <- renderUI({
    sliderInput("clust_num", "Cluster num: ", 
                min = 2, max = ncol(res)-2, value = 2, step=1)
  })

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

runApp("www2")

ui.Rの作成

shinyUI(bootstrapPage(

  # Application title
  headerPanel("前回の課題1"),

  # Sidebar
  sidebarPanel(
      #relative=checkbox(FALSE, "Relative Freq")
      checkboxInput(inputId = "relative",
                label = strong("Relative Freq"),
                value = FALSE),

      #TFIDF=picker(0,1,2)
      selectInput(inputId ="TFIDF", 
                  label = "Choose a TF-IDF option:", 
                  choices = c(0,1,2),
                  selected = 0),

      #dist_method=picker("euclidean","canberra","manhattan")
      selectInput(inputId ="dist_method", 
                  label = "Choose a distance method:", 
                  choices = c("euclidean","canberra","manhattan"),
                  selected = "canberra"),

      checkboxInput(inputId = "draw_rect",
                    label = strong("Draw Rectangles"),
                    value = FALSE),

      #clust_num=slider(2,5)
      #conditionalPanel(condition = "input.draw_rect == true", 
      #                 sliderInput(inputId = "clust_num",
      #                             label = "Cluster num: ",
      #                             min = 2, max = 5, value = 2))
      conditionalPanel(condition = "input.draw_rect == true", 
                       uiOutput("cnumControls"))
    ),

  # Show a plot of the generated distribution
  mainPanel(
    plotOutput("main_plot")
  )

))

server.R の作成

shinyServer(function(input, output) {

  output$cnumControls <- renderUI({
    sliderInput("clust_num", "Cluster num: ", 
                min = 2, max = ncol(res)-2, value = 2, step=1)
  })

  output$main_plot <- renderPlot({

    res <- getFreqMtxDir("../univ", rela=input$relative, tfidf=input$TFIDF) 
    mtx<-t(res) 
    hc <-hclust(dist(mtx, method=input$dist_method), method="ward")

    plot(hc) 

    if(input$draw_rect){
      rect.hclust(hc, k = input$clust_num, border = "red")
    }

  })
})

類似度計算表示

テキスト出力

• ui.R: verbatimTextOutput()
• server.R: renderPrint()

作業フォルダの作成：www4

ui.Rの作成

shinyUI(bootstrapPage(

  # Application title
  headerPanel("類似度計算"),

  # Sidebar
  sidebarPanel(

      selectInput(inputId ="simil_method", 
                  label = "Choose a similarity method:", 
                  choices = c("correlation","cosine"),
                  selected = "correlation")
    ),

  # Show a plot of the generated distribution
  mainPanel(
    verbatimTextOutput("main_plot")
  )

))

server.R の作成

shinyServer(function(input, output) {

  output$main_plot <- renderPrint({
    library(proxy)
    print(input$simil_method)
    res <- getFreqMtxDir("../univ")
    simil(t(res), method=input$simil_method)
  })

})

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

runApp("www4")

テーブル出力

• ui.R: tableOutput()
• server.R: renderTable()

ui.Rの作成

shinyUI(bootstrapPage(

  # Application title
  headerPanel("類似度計算"),

  # Sidebar
  sidebarPanel(

      selectInput(inputId ="simil_method", 
                  label = "Choose a similarity method:", 
                  choices = c("correlation","cosine"),
                  selected = "correlation")
    ),

  # Show a plot of the generated distribution
  mainPanel(
    verbatimTextOutput("main_plot")
  )

))

server.R の作成

shinyServer(function(input, output) {

  output$main_plot <- renderPrint({
    library(proxy)
    print(input$simil_method)
    res <- getFreqMtxDir("../univ")
    simil(t(res), method=input$simil_method)
  })

})

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

runApp("www5")

考えて（苦しんで？）みましょう

www5の拡張：TF-IDF値(type=1&2)のオプションを追加する

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

runApp("www6")

結果出力イメージ

出力画面

今日の課題

次回の授業までに、期末課題の作品の構想を練ってください。

次回授業時に、教えてください。

期末課題：shinyを利用して、簡単なテキスト処理・分析のプログラムをweb上で実行させる。