/> 忍者ブログ

WEEKEND ECONOMIST

小さな工夫と発見の蓄積

Shinyアプリ・Outputの値へのアクセス・変数のスコープ

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

コメント

ただいまコメントを受けつけておりません。

Shinyアプリ・Outputの値へのアクセス・変数のスコープ

Shinyアプリで、ログディスプレイのようなもののあるページをつくろうと考えた。
画面上の操作に応じてテキストが徐々に追加されているような仕組みだが、思いの外難しかった。

模式的には、下の画像のようなものを想定している。入力フォームに記入してOKボタンを押すと、その文が画面に追加されていくという構造だ(コード)。



これが少し難しくなる理由は大きく2つある。
(1)outputに属する部品の値を取得することができない
(2)処理が関数や表現の内部で起こっているため、通常は変数は共有されない


まずはuiを作成する。入力フォーム、OKボタンと表示エリアだけの簡単な作りになっている。
library(shiny)
ui <- list(
   textInput('line', 'Type a line here.'),
   actionButton('insert', 'OK'),
   p(strong('Your sentenses will be displayed below')),
   verbatimTextOutput('display')        
)
次のようなserverを考える。OKボタンに反応するobserverを用意して、ボタンが押され時に、ディスプレイの文字列に入力された文字列を結合しようとしている。
ところが、起動してみると次のようなエラーが発生する:Reading objects from shinyoutput object not allowed. どうやら、直接outputの値にアクセスすることができない仕組みになっているらしい。
server1 <- function(input, output, session) {
    observeEvent(input$insert,
        { 
          output$display <- renderText({ 
              paste(output$display, input$line, sep='\n') 
          })
          updateTextInput(session, 'line', value='') 
        }
    )
}
runApp(list(ui=ui, server=server1))

そこで、今度は裏側に変数を用意して、そこにディスプレイと同じ文字列を格納しておくことを考える。次のようなserverになる。
今度はエラーは出ないが、ディスプレイに文字列が追加されていかず、その都度最新の値に置き換えられてしまう。原因は、observeEvent内で文字列Dの値を更新する際に、実はもとのDとは異なる文字列が生成されてしまっていて、その新しい変数のスコープが当該expression内に限られていることだ。そのため、新しく定義したDは毎回破棄され、もともとのDは手付かずのままになる。
server2 <- function(input, output, session) {
    D <- character(0)
    output$display <- renderText({ D })
    observeEvent(input$insert,
        { 
          D <- c(D, input$line)
          updateTextInput(session, 'line', value='') 
          output$display <- renderText({ paste(D, collapse='\n') })
        }
    )
}
runApp(list(ui=ui, server=server2))

スコープが問題、ということなので今度は文字列変数の代わりにR6クラスオブジェクトを作成し、そこにディスプレイの値を格納することを考える。R6クラスオブジェクトへの更新が参照扱いになることを利用するわけだ(参照:R6パッケージの解説)。
以下がその例で、これがうまくいく。Docクラスは、文字列変数をもつだけの単純なクラスでこれをServer処理のなかで定義する。observeEventからDへアクセスする際には、もとのオブジェクトを参照しているので、値の更新が保持される仕組みだ。

library(R6)
Doc <- R6Class('document',
    public=list(
    text = character(0),
    initialize = function(init=character(0)) 
        { self$text <- init }
    )
)

server3 <- function(input, output, session) {
    D <- Doc$new()  

    output$display <- renderText({ paste(D$text, collapse='\n') })
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
          output$display <- renderText({ paste(D$text, collapse='\n') })
        }
    )
}
runApp(list(ui=ui, server=server3))

上のコードで、renderText の処理が observeEvent 内にあるのは重要で、外側に配置してしまうと、ディスプレイの値が変化していかない。裏側でDオブジェクトの値は更新されるのだが、そのことをshinyの機能が認知しないため、いつまでたっても処理が開始されないのだ。下記がその例。
server4 <- function(input, output, session) {
    D <- Doc$new()  
    
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
          print(D$text)
        }
    )

    output$display <- renderText({ paste(D$text, collapse='\n') })
}
runApp(list(ui=ui, server=server4))

renderText を外に配置する方法として、処理内でOKボタンへ言及する方法がある。 すると、ボタンが押されるたびにそれに感応して処理が行われることになり、ディスプレイも更新される。 下はその例でうまく動くようだが、タイミングの定義が曖昧なようにも思える。 ふたつの処理がOKボタンに反応するようになっていて、どちらが先にくるかが明示されていない。observeEvent が優先される仕様なのか、単に運が良いだけなのかは分からない。
server5 <- function(input, output, session) {
    D <- Doc$new()  
    
    observeEvent(input$insert,
        { 
          D$text <- c(D$text, input$line)
          updateTextInput(session, 'line', value='') 
        }
    )

    output$display <- renderText({ 
        input$insert
        paste(D$text, collapse='\n') 
    })
}
runApp(list(ui=ui, server=server5)) 

つまり、R6クラスオブジェクトで値を管理することの弱点は、その値がShinyの監視下にないことだ。実は、Shinyに監視されるオブジェクトととして、reactivevalues クラスが定義されている。おそらく以下の書き方が一番 「shinyらしい」。
server6 <- function(input, output, session) {
    V <- reactiveValues(text = character(0))

    observeEvent(input$insert,
        { 
          V$text <- c(V$text, input$line)
          updateTextInput(session, 'line', value='') 
        }
    )

    output$display <- renderText({
        paste(V$text, collapse='\n') 
    })
}
runApp(list(ui=ui, server=server6)) 



コードの全体はこちら
PR

コメント

プロフィール

HN:
KM
性別:
非公開

カレンダー

03 2025/04 05
S M T W T F S
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30