单击时发出操作按钮

Question

在下面的应用程序中，当我单击操作按钮（“sam”）时，会出现 table。现在，当您单击第二列上的小箭头时，会弹出一个模式框。很好。

现在，当您更改日期并单击按钮时，table 会刷新。现在，当您单击箭头时，不会弹出任何内容。不知道为什么？

library(shiny)
library(shinydashboard)
library(DT)

number_compare <- data.frame(replicate(2, sample(1:100, 10, rep=TRUE)))
# number_compare$direction <- ifelse(
#   number_compare$X1 < number_compare$X2,
#   as.character(icon("angle-up")),
#   as.character(icon("angle-down"))
# )

sidebar <- dashboardSidebar()

body <- dashboardBody(
  fluidRow(box(width = 12, solidHeader = TRUE,
               DTOutput("example_table"),
               actionButton("sam","sam"),
               dateInput("da","Date", value = Sys.Date(), min = Sys.Date()-1, max = Sys.Date()+1))
  )
)

ui <- dashboardPage(dashboardHeader(title = "Example"),
                    sidebar,
                    body
)


server <- function(input, output) {
  
  number_compare$X2 <- paste("sd",number_compare$X2)
  
  number_compare$X2[which(rownames(number_compare) == 2)] = paste(with(number_compare, X2[rownames(number_compare) == 2])," ", " ",as.character(actionLink(inputId="ang", label="", icon("caret-up"))))
  
  print(paste(with(number_compare, X2[rownames(number_compare) == 2])," ", as.character(actionButton("ang",""))))
  print("Vinay")
  # number_compare$X2[which(rownames(number_compare) == 4)] = paste(with(number_compare, X2[rownames(number_compare) == 4])," ", as.character(actionButton("angle2","", icon("angle-up"),style = "border: none;
  #   outline:none;background:white")))
  
  
  
  observeEvent(input$sam,{
    if(input$da == Sys.Date()){
      output$example_table <- DT::renderDT({
        datatable(
          number_compare[c(2,3:4),],
          escape = FALSE
          ,options=list(preDrawCallback=JS(
            'function() {
     Shiny.unbindAll(this.api().table().node());}'),
            drawCallback= JS(
              'function(settings) {
       Shiny.bindAll(this.api().table().node());}')))
      })
    }
    else {
      output$example_table <- DT::renderDT({
        datatable(
          number_compare[c(2,5:10),],
          escape = FALSE
          ,options=list(preDrawCallback=JS(
            'function() {
     Shiny.unbindAll(this.api().table().node());}'),
            drawCallback= JS(
              'function(settings) {
       Shiny.bindAll(this.api().table().node());}')))
      })
    }
  })
  
  # tolisten <- reactive({
  #   list(input$ang, input$da)
  # })
  observeEvent(input$ang,{
    if(!is.null(input$da))
    {
      print("clicked")
      showModal(modalDialog(
        title = "dsd"
      ))
    }
  })
  
  
  
}

shinyApp(ui, server)

Answer 1

我觉得你需要解绑

body <- dashboardBody(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  fluidRow(......

并在 server 中：

server <- function(input, output, session) { # add the 'session' argument

  ......

  observeEvent(input$sam, {
    session$sendCustomMessage("unbindDT", "example_table")
    if(input$da == Sys.Date()){
    ......

单击时发出操作按钮

Issue in action button when clicked

r

shiny

dt