Question

这是一个很好的答案here的后续问题。

我想在这个闪亮的应用程序中包含一个参数化的HTML报告，其中包括每一行的弹出窗口。在下面的代码中，您可以找到可复制的示例。您必须有两个文件：app.R和htmlreport.Rmd。

我回答了这个问题，并添加了一个下载HTML报告的选项。

问题是：如何在HTML报告中也有弹出窗口？

app.R：

library(DT)
library(shiny)
library(shinyBS)
library(shinyjs)
library(shinydashboard)

# This function will create the buttons for the datatable, they will be unique
shinyInput <- function(FUN, len, id, ...) {inputs <- character(len)
for (i in seq_len(len)) {
  inputs[i] <- as.character(FUN(paste0(id, i), ...))}
inputs
}

ui <- dashboardPage(
  dashboardHeader(title = "Simple App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Menu Item 1", tabName = "one", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "one",h2("Datatable Modal Popup"),
              DT::dataTableOutput('my_table'),uiOutput("popup")
      )
    ),
    downloadButton("downloadhtml", "HTML report")
  )
)

server <- function(input, output, session) {
  my_data <- reactive({
    testdata <- mtcars
    as.data.frame(cbind(View = shinyInput(actionButton, nrow(testdata),'button_', label = "View", onclick = 'Shiny.onInputChange(\"select_button\",  this.id)' ),testdata))
  })  
  output$my_table <- DT::renderDataTable(my_data(),selection = 'single',options = list(searching = FALSE,pageLength = 10),server = FALSE, escape = FALSE,rownames= FALSE)

  # Here I created a reactive to save which row was clicked which can be stored for further analysis
  SelectedRow <- eventReactive(input$select_button,{
    as.numeric(strsplit(input$select_button, "_")[[1]][2])
  })

  # This is needed so that the button is clicked once for modal to show, a bug reported here
  # https://github.com/ebailey78/shinyBS/issues/57
  observeEvent(input$select_button, {
    toggleModal(session, "modalExample", "open")
  })

  DataRow <- eventReactive(input$select_button,{
    my_data()[SelectedRow(),2:ncol(my_data())]
  })

  output$popup <- renderUI({
    bsModal("modalExample", paste0("Data for Row Number: ",SelectedRow()), "", size = "large",
            column(12,                   
                   DT::renderDataTable(DataRow())

            )
    )
  })

  output$downloadhtml <- downloadHandler(

    filename = "report.html",
    content = function(file) {
      # Copy the report file to a temporary directory before processing it, in
      # case we don't have write permissions to the current working dir (which
      # can happen when deployed).

      tempReport <- file.path(tempdir(), "htmlreport.Rmd")
      file.copy("htmlreport.Rmd", tempReport, overwrite = TRUE)


      # Set up parameters to pass to Rmd document
      params <- list(data = my_data())

      # Knit the document, passing in the `params` list, and eval it in a
      # child of the global environment (this isolates the code in the document
      # from the code in this app).
      rmarkdown::render(tempReport, output_file = file,
                        params = params,
                        envir = new.env(parent = globalenv())
      )
    }
  )


}

shinyApp(ui, server)

htmlreport.Rmd：

---
title: "Untitled"
output: html_document
params:
  data: NA
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

# Data

```{r}
DT::datatable(params$data,selection = 'single',options = list(searching = FALSE,pageLength = 10), escape = FALSE,rownames= FALSE)
```

参数化HTML报告RMarkdown中的弹出窗口

0 个答案: