r - R Shiny Dynamic Report Download

Question

I have made a dynamic report visually in an r shiny app using renderui. I would like to be able to download this dynamic report but not sure how to correctly create it assuming I am unable to convert a render ui into an html file.

What is the best way to write a dynamic html file that can be displayed in the ui? and then download it?

Below is a minimal reproducible project. The download button is currently just for show.

library(shiny)
library(shinydashboard)
library(dplyr)
library(stringr)
library(DBI)
library(DT)
library(shinycssloaders)
library(lubridate)
library(tidyr)
library(ggplot2)
library(plotly)
library(scales)


ui <- dashboardPage(
  
  dashboardHeader(title = "Key Performance Indicators", titleWidth =300),
  
  dashboardSidebar(width = 300,
                   
                   sidebarMenu(
                     menuItem("User Guide", tabName = "userguide", icon = icon("question-circle")),
                     menuItem("Dashboard", tabName = "dashboard", icon = icon("chart-line"), selected = TRUE)
                   ),
                   
                   selectizeInput(inputId="goals",
                                  label="Goal:",
                                  choices= c("Asset Management"
                                  ),
                                  selected= "Asset Management",
                                  multiple = FALSE),
                   
                   uiOutput("kpis")
                   
  ),
  dashboardBody(
    
    tabItems(
      tabItem(
        tabName = "userguide",
        
        fluidRow(column(width =  12,
                        tabBox(width = NULL,
                               tabPanel("User Guide",
                                        
                                        h3("General"),
                                        h5("")
                               )
                        )
        )
        
        
        )
      ),
      tabItem(
        tabName = "dashboard",
        
        fluidRow(column(width =  12,
                        tabBox(width = NULL,
                               
                               tabPanel("Plot",
                                        plotlyOutput("plot", height = 550) %>%
                                          withSpinner(color="#1b6d96")),
                               
                               tabPanel("Report",
                                        uiOutput("report") %>%
                                          withSpinner(color="#1b6d96")
                               )
                               
                               
                        )
        )
        )
      )
    )
    
  )
)

server <- function(input, output) {
  
  rawTable <- reactive({
    
    df <- data.frame(KPI =c("Money Spent"),
                     measure = c("Dollars"),
                     FY2015= c(500), 
                     FY2016= c(100),
                     FY2017= c(250),
                     FY2018= c(600), 
                     FY2019= c(750), 
                     FY2020= c(900))
    
    return(df)
  })
  
  output$kpis <- renderUI({
    
    selectizeInput(inputId="kpi",
                   label="KPI:",
                   choices= unique(rawTable()$KPI),
                   selected= unique(rawTable()$KPI[1]),
                   multiple = FALSE)
    
  })
  
  KPIplot <- reactive({
    
    req(input$kpi)
    
    df <- rawTable() %>%
      filter(KPI == input$kpi) %>%
      tidyr::pivot_longer(cols = tidyr::starts_with("FY"),
                          names_to = "Fiscal.Year",
                          values_to = "Value") %>%
      mutate(Values = as.numeric(gsub("[^A-Za-z0-9;._-]","",Value)))
    
    #measure <- toupper(unique(df$`Y Axis Label`))
    
    ggplotly(
      ggplot(
        data = df,
        aes(x = Fiscal.Year, y= Value,
            text = paste0("Fiscal Year: ", gsub("\\.","-",str_remove(Fiscal.Year, "FY")),
                          "<br>Value: ", Value))
      ) +
        geom_bar(stat = "identity") +
        scale_y_continuous(labels = comma, breaks = scales::pretty_breaks(n = 10)) +
        theme_minimal(),
      tooltip = c("text")
    )
    
  })
  
  output$plot <- renderPlotly({KPIplot()})
  
  output$report <- renderUI({
    
    fluidPage(
      fluidRow(
        column(
          8, align = "right", offset = 2,
          downloadButton("report", "Generate report")
        )
      ),
      fluidRow(
        column(
          8, align="center", offset = 2,
          h1("Key Performance Indicator"),
          hr(),
          h2(input$goals)
        )
      ),
      fluidRow(
        column(
          8, align="left", offset = 2,
          h2(input$kpi),
          br(),
          h3("Description"),
          h5("custom text"),
          br(),
          h3("Performance Data"),
          renderPlotly({KPIplot()}),
          br(),
          h3("Analysis"),
          h5("custom text")
        )
      )
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

标签： rshiny