下载rpivotTable输出闪亮的Dasboard
我试图从我的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）;}”）
我试图将'myData'改为ns（'myData'），但没有任何结果
print（class（input $ myData）） - 总是在控制台中显示[1]“NULL”，这意味着我没有将数据传递给'myData'
也许有人知道如何解决这个问题？
按下“in”后ps按钮“下载”
你的代码中有很多额外的，不必要的东西（对于一个最小可重现的例子来说并不理想）。 然而，我发现只要你在适当的时候总是使用ns() ，一切都按预期工作，即使对于模块也是如此。 与我所做非模块化代码的最大偏差是使用downloadHandler()因为该答案不符合最佳实践。
因此，将原始解决方案（从这里）扩展到模块会给你类似的东西（请注意，在jsCallback函数中，你需要对myData和pivot都使用ns() ，因为它们都属于该模块）：
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)