communication for ShinyModules for generating Rmarkdown report

I would like to generate reports based on several shiny modules, How does it work in this case, since the modules have to communicate with the rmd.file, how can this be done? I have not been able to find a solution here. the reproducible shiny app down below, works perfectly, however, as I said, I would want to render PDF/HTML report based on different modules.

file_upload_UI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "Upload File",
    titlePanel("Uploading Files"),
    sidebarLayout(
      sidebarPanel(
        fileInput(ns("file1"), "Choose CSV File",
                  accept = c(
                    "text/csv",
                    "text/comma-separated-values,text/plain",
                    ".csv"
                  )
        ),
        tags$br(),
        checkboxInput(ns("header"), "Header", TRUE),
        radioButtons(
          ns("sep"),
          "Separator",
          c(
            Comma = ",",
            Semicolon = ";",
            Tab = "\t"
          ),
          ","
        ),
        radioButtons(
          ns("quote"),
          "Quote",
          c(
            None = "",
            "Double Quote" = '"',
            "Single Quote" = "'"
          ),
          '"'
        )
      ),
      mainPanel(
        tableOutput(ns("contents"))
      )
    )
  )
}

file_upload_Server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      data <- reactive({
        req(input$file1)
        
        inFile <- input$file1
        
        df <- read.csv(inFile$datapath,
                       header = input$header, sep = input$sep,
                       quote = input$quote
        )
        return(df)
      })
      
      output$contents <- renderTable({
        data()
      })
      
      # return data
      data
    }
  )
}





first_page_UI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "First Tab",
    titlePanel("My First Plot"),
    sidebarPanel(
      selectInput(ns("xcol"), "X Variable", ""),
      selectInput(ns("ycol"), "Y Variable", "", selected = "")
    ),
    mainPanel(
      plotOutput(ns("MyPlot"))
    )
  )
}


first_page_Server <- function(id, df) {
  stopifnot(is.reactive(df))
  moduleServer(
    id,
    function(input, output, session) {
      observeEvent(df(), {
        updateSelectInput(session,
                          inputId = "xcol", label = "X Variable",
                          choices = names(df()), selected = names(df())
        )
        updateSelectInput(session,
                          inputId = "ycol", label = "Y Variable",
                          choices = names(df()), selected = names(df())[2]
        )
      })
      
      
      graph_2 <- reactive({
        
        graph_w<- ggplot(df(), aes(.data[[input$xcol]], .data[[input$ycol]])) +
          geom_point()
        
        graph_w
        
        
      })
      
      output$MyPlot <- renderPlot({
        graph_2()
        
        
      })
      

      
      
    }
  )
}


mod_ggplot_ui <- function(id){
  ns <- NS(id)
  
  tabPanel("ggplot Tab",
           pageWithSidebar(
             headerPanel('My second Plot'),
             sidebarPanel(
               
               selectInput(ns('xcol_1'), 'X Variable', ""),
               selectInput(ns('ycol_1'), 'Y Variable', "", selected = ""),
               checkboxInput(ns("typeplotly"), "Use interactivity", FALSE)

             ),
             mainPanel(
               conditionalPanel(
                 ns = NS(id),
                 "input.typeplotly == true", plotlyOutput(ns("plotly"))),
               conditionalPanel(
                 ns = NS(id),
                 "input.typeplotly == false", plotOutput(ns("plot")))
               
             )
           )
           
           
  )
  
}


mod_ggplot_server <- function(id, df){
  stopifnot(is.reactive(df))
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    observeEvent(df(), {
      updateSelectInput(session,inputId = "xcol_1",label = "X Variable",choices = names(df()), selected = names(df())
                        
                        
      )
      updateSelectInput(session,inputId = "ycol_1",label = "y Variable",choices = names(df()), selected = names(df())[2])
      
    }
    
    )
    
    graph <- reactive({
      
      graph_res <- ggplot(df(), aes(.data[[input$xcol_1]], .data[[input$ycol_1]])) +
        geom_point()
      
      graph_res
      
      
    })
    
    output$plot <- renderPlot({
      graph()
      
      
    })
    
    output$plotly <- renderPlotly({
      ggplotly(graph())
      
      
    })
    
    
  })
}


mod_Report_ui <- function(id){
  ns <- NS(id)
  
  tabPanel("Report ",
           mainPanel(
             
             width=12,title="Reporting information", solidHeader = TRUE, status = "primary",collapsible = F,
             fluidRow(
               column(4,  HTML('Report title')),
               column(8,textInput(ns("title"), placeholder='Report title',label=NULL))
             ),
             fluidRow(
               column(4,  HTML('author')),
               column(8,textInput(ns("author"), placeholder='Modeler name',label=NULL))
             )
             
             fluidRow(
               hr(),
               column(6,radioButtons(ns('format'), 'Document format', c('PDF', 'HTML', 'Word'),
                                     inline = TRUE)),
               column(6,  downloadButton(ns("report"), "Generate report",width='100%'))
               
             )
             
           )
  )
  
}


mod_Report_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    
    
    
    output$report <- downloadHandler(
      filename = function() {
        paste('My_report', Sys.Date(), sep = '.', switch(
          input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
        ))
      },
      
      content = function(file) {
        src <- normalizePath('report.Rmd')
        
        withProgress(message = 'Report generating in progress',
                     detail = 'This may take a while...', value = 0, {
                       for (i in 1:10) {
                         incProgress(1/10)
                         Sys.sleep(0.40)
                       }
                       
                     })
        
        
        
        
        owd <- setwd(tempdir())
        on.exit(setwd(owd))
        file.copy(src, 'report.Rmd', overwrite = TRUE)
        
        
        
        library(rmarkdown)
        out <- render('report.Rmd', switch(
          input$format,
          PDF = pdf_document(), HTML = html_document(), Word = word_document()
        ))
        file.rename(out, file)
      }
    )
    
    
  })
}



library(shiny)
library(ggplot2)
library(plotly)
library(datasets)

ui <- shinyUI(fluidPage(
  titlePanel("Column Plot"),
  tabsetPanel(
    file_upload_UI("upload_file"),
    first_page_UI("first_page"),
    
    mod_ggplot_ui("ggplot_1"),
    
    mod_Report_ui("Report_1")
    
    
  )
))

server <- shinyServer(function(input, output, session) {
  upload_data <- file_upload_Server("upload_file")
  first_page_Server("first_page", upload_data)
  mod_ggplot_server("ggplot_1",upload_data)
  
  mod_Report_server("Report_1")
  
})

shinyApp(ui, server)
---   
title: "`r input$title`" 
author: "`r input$author`"
output: pdf_document
---



```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(ggplot2)
library(shiny)
library(rmarkdown)
library(knitr)
graph_2()
graph()

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.