在闪亮的仪表板中下载 rpivotTable 输出

Question

我正在尝试从我的仪表板 UI 中的 rpivotTable 保存数据。我已经读过 https://github.com/smartinsightsfromdata/rpivotTable/issues/62 并与 ui.r 和 server.r 合作但是当我尝试将它与仪表板一起使用时 - 它什么都没有。

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)

我遇到了这个问题：

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

我试图将 'myData' 更改为 ns('myData') ，但什么也没有

print(class(input$myData)) - 在控制台中总是显示 [1] "NULL"，这意味着我没有将数据传递给 'myData'

也许有人知道如何解决这个问题？

p.s。按下 "in"

后出现按钮 "download"

Answer 1

你的代码中有很多额外的、不必要的东西（对于最小的可重现示例来说并不理想）。但是，我发现只要您始终在适当的时候使用 ns()，一切都会按预期工作，即使使用模块也是如此。与我所做的非模块化代码的最大偏差是使用 downloadHandler() 因为该答案不遵循最佳实践。

所以将原始解决方案（从 here）扩展到模块会给你这样的东西（注意在 jsCallback 函数中，你需要对两个 myData 和 pivot，因为它们都属于该模块）：

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)

在闪亮的仪表板中下载 rpivotTable 输出

download rpivotTable output in shiny Dasboard

javascript

r

rpivottable