/> 忍者ブログ

WEEKEND ECONOMIST

小さな工夫と発見の蓄積

Shiny: Output UI のループ

×

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

コメント

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

Shiny: Output UI のループ

同じようなUIがたくさんあって、処理にも法則性がある場合に、UIのループを作成したくなることがある。
たとえば、グラフが10個あって、それぞれに対応するパラメータを選択するUIがあるとする。
グラフのIDが "fig1", "fig2", ..., パラメータUIのIDが "para1", "para2", ... と定義されているなら、同じコードを10回記述せずにループを利用した簡略なコードを書きたくなる。

Shinyでこれをするのは少し難しい。理由は、Shinyは常に変数の更新を監視し、結果を反映し続けているので、注意してコードを書かないと、ループ変数の更新を思わぬ形で反映して、バグが生じてしまうからだ。


例として、3つのテキスト入力フォーム("text1", "text2", "text3")と テキスト出力("out1", "out2", "out3")をもつアプリを考える。 text1 の内容は out1に、 text2はout2に、・・・というように表示させたい(コード)。


UI部分はシンプルだ。
library(shiny)

ui <- list(
    textInput('text1', 'Text 1', value=''),
    textInput('text2', 'Text 2', value=''),
    textInput('text3', 'Text 3', value=''),
    hr(),
    textOutput('out1'),
    textOutput('out2'),
    textOutput('out3')
)

単純な方法は3つの対応関係をすべて書きくだすこと。これで良いのだけど、汎用性がない。
server1 <- function(input, output) {
    output$out1 <- renderText({ input$text1 })
    output$out2 <- renderText({ input$text2 })
    output$out3 <- renderText({ input$text3 })    
}
runApp(list(ui=ui, server=server1))

単純なループはうまくいかない。下の例だと、renderText内の命令を実行するする際に、最新の i の値が使われてしまう。そのため、すべての出力がtext3(最後の値なので)を参照するようになる。 また、 "i <- 1" をアンコメントすると、すべてtext1を参照するようになる。
server2 <- function(input, output) {
    for (i in 1:3) {
        output[[paste('out', i, sep='')]] <- renderText({
            input[[paste('text', i, sep='')]]
        })
    }
    #i <- 1
}
runApp(list(ui=ui, server=server2))

つまり、 i のスコープが広すぎて、意図しないところまで値を探しにいってしまうのがバグの原因になっている。これを回避する1つの方法は、 lapply を利用して、 i のスコープを限定することだ。以下の例はうまくいく。
server3 <- function(input, output) {
    lapply(1:3, 
        function(i) { 
            output[[paste('out', i, sep='')]] <- renderText({ 
                input[[paste('text', i, sep='')]] 
            }) 
        }
    )
}
runApp(list(ui=ui, server=server3))



もしくは、local関数を利用して、その中で新しい変数をコピーすることで、外部での更新の影響を遮断する方法もある。
server4 <- function(input, output) {
    for (i in 1:3) { local({
        j <- i
        output[[paste('out', j, sep='')]] <- renderText({
            input[[paste('text', j, sep='')]]
        })
    }) }
}
runApp(list(ui=ui, server=server4))

全コードはこちら。 参考:Stack Overflow
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