Скачать rpivotTable выход в блестящей Dasboard

Question

Я пытаюсь сохранить данные из rpivotTable в моем dashboardUI. Я уже прочитал 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"

Может кто знает как это решить?

ps кнопка "скачать" появляется после нажатия "в"

Answer 1

В вашем коде много лишних, ненужных вещей (не идеально для минимального воспроизводимого примера). Тем не менее, я обнаружил, что, пока вы всегда используете ns() когда это уместно, все работает как положено, даже с модулями. Наибольшее отклонение от немодульного кода, которое я сделал, это использование downloadHandler() потому что этот ответ не следует передовым методам для этого.

Таким образом, расширение исходного решения ( отсюда) на модули дает вам что-то вроде этого (обратите внимание, что в jsCallback функция, вам нужно использовать ns() для обоих 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)