2021年5月3日星期一

R - Shiny - Export of shiny dashboard is not working - rmarkdown

I've created a shiny dashboard but unable to export into pdf/image/html.

Have given below a simplified version of script I tried and the error screenshot.

It would be great if someone can help me to achieve this.

library(shiny)  library(shinythemes)  library(DT)  library(rhandsontable)  library(tidyverse)  library(tidyquant)  library(knitr)  library(gt)  library(shinycssloaders)  library(shinydashboard)  library(shinyWidgets)  library(rmarkdown)        Table1 = data.frame(A = c(1:3), B = c(4:6))  Table2 = data.frame(C = c(7:9), B = c(10:12))  tab1selection = "Option 1"  tab2selection = "Option 3"    header = dashboardHeader(title = 'Title', titleWidth = 400)    sidebar = dashboardSidebar(        width = 300,        fluidRow(            selectInput(inputId = 'dropdown1', 'Select an option', choices = c(''), selected = 1),            conditionalPanel(condition = "input.tabselected == 'tab1'",                       radioButtons('format', 'Document format', c('PDF', 'HTML', 'Image'), inline = TRUE),                       align = "center",  downloadButton('DownloadReport')      ),            conditionalPanel(condition = "input.tabselected != 'tab1'", fileInput("file", "Choose xlsx file", accept = ".xlsx"))          )      )      body <- dashboardBody(    uiOutput("mainpanel")  )    ui = dashboardPage(header, sidebar, body)    server = function(input, output, session) {        ############            output$DownloadReport <- downloadHandler(      filename = function(dropdown1) {        paste(input$, sep = '.', switch(          input$format, PDF = 'pdf', HTML = 'html', Image = 'png'        ))      },            content = function(file) {        src <- normalizePath('report.Rmd')                # temporarily switch to the temp dir, in case you do not have write        # permission to the current working directory        owd <- setwd(tempdir())        on.exit(setwd(owd))        file.copy(src, 'report.Rmd', overwrite = TRUE)                out <- render('report.Rmd', switch(          input$format,          PDF = pdf_document(), HTML = html_document(), Image = png()        ))        file.rename(out, file)      }    )        output$mainpanel = renderUI({            if(is.null(input$file)) {return(                fluidRow(            tabBox(width = 250, height = 100,                 tabPanel("Tab 1", value = 'tab1', DT::dataTableOutput("output1")%>% withSpinner(color="#3483CA", type = 1, size = 2)),                 tabPanel("Tab 2", value = 'tab2', DT::dataTableOutput("output2")%>% withSpinner(color="#3483CA", type = 1, size = 2), downloadButton(outputId = "FFSassndownload", label = "Download Table")),                 id ="tabselected"          )        )      )}            else                fluidRow(          tabBox(width = 250, height = 100,                 tabPanel("Tab 3", value = 'tab3', rHandsontableOutput("contents")%>% withSpinner(color="#3483CA", type = 1, size = 2)),                 tabPanel("Tab 2", value = 'tab2', DT::dataTableOutput("output2")%>% withSpinner(color="#3483CA", type = 1, size = 2), downloadButton(outputId = "Tabledownload", label = "Download Table")),                 tabPanel("Tab 1", value = 'tab1', DT::dataTableOutput("output1")%>% withSpinner(color="#3483CA", type = 1, size = 2)),                 id ="tabselected"          )        )    })            ############        choices = reactiveValues(      tab1 = c('Option 1', 'Option 2'),      tab2 = c('Option 3'),      tab3 = c('Option 4')    )        observeEvent(input$tabselected, {      updateSelectInput(session, 'dropdown1', choices = choices[[input$tabselected]],                        selected = ifelse(input$tabselected == 'tab1', tab1selection, tab2selection))    })        observeEvent(input$dropdown1, {            req(input$tabselected)            if(input$tabselected == 'tab1') {tab1selection <<- input$dropdown1} else {tab2selection <<- input$dropdown1}            if(input$tabselected == 'tab1') {output$output1 = DT::renderDataTable({datatable(Table1)})}          })            output$output2 =  DT::renderDataTable({      datatable(Table2, options = list(scrollX = TRUE), list(paging = F), rownames = F, filter = "top") %>%        formatRound(columns = c(1:2), digits = 2)    })        output$Tabledownload = downloadHandler(      filename = "Tabledownload.xlsx",      content = function(file) {write.xlsx(Table2, file)})            indat <- reactiveValues(data=FFSassns)        output$contents =       renderRHandsontable({        file <- input$file        ext <- tools::file_ext(file$datapath)        req(file)        validate(need(ext == "xlsx", "Please upload an xlsx file"))        data1 = openxlsx::read.xlsx(file$datapath, check.names=FALSE)        indat$data <- data1        rhandsontable(indat$data)      })      }      shinyApp(ui = ui, server = server)    

Error:

enter image description here

Please note: I'll not be able to download any .exe files (like Rtools) and install in my system due to work environment restrictions. Kindly suggest if there is any other alternate solution is also available.

Thanks...

https://stackoverflow.com/questions/67378277/r-shiny-export-of-shiny-dashboard-is-not-working-rmarkdown May 04, 2021 at 11:05AM

没有评论:

发表评论