[英]Shiny - dynamically generated inputs
在我的 shiny 代码中,我正在动态生成输入,并且我试图通过这些输入中的任何更改来触发 observe()。
我发现这个链接Shiny - 由动态生成的输入触发的观察()非常有用,但不适用于所有类型的输入。 我在链接额外输入的代码中添加了代码:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
),
dashboardBody(
tags$script("$(document).on('change', '.dynamicSI select', function () {
Shiny.onInputChange('lastSelectId',this.id);
// to report changes on the same selectInput
Shiny.onInputChange('lastSelect', Math.random());
});"),
numericInput("graph_tytle_num","Number of Graph Title elements",value = 1,min = 1,max = 10),
uiOutput("graph_title"),
plotOutput("plot")
)
)
server <- function(input, output, session) {
#elements of graphic titles
output$graph_title <- renderUI({
buttons <- as.list(1:input$graph_tytle_num)
# use a div with class = "dynamicSI" to distinguish from other selectInput's
div( class = "dynamicSI",
lapply(buttons, function(i)
column(3,
selectInput(inputId = paste0("title1_element",i),
label = paste("Title element",i),
choices = paste0(LETTERS[i],seq(1,i*2)),
selected = 1),
radioButtons(inputId = paste0("title2_element",i),
label = paste("Title1 element",i),
choices = c("Yes","No"),
selected = "Yes"),
numericInput(inputId = paste0("title3_element",i),
label = paste("Title element",i),value=1),
dateInput(inputId = paste0("title4_element",i),
label = paste("Title element",i),
value="1900-01-01")
)
)
)
})
# react to changes in dynamically generated selectInput's
observe({
input$lastSelect
if (!is.null(input$lastSelectId)) {
cat("lastSelectId:", input$lastSelectId, "\n")
cat("Selection:", input[[input$lastSelectId]], "\n\n")
}
isolate({ #I dont want to have the numericInput input$graph_tytle_num to be a trigger
#Create the graph title
title <- c()
for(i in 1:input[["graph_tytle_num"]]){
title <- paste(title,input[[paste0("title1_element",i)]],input[[paste0("title2_element",i)]],
input[[paste0("title3_element",i)]],input[[paste0("title4_element",i)]])
}
output$plot <-renderPlot({hist(rnorm(100,4,1),
breaks = 10,
main = title)})
})
})
}
shinyApp(ui, server)
如果我将 JS 部分中的 '.dynamicSI select' 替换为 '.dynamicSI:input' 那么我会得到一个错误
如果我从代码中删除 dateInput 并在 JS 中进行更改,则观察将由 selectInput 和 numericInput 但不是单选按钮触发。
我怎样才能让我的观察被所有人触发?
谢谢
获取inputId
的方式取决于小部件的类型。
您可以进行如下操作。
div(class = "dynamicSI",
lapply(buttons, function(i)
column(
width = 3,
div(class = "selector",
selectInput(inputId = paste0("title1_element",i),
label = paste("Title element",i),
choices = paste0(LETTERS[i],seq(1,i*2)),
selected = 1)
),
div(class = "radio",
radioButtons(inputId = paste0("title2_element",i),
label = paste("Title1 element",i),
choices = c("Yes","No"),
selected = "Yes")
),
div(class = "input",
numericInput(inputId = paste0("title3_element",i),
label = paste("Title element",i),value=1)
),
div(class = "date",
dateInput(inputId = paste0("title4_element",i),
label = paste("Title element",i),
value = "1900-01-01")
)
)
)
)
在 JavaScript 中,您可以使用Shiny.setInputValue
和选项{priority: 'event'}
。 这取代了Shiny.onInputChange
而无需使用Math.random()
的“技巧”。
js <- "
$(document).on('change', '.dynamicSI .selector select', function(){
Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .radio input', function(){
Shiny.setInputValue('lastSelectId', $(this).attr('name'), {priority: 'event'});
});
$(document).on('change', '.dynamicSI .input input', function(){
Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .date input', function(){
Shiny.setInputValue('lastSelectId', $(this).parent().attr('id'), {priority: 'event'});
});
"
另外,在server
中,不要使用observe
和isolate
,最好使用observeEvent
。
完整的应用程序:
library(shiny)
library(shinydashboard)
js <- "
$(document).on('change', '.dynamicSI .selector select', function(){
Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .radio input', function(){
Shiny.setInputValue('lastSelectId', $(this).attr('name'), {priority: 'event'});
});
$(document).on('change', '.dynamicSI .input input', function(){
Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .date input', function(){
Shiny.setInputValue('lastSelectId', $(this).parent().attr('id'), {priority: 'event'});
});
"
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(),
dashboardBody(
tags$head(tags$script(HTML(js))),
numericInput("graph_tytle_num", "Number of Graph Title elements",
value = 1, min = 1, max = 10),
uiOutput("graph_title"),
plotOutput("plot")
)
)
server <- function(input, output, session) {
#elements of graphic titles
output$graph_title <- renderUI({
buttons <- as.list(1:input$graph_tytle_num)
div(class = "dynamicSI",
lapply(buttons, function(i)
column(
width = 3,
div(class = "selector",
selectInput(inputId = paste0("title1_element",i),
label = paste("Title element",i),
choices = paste0(LETTERS[i],seq(1,i*2)),
selected = 1)
),
div(class = "radio",
radioButtons(inputId = paste0("title2_element",i),
label = paste("Title1 element",i),
choices = c("Yes","No"),
selected = "Yes")
),
div(class = "input",
numericInput(inputId = paste0("title3_element",i),
label = paste("Title element",i),value=1)
),
div(class = "date",
dateInput(inputId = paste0("title4_element",i),
label = paste("Title element",i),
value = "1900-01-01")
)
)
)
)
})
# react to changes in dynamically generated selectInput's
observeEvent(input$lastSelectId, {
cat("lastSelectId:", input$lastSelectId, "\n")
cat("Selection:", input[[input$lastSelectId]], "\n\n")
title <- c()
for(i in 1:input[["graph_tytle_num"]]){
title <- paste(title,input[[paste0("title1_element",i)]],input[[paste0("title2_element",i)]],
input[[paste0("title3_element",i)]],input[[paste0("title4_element",i)]])
}
output$plot <-renderPlot({hist(rnorm(100,4,1),
breaks = 10,
main = title)})
})
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.