Shiny で文字を入力してボタンでUIに反映させるにはeventReactive

最近、仕事でShinyアプリケーションを作るようになったのですが、ちょこっとはまったのでメモ。 shiny の基本のキは分かってる人向けです。

Shiny での文字入力

まず、Shiny で文字入力してボタンを押すとUIに反映されるを実現するには r - Create a data frame using text input in Shiny - Stack Overflow にあるように ui.R と server.R を以下のように設定するとできます。

ui.R

library(shiny)    
shinyUI(
  pageWithSidebar(
    headerPanel("文字入力デモ")
    ,
    sidebarPanel(
        textInput('x', "Xの値を入力","")
        ,
        textInput('y', "Yの値を入力","")
        ,
        actionButton("submit", "実行")
    )
    ,
    mainPanel(uiOutput('table'))
  ))

server.R

library(shiny)
  shinyServer(
    function(input, output, session){
      
      Data = reactive({
        if (input$submit > 0) {
          df <- data.frame(x = input$x, y = input$y)
          return(list(df = df))
        }
      })
      
      output$table <- renderTable({
        if (is.null(Data())) {return()}
        print(Data()$df)
      }, 'include.rownames' = FALSE
      , 'include.colnames' = TRUE
      , 'sanitize.text.function' = function(x){x}
      )
      
    })

アプリ起動画面 f:id:songcunyouzai:20170917165112p:plain

ここで、テキスト入力のところに何か入れて実行ボタンを押すと、データフレームにそれが出力されます。

f:id:songcunyouzai:20170917165324p:plain

しかし

しかし、この状態ですと触ってみると分かるのですが文字入力のところをいじる度に、実行ボタンを押さなくてもリアルタイムで出力が変わっていきます。 f:id:songcunyouzai:20170917170225g:plain

このくらい小さい出力だとまだいいのですが、文字を入力して少し重たい(といっても5秒以内くらいがいいと思うのですが)処理をさせたいときに1文字変える度に実行されてたのではたまったものではありません。

原因は？

今回の原因はどこにあるのかというと、 server.R のテキスト入力のところ(5 〜10 行目)です。上の例だと

「実行ボタンが0でないときはずっと出力し続ける」

という処理になっています。最初に実行ボタンを押した時点で実行ボタンが0でない状態が保持し続けられるので、テキスト入力のところを変えるとリアルタイムで出力の命令が行くわけです。

解決策は？

要するに、実行ボタンが押されるまで出力の命令がいかなければいいのです。そんなときは、eventReactive が有用です。

そもそも Reactive は、チュートリアルの和訳にあるように「特定の箇所が変更されるまで命令を出さない」ようにするものですが、 eventReactibe は「特定のアクションが起こるまで命令を出さない」ものです。これを実行ボタンに適用してあげればいいのです。

以上を踏まえて、 server.R を変更すると以下のようになります。

server.R

  library(shiny)
  shinyServer(
    function(input, output, session){
      
      Data = eventReactive(input$submit, {
          df <- data.frame(x = input$x, y = input$y)
          return(list(df = df))
      })
      
      output$table <- renderTable({
        if (is.null(Data())) {return()}
        print(Data()$df)
      }, 'include.rownames' = FALSE
      , 'include.colnames' = TRUE
      , 'sanitize.text.function' = function(x){x}
      )
      
    })