Issue in action button

Question

The code below has action button in rendered in html. But when i click the button in second row(id as "ang") there is no modal box showing up. Can anyone help me? Not sure why this logic is not working.. If I put a normal button, it is working

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"))
  )
)

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


server <- function(input, output) {
  
  number_compare$X2[which(rownames(number_compare) == 2)] = paste(with(number_compare, X2[rownames(number_compare) == 2])," ", as.character(actionButton("ang","")))
  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")))
  number_compare$X2[which(rownames(number_compare) == 6)] = paste(with(number_compare, X2[rownames(number_compare) == 6])," ", as.character(actionButton("angle3","", icon("angle-up"),style = "border: none;
                                                                                                                                                         outline:none;background:white")))
 
 
 
  
  output$example_table <- DT::renderDT({
    datatable(
      number_compare,
      escape = FALSE)
   
    
    })
 
  observeEvent(input$ang,{
   
    showModal(modalDialog(
      title = "Somewhat important message",
      "This is a somewhat important message.",
      easyClose = TRUE,
      footer = NULL
    ))
    })
 
  
  
}

shinyApp(ui, server)

I got the solution with below code . Just a small change I did. If i change the input date and click on arrow, it not popping up. Not sure what mistake I am making (Basicall, if I click "sam" button twice, the arrow is not popping up modal box when it is clicked

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",""))))
  # 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)

For that to work you need to use javascript code. Please adapt the solution from here: https://stackoverflow.com/questions/42489740/r-shiny-click-button-within-datatable-to-display-popup-twice-in-a-row — YBS, Sep 18 '20 at 16:40

score 2 · Accepted Answer · answered Sep 18 '20 at 20:07

2

You have to bind:

  output$example_table <- DT::renderDT({
    datatable(
      number_compare,
      escape = FALSE, 
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })

answered Sep 18 '20 at 20:07

Stéphane Laurent

75,186
15
119
225

Thanks . Working But I did a small change. I have a edited my question. Seems not working. Could you please help – Vinod P Sep 21 '20 at 08:46
Hi Stephane. Did you get a chance to see my change :) – Vinod P Sep 21 '20 at 14:52

Issue in action button

1 Answers1

Linked