Home > OS >  Tweak the downloaded file on shiny
Tweak the downloaded file on shiny

Time:11-18

The code in shiny below works correctly. As you can see a table is shown and it is also possible to download an excel file of this generated table. However, I would like to make an brief adjustment to this downloaded spreadsheet. I made an image to illustrate what I want to do, which is to insert a new column called Todayday, which is the date that this spreadsheet was downloaded, that is, in this case, today, it is 17/11. So if I'm going to download this table tomorrow, the Todayday column will be 18/11.

How to adjust this?

Executable code below:

library(shiny)
library(shinythemes)
library(dplyr)

Test <- structure(list(date2 = structure(c(18808, 18808, 18809, 18810
), class = "Date"), Category = c("FDE", "ABC", "FDE", "ABC"), 
coef = c(4, 1, 6, 1)), row.names = c(NA, 4L), class = "data.frame")



ui <- fluidPage(
  
  shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                    br(),
                    tabPanel("",
                             sidebarLayout(
                               sidebarPanel(
                                 uiOutput('daterange'),
                                 br()
                                 
                               ),
                               mainPanel(
                                 dataTableOutput('table'),
                                 br(), br(), 
                                 downloadButton("dl", "Download")
                               ),
                             ))
  ))

server <- function(input, output,session) {
  
  data <- reactive(Test)
  
  data_subset <- reactive({
    req(input$daterange1)
    days <- seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$daterange <- renderUI({
    dateRangeInput("daterange1", "Period you want to see:",
                   start = min(data()$date2),
                   end   = max(data()$date2))
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
  output$dl <- downloadHandler(
    filename = function() { "data.xlsx"},
    content = function(file) {
      writexl::write_xlsx(data_subset(), path = file)
    }
  )
}

shinyApp(ui = ui, server = server)

Example enter image description here

I have o output$dl like this:

    output$dl <- downloadHandler(
    filename = function() { "data.xlsx"},
    content = function(file) {
    data1<-data_subset1()
    data2<-data_subset2()
    sheets <- mget(ls(pattern = "data"))
    writexl::write_xlsx(sheets, path = file)
    }
  )
  

CodePudding user response:

You can create a temp data.frame add the column and reorder the data.frame:

library(shiny)
library(shinythemes)
library(dplyr)

Test <- structure(
    list(
      date2 = structure(c(18808, 18808, 18809, 18810), class = "Date"),
      Category = c("FDE", "ABC", "FDE", "ABC"),
      coef = c(4, 1, 6, 1)
    ),
    row.names = c(NA, 4L),
    class = "data.frame"
  )

ui <- fluidPage(shiny::navbarPage(
  theme = shinytheme("flatly"),
  collapsible = TRUE,
  br(),
  tabPanel("",
           sidebarLayout(
             sidebarPanel(uiOutput('daterange'),
                          br()),
             mainPanel(
               dataTableOutput('table'),
               br(),
               br(),
               downloadButton("dl", "Download")
             ),
           ))
))

server <- function(input, output, session) {
  data <- reactive(Test)
  
  data_subset <- reactive({
    req(input$daterange1)
    days <-
      seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$daterange <- renderUI({
    dateRangeInput(
      "daterange1",
      "Period you want to see:",
      start = min(data()$date2),
      end   = max(data()$date2)
    )
  })
  
  output$table <- renderDataTable({
    data_subset()
  })
  
  output$dl <- downloadHandler(
    filename = function() {
      "data.xlsx"
    },
    content = function(file) {
      tmpTbl <- data_subset()
      tmpTbl$Todayday <- Sys.Date()
      nCols <- ncol(tmpTbl)
      writexl::write_xlsx(tmpTbl[, c(nCols, seq_len(nCols-1))], path = file)
    }
  )
}

shinyApp(ui = ui, server = server)

For a second sheet:

library(shiny)
library(shinythemes)
library(dplyr)

addTodayCol <- function(DF){
  tmpTbl <- DF
  tmpTbl$Todayday <- Sys.Date()
  nCols <- ncol(tmpTbl)
  return(tmpTbl[, c(nCols, seq_len(nCols-1))])
}

Test <- structure(
  list(
    date2 = structure(c(18808, 18808, 18809, 18810), class = "Date"),
    Category = c("FDE", "ABC", "FDE", "ABC"),
    coef = c(4, 1, 6, 1)
  ),
  row.names = c(NA, 4L),
  class = "data.frame"
)

ui <- fluidPage(shiny::navbarPage(
  theme = shinytheme("flatly"),
  collapsible = TRUE,
  br(),
  tabPanel("",
           sidebarLayout(
             sidebarPanel(uiOutput('daterange'),
                          br()),
             mainPanel(
               dataTableOutput('table'),
               br(),
               br(),
               downloadButton("dl", "Download")
             ),
           ))
))

server <- function(input, output, session) {
  data <- reactive(Test)
  
  data_subset2 <- data_subset1 <- reactive({
    req(input$daterange1)
    days <-
      seq(input$daterange1[1], input$daterange1[2], by = 'day')
    subset(data(), date2 %in% days)
  })
  
  output$daterange <- renderUI({
    dateRangeInput(
      "daterange1",
      "Period you want to see:",
      start = min(data()$date2),
      end   = max(data()$date2)
    )
  })
  
  output$table <- renderDataTable({
    data_subset1()
  })
  
  output$dl <- downloadHandler(
    filename = function() {
      "data.xlsx"
    },
    content = function(file) {
      data1 <- addTodayCol(data_subset1())
      data2 <- addTodayCol(data_subset2())
      sheets <- mget(ls(pattern = "data"))
      writexl::write_xlsx(sheets, path = file)
    }
  )
}

shinyApp(ui = ui, server = server)
  • Related