下載rpivotTable輸出閃亮的Dasboard

Question

我試圖從我的dashboardUI中的rpivotTable保存數據。 我已經讀過 https://github.com/smartinsightsfromdata/rpivotTable/issues/62 並與ui.r和server.r 但是，當我RTY TI與儀表板使用的作品 - 這沒什麼。

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（「功能（配置）{Shiny.onInputChange（ 'MYDATA的'，的document.getElementById（ '結果'）的innerHTML）;}「）

我試圖改變 'myData的' 以納秒（ 'MYDATA的'），但沒有

print（class（input $ myData）） - 總是在控制檯中顯示[1]「NULL」，這意味着我沒有將數據傳遞給'myData'

也許有人知道如何解決這個問題？

p.s.在按下「in」後按鈕「下載」出現

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)