R Shiny - наблюдаем () Ввод даты также запускается, когда значение dataInput не изменяется - PullRequest
1 голос
/ 29 апреля 2020

У меня есть блестящий код, который генерирует входы, и каждый из этих входов запускает наблюдение, когда значение изменяется, однако это не происходит в dateInput, dateInput срабатывает перед наблюдением.

Я хочу, чтобы dateInput срабатывал только при изменении значения даты.

Вот код

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)

Спасибо за помощь. Высоко ценится

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...