问题
In my shiny code i am generating inputs dynamically and i am trying to make the observe() to be triggered by any change in those inputs.
I found this link Shiny - observe() triggered by dynamicaly generated inputs which was very useful but didn't work with all kind of inputs. I added to the code in the link extra inputs That's the code:
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)
If i replace '.dynamicSI select' in the JS part with '.dynamicSI :input' then i will get an error
If i remove the dateInput from the code and make the change in the JS then the observe will be triggered by selectInput and numericInput but not radioButtons.
How can i make my observe triggered by all of them?
Thanks
回答1:
The way to get the inputId
depends on the type of widget.
You can proceed as follows.
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")
)
)
)
)
In JavaScript, you can use Shiny.setInputValue
with the option {priority: 'event'}
. This replaces Shiny.onInputChange
without need of the "trick" with 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'});
});
"
In addition, in server
, instead of using observe
with isolate
, it is better to use observeEvent
.
The full app:
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)
来源:https://stackoverflow.com/questions/61475419/shiny-dynamically-generated-inputs