Question

我试图在我的dashboardUI中保存来自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);}")

我试图改变我的数据＆＃39; ns（＆＃39; myData＆＃39;），但没有

print(class(input$myData)) - 始终显示[1]＆＃34; NULL＆＃34;在控制台中，这意味着我没有将数据传递给我的数据＆＃39;

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

P.S。按钮＆＃34;下载＆＃34;按＆＃34;＆＃34;

后出现

Answer 1

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

因此，将原始解决方案（从here）扩展到模块会为您提供类似的结果（请注意，在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)

在闪亮的Dasboard

1 个答案: