How to use shiny action button in DataTable through shiny module?

I have successfully implemented action button inside DataTable of shinyApp.However, it only works without module. implementing it through shiny module doesn't give any response.

I wonder, What are the changes required while implementing action button inside DataTable through shiny module ??

PS: same I also posted on stackoverflow

App without module

library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable
  ui <- fluidPage(
    fluidRow(
      DT::dataTableOutput(outputId = "my_data_table"),
      textOutput(outputId = "myText")  
    )
  )
  
  
  server <- function(input, output) {
    
    myValue <- reactiveValues(check = '')
    
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- character(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), ...))
      }
      inputs
    }
    
    
    my_data_table <- reactive({
      tibble::tibble(
        Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
        Motivation = c(62, 73, 3, 99, 52),
        Actions = shinyInput(actionButton, 5,
                             'button_',
                             label = "Fire",
                             onclick = paste0('Shiny.onInputChange( \"select_button\" , this.id)') 
        )    
      )
    })
    
    output$my_data_table <- renderDataTable({
      my_data_table()
    }, escape = FALSE)
    
    
    observeEvent(input$select_button, {
      selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
      myValue$check <<- paste('click on ',my_data_table()[selectedRow,1])
    })
    
    
    output$myText <- renderText({
      myValue$check
    })
    
    
  }

  shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:4652

Created on 2019-09-17 by the reprex package (v0.3.0)

App with module

library(shiny)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable


## module UI
test_data_table_ui  <- function(id){
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(outputId = ns("my_data_table")),
    textOutput(outputId = ns("my_text"))  
  )
  
}
  
## module server
test_data_table_server <- function(input, output, session ){
  ns = session$ns
  
  myValue <- reactiveValues(check = '')
  
  shinyInput <- function(FUN, len, id, ns, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  
  my_data_table <- reactive({
    tibble::tibble(
      Name = c('Dilbert', 'Alice', 'Wally', 'Ashok', 'Dogbert'),
      Motivation = c(62, 73, 3, 99, 52),
      Actions = shinyInput(actionButton, 5,
                           'button_',
                           label = "Fire",
                           onclick = paste0('Shiny.onInputChange(' , ns("select_button"), ', this.id)')
      )
    )
  })
  
  output$my_data_table <- DT::renderDataTable({
    return(my_data_table())
  }, escape = FALSE)
  
  
  observeEvent(input$select_button, {
    print(input$select_button)
    selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    myValue$check <<- paste('click on ',my_data_table()[selectedRow,1])
  })


  output$my_text <- renderText({
    myValue$check
  })
  
  
}


ui <- fluidPage(
  test_data_table_ui(id = "test_dt_inside_module")
)

server <- function(input, output, session) {
  callModule(module = test_data_table_server , id = "test_dt_inside_module")
}

shinyApp(ui, server)
#> 
#> Listening on http://127.0.0.1:7583

Created on 2019-09-17 by the reprex package (v0.3.0)

1 Like

Hi @cparsania. You miss a pair of double quote in the onclick argument.

      Actions = shinyInput(actionButton, 5,
                           'button_',
                           label = "Fire",
                           onclick = paste0('Shiny.onInputChange(\"' , ns("select_button"), '\", this.id)')
      )
3 Likes

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.