/>
小さな工夫と発見の蓄積
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
ただいまコメントを受けつけておりません。
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))
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))
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))
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))
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))