[英]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.