download rpivotTable output in shiny Dasboard

Question

I'm trying to save data from rpivotTable in my dashboardUI. I already read https://github.com/smartinsightsfromdata/rpivotTable/issues/62 and in works with ui.r and server.r But when I try to use this with dashboard - it's nothing .

dashboard.r

# install.packages("devtools")
#devtools::install_github("smartinsightsfromdata/rpivotTable",ref="master") 

options(java.parameters = "-Xmx8000m")

library(shiny)
library(shinyjs)
library(shinydashboard)
library(highcharter)
library(xts)
library(htmlwidgets)
library(rpivotTable)
library(xml2)
library(rvest)

sotrud <- c("1","2")

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

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("log", tabName = "login", icon = icon("user")),
    menuItem("test", tabName = "ost", icon = icon("desktop"))
  )
)

body <- dashboardBody(
tabItems(
  tabItem(tabName = "login",
          tabPanel("log", 
                   useShinyjs(), # Set up shinyjs
                   br(),
                   selectInput(inputId=ns("sel_log"), label = h5("log"), 
                               choices= c(unique(as.character(sotrud))) 
                               , selected = NULL),
                   tags$form( passwordInput(inputId=ns("pass"), label = 
h3("int psw"), value = "000")),

                   fluidRow(
                     br(),
                     column(8,actionButton(ns("psw"), "in") 
                     )

                   )

          )
  ),
  tabItem(tabName = "ost",
          tabPanel("test",
                   fluidRow(


                     column(3,
                             h4(" "),
                             conditionalPanel(
                               condition = paste0("input['", ns("psw"), "'] > '0' "), 
                               actionButton(ns("save"), "download") )
                     )

                     ,br()
                     ,br()

                   )


          )
          ,DT::dataTableOutput(ns('aSummaryTable'))
          ,rpivotTableOutput(ns('RESULTS'))
          ,column(6,
                  tableOutput(ns('myData')))

  )
))


 # Put them together into a dashboardPage
 dashboardPage(
 dashboardHeader(title = "1"),
 sidebar,
 body
 )

 }

 dashboard <- function(input, output, session) {


  observe({    ## will 'observe' the button press

   if(input$save){ 
   print("here")  ## for debugging
   print(class(input$myData))
   }
    })


  # Make some sample data
  qbdata <- reactive({
  expand.grid(LETTERS,1:3)
  })

  # # Clean the html and store as reactive
    # summarydf <- eventReactive(input$myData,{
    #   print("here")
    #   
    #   input$myData %>% 
    #     read_html %>% 
    #     html_table(fill = TRUE) %>% 
    #     # Turns out there are two tables in an rpivotTable, we want the             
     second
    #     .[[2]]
    #   
    # })



      # # show df as DT::datatable
      # output$aSummaryTable <- DT::renderDataTable({
      #   datatable(summarydf(), rownames = FALSE)
      # })

      # Whenever the config is refreshed, call back with the content of the         table
      output$RESULTS <- renderRpivotTable({
        rpivotTable(
          qbdata(),
          onRefresh = 
            htmlwidgets::JS("function(config) {Shiny.onInputChange('myData',         document.getElementById('RESULTS').innerHTML);}")
        )
      })




    } 

app.r

source("dashboard.R")


ui <- 
  dashboardUI("dash")



server <- function(input, output, session) {
  df2 <- callModule(dashboard, "dash")


  }

  shinyApp(ui, server)

I fell problem with this:

htmlwidgets::JS("function(config) {Shiny.onInputChange('myData',  document.getElementById('RESULTS').innerHTML);}")

I tried to change 'myData' to ns('myData') , but nothing

print(class(input$myData)) - always shows [1] "NULL" in console, that's mean I didn't pass data to 'myData'

Maybe someone know how to resolve this?

p.s. button "download" appears after pushing "in"

Answer 1

You have a lot of extra, unnecessary stuff in your code (not ideal for a minimal reproducible example). However, I've found that as long as you always use ns() when appropriate, everything works as expected, even with modules. The largest deviation from the non-modular code I've made is using a downloadHandler() because that answer doesn't follow best practices for that.

So extending the original solution (from here) to modules gives you something like this (notice that in the jsCallback function, you need to use ns() for both myData and the pivot, as they both belong to that module):

library(shiny)
library(shinyjs)
library(shinydashboard)
library(highcharter)
library(xts)
library(htmlwidgets)
library(rpivotTable)
library(xml2)
library(rvest)

options(shiny.launch.browser=F, shiny.minified=F, shiny.port = 6245)
sotrud <- c("1","2")

dashboardUI <- function(id) {
  ns <- NS(id)
  dashboardPage(
    dashboardHeader(), 
    dashboardSidebar(), 
    dashboardBody(
      useShinyjs(),
      tableOutput(ns('tbl')),
      downloadButton(ns('save')),
      rpivotTableOutput(ns('pivot'))
    )
  )
}

dashboard <- function(input, output, session) {
  output$pivot <- renderRpivotTable({
    jsCallback <- paste0("function(config) {",
      "Shiny.onInputChange('",
      session$ns("myData"), "',",
      "document.getElementById('", session$ns("pivot"), "').innerHTML);}")
    rpivotTable(
      expand.grid(LETTERS, 1:3),
      onRefresh = htmlwidgets::JS(jsCallback)
    )
  })
  summarydf <- eventReactive(input$myData, {
    input$myData %>%
      read_html %>%
      html_table(fill = TRUE) %>%
      .[[2]]
  }, ignoreInit = TRUE)

  output$tbl <- renderTable({ summarydf() })

  output$save <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      req(summarydf())
      write.csv(summarydf(), file)
    }
  )
} 

ui <- dashboardUI("dash")
server <- function(input, output, session) { callModule(dashboard, "dash") }
shinyApp(ui, server)