input$outputID_select inside a Shiny Module

[saxodel]

Hello! First of all, a word to say thank you for this awesome package @ThomasSiegmund , I'm now using it for my projects.

But I'm having some troubles with the tables generated by d3tablefilter (_select, _edit, _filter) when they are inside a Shiny module (even when I call them from inside the module). I think it has to do with the namespace function and the output ID (since the final name is "input$" + "outputID" + "_table"...

Here is a reproducible example where the _select table is not updated when a new row is selected. Do you have any ideas how to make it work ?

# d3tabModule.R

d3tabUI <- function(id) {
  ns <- NS(id)

  tagList(
    column(d3tfOutput(ns('mtcars')), width = 8),
    column(tableOutput(ns("mtcarsSelect")), width = 4)
  )
}

d3tab <- function(input, output, session, data) {

  output$mtcars <- renderD3tf({

    tableProps <- list(
      btn_reset = TRUE,
      rows_counter = TRUE,  
      rows_counter_text = "Rows: ",
      sort = TRUE,
      on_keyup = TRUE,  
      on_keyup_delay = 800,
      sort_config = list(
        sort_types = c("Number", "Number")
      ),
      filters_row_index = 1,
      rows_always_visible = list(nrow(mtcars) + 2),
      col_operation = list( 
        id = list("frow_0_fcol_1_tbl_mtcars","frow_0_fcol_2_tbl_mtcars"),    
        col = list(1,2),    
        operation = list("mean","mean"),
        write_method = list("innerhtml",'innerhtml'),  
        exclude_row = list(nrow(mtcars) + 2),  
        decimal_precision = list(1, 1)
      )
    );

    footData <- data.frame(Rownames = "Mean", mpg = 0, cyl = 0);

    d3tf(mtcars[ , 1:2],
         enableTf = TRUE,
         tableProps = tableProps,
         showRowNames = TRUE, 
         selectableRows = "multi",
         selectableRowsClass = "info",
         tableStyle = "table table-bordered table-condensed",
         rowStyles = c(rep("", 7), rep("info", 7)),
         filterInput = TRUE,
         footData = footData,
         height = 500);
  })

  # for a output object "mtcars" tableFilter generates an input
  # "mtcars_edit". 
  output$mtcarsSelect <- renderTable({
    if(is.null(input$mtcars_select)) return(NULL);
    mtcars[input$mtcars_select, 1:2];
  })

}

# app.R

library(shiny)
library(htmlwidgets)
library(D3TableFilter)

source("d3tabModule.R")

ui <- fluidPage(
  d3tabUI("d3tab")
)

server <- function(input, output) {
  callModule(d3tab, "d3tab", data(mtcars))
}

shinyApp(ui = ui, server = server)

Thank you, cheers.

[ThomasSiegmund]

Hi,

thanks @saxodel for the nice comments.

I can't say that I have understood completely what's going on. I've fixed one bug in the D3TableFilter javascript preventing the select input from working in a module. Then I modified your example sligthly (see below.). In this version the observer in the server function works, but the reactive in the module doesn't work, even if it is listening to the same input. I guess I need to dig a bit deeper in shiny modules...

Best

# d3tabModule.R

d3tabUI <- function(id) {
  ns <- NS(id)

  tagList(
    column(d3tfOutput(ns('mtcars')), width = 8),
    column(tableOutput(ns("mtcarsSelect")), width = 4)
  )
}

d3tab <- function(input, output, session, data) {

  ns <- session$ns

  output$mtcars <- renderD3tf({

    tableProps <- list(
      btn_reset = TRUE,
      rows_counter = TRUE,  
      rows_counter_text = "Rows: ",
      sort = TRUE,
      on_keyup = TRUE,  
      on_keyup_delay = 800,
      sort_config = list(
        sort_types = c("Number", "Number")
      ),
      filters_row_index = 1,
      rows_always_visible = list(nrow(mtcars) + 2),
      col_operation = list( 
        id = list("frow_0_fcol_1_tbl_mtcars","frow_0_fcol_2_tbl_mtcars"),    
        col = list(1,2),    
        operation = list("mean","mean"),
        write_method = list("innerhtml",'innerhtml'),  
        exclude_row = list(nrow(mtcars) + 2),  
        decimal_precision = list(1, 1)
      )
    );

    footData <- data.frame(Rownames = "Mean", mpg = 0, cyl = 0);

    d3tf(mtcars[ , 1:2],
         enableTf = TRUE,
         tableProps = tableProps,
         showRowNames = TRUE, 
         selectableRows = "multi",
         selectableRowsClass = "info",
         tableStyle = "table table-bordered table-condensed",
         rowStyles = c(rep("", 7), rep("info", 7)),
         filterInput = TRUE,
         footData = footData,
         height = 500);
  })

  mtcarsInput <- reactive({
     inputID <- ns("mtcars_select")
     print("inputID in mtcarsInput ")
     print(inputID)
     print(input[[inputID]])
     if(is.null(input[[inputID]])) return(NULL)
     return(input[[inputID]]) 
    })

  # for a output object "mtcars" tableFilter generates an input
  # "mtcars_edit". 
  output$mtcarsSelect <- renderTable({
     if (is.null(mtcarsInput())) return(invisible());
     mtcarsInput()[ , 1:2];
  })
}

# app.R

library(shiny)
library(htmlwidgets)
library(D3TableFilter)

source("d3tabModule.R")

ui <- fluidPage(
  d3tabUI("d3tab")
)

server <- function(input, output) {

  observe({
    print("d3tab-mtcars_select in server")
    print(input[['d3tab-mtcars_select']])
  })

  callModule(d3tab, "d3tab", data(mtcars))
}

shinyApp(ui = ui, server = server)