Output from Shiny module passed to Rmarkdown document appears blank-CodePudding

I want to pass some outputs from my Shiny app to a report which users can download. However, my attempt so far has proved unsuccessful. The code does not give me any error but the variable I require (bins) does not appear to be passed correctly to the markdown file.

I think it is probably something I have overlooked, but I am unable to figure out what it is:

Shiny app:

library(shiny)
library(tidyverse)
library(shinyjs)
library(rmarkdown)

slider_input_ui <- function(id) {
  ns <- NS(id)
  tagList(
    sliderInput(inputId = ns("bins"),label = "Number of bins:",min= 1,max = 50,value= 30),
    br(),
    actionButton(inputId = ns("click"),label   = "Click Me"),
    br())
}
slider_input_server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      shinyjs::click(id = "click")
      return(
        list(
          bins       = reactive(input$bins),
          action_btn = reactive(input$click)
        )
      )
    }
  )
}

dist_ui <- function(id) {
  ns <- NS(id)
  radioButtons(inputId = ns("dist"),
               label = "Choose Distribution",choices = c("Normal", "Exponential"))
}
dist_server <- function(id, action_button) {
  moduleServer(
    id,
    function(input, output, session) {
      distribution <- eventReactive(action_button(), {
        if(input$dist == "Normal") {
          dist <- rnorm(n = 10000, mean = 0, sd = 1)
        } else {
          dist <- rexp(n = 10000, rate = .2)
        }
        return(dist)
      })
      return(distribution)
    }
  )
}

histogram_ui <- function(id) {
  
  ns <- NS(id)
  
  tagList(
    
    plotOutput(ns("plot"))
    
    
  )
  
}
histogram_server <- function(id, df, slider_input_bins, action_button) {
  moduleServer(
  id,
    function(input, output, session) {
      bins <- eventReactive(action_button(), {
        bins <- seq(min(df()), max(df()), length.out = slider_input_bins()   1)
      })
      output$plot <- renderPlot({
         hist(df(), breaks = bins(), col = 'darkgray', border = 'white')
      })
    })
}

ui <- fluidPage(
  shinyjs::useShinyjs(),
  titlePanel("Modules Tutorial"),
  sidebarLayout(
    sidebarPanel(
      slider_input_ui("slider_btn"),
      dist_ui("dist"),
      downloadButton("report", "Generate report")
    ),
    mainPanel(histogram_ui("hist"))
  )
)
server <- function(input, output, session) {
  
  slider_btn_vals <- slider_input_server(id = "slider_btn")
  dist_values <- dist_server(id = "dist",action_button = slider_btn_vals$action_btn)
  histogram_server(id = "hist",
                   df = dist_values,
                   slider_input_bins = slider_btn_vals$bins,
                   action_button = slider_btn_vals$action_btn)
  output$report <- downloadHandler(
    filename = "report.html",
    content = function(file) {
      tempReport <- file.path(tempdir(), "report.Rmd")
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      params <- list(n = reactive(slider_btn_vals$bins))
      rmarkdown::render(tempReport, output_file = file,
                        params = params,
                        envir = new.env(parent = globalenv())
      )
    }
  )
}  
shinyApp(ui = ui, server = server)

R markdown document: report.Rmd

---
title: My Document
output: html_document
params:
  n: NA
---

This is a test: `r params$n`

CodePudding user response：

The issue is simply that you pass a reactive, i.e. slider_btn_vals$bins, wrapped inside a reactive to the params list.

To fix that use

params <- list(n = slider_btn_vals$bins())

to pass the value of slider_btn_vals$bins to the parameter n.