TarJae
TarJae

Reputation: 79276

How to store a shiny reactive data frame as csv on hard drive locally and append new entries

This is a follow-up question to this: How to use paste0 with input$ in shiny

I don't know if this is possible and I have been through all the persistent storage history the last years (here is a representative example of a former question: r shiny: Load data in to form fields from previously persistent stored data

Now I want to create a form in shiny where people can fill in the form and press a button to send the data, this is done with this code:

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  sidebarLayout(
    # Sidebar to demonstrate various slider options ----
    sidebarPanel(width = 4,
                 setSliderColor(c("DeepPink ", "#FF4500", "Teal"), c(1, 2, 3)),
                 # Input: Simple integer interval ----
                 div(class = "label-left",
                     Map(function(id, lbl) {
                       list(
                         div(style="display: inline-block;vertical-align:middle; width: 300px;",sliderInput(id, lbl, min = 0, max = 3, value = 0, width = "250px")),
                         div(style="display: inline-block;vertical-align:middle; width: 150px;",textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
                       )
                     }, c("a", "b", "c"), c("A", "B", "C"))
                 )
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      titlePanel("Sliders"),
      # Output: Table summarizing the values entered ----
      tableOutput("values")
      
    )
  )
)
server <- function(input, output, session) {
  Map(function(id) {
    list(
      observeEvent(input[[paste0("txt_", id)]], {
        if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
        {
          updateSliderInput(
            session = session,
            inputId = id,
            value = input[[paste0("txt_", id)]]
          ) # updateSliderInput
        }#if
      }),
      observeEvent(input[[id]], {
        if(as.numeric(input[[paste0("txt_", id)]]) != input[[id]])
        {
          updateTextInput(
            session = session,
            inputId = paste0("txt_", id),
            value = input[[id]]
          ) # updateTextInput
          
        }#if
      })
    )
  }, c("a", "b", "c"))
  
  # Reactive expression to create data frame of all input values ----
  sliderValues <- reactive({
    
    data.frame(
      Name = c("A",
               "B",
               "C"),
      Value = as.character(c(input$a,
                             input$b,
                             input$c
      )),
      stringsAsFactors = FALSE)
    
  })
  
  # Show the values in an HTML table ----
  output$values <- renderTable({
    sliderValues()
  })
}
shinyApp(ui, server)

And NOW I would like to save the actual filled in data to the hard disk as csv or any other format. And if the same user comes again next time the new data should be appended to the existing data.

Is this possible?

Upvotes: 4

Views: 544

Answers (1)

asd-tm
asd-tm

Reputation: 5263

Here is an app.R that does the required actions from your comments.

library(shiny)
library(shinyWidgets)
library(dplyr)
library(openxlsx)

defaultDF <- data.frame(Name = c("A", "B", "C"),
                        Value = rep(0L, 3))

MyColors = c("DeepPink ", "#FF4500", "Teal")

ui <- fluidPage(
  sidebarLayout(
    # Sidebar to demonstrate various slider options ----
    sidebarPanel(width = 4,
                 setSliderColor(MyColors, 
                                c(1:3)),
                 # Input: Simple integer interval ----
                 div(class = "label-left",
                     Map(function(id, lbl, val) {
                       list(
                         div(style="display: inline-block;vertical-align:middle; width: 300px;",
                             sliderInput(id, lbl, min = 0, max = 3, value = val, width = "250px")),
                         div(style="display: inline-block;vertical-align:middle; width: 150px;",
                             textInput(paste0("txt_", id), label = NULL, value = 0, width = "40px" ))
                       )
                     }, defaultDF %>% select(Name) %>% pull(), 
                     defaultDF %>% select(Name) %>% pull(), 
                     defaultDF %>% select(Value) %>% pull())
                 ),
                 downloadButton("xlsxDownload", "Download dataframe"),
                 fileInput(
                   "xlsxUpload",
                   "Files with stored values",
                   #placeholder = "Select files",
                   #buttonLabel = "Обзор",
                   #accept = c(".xml",".zip"),
                   accept = c(".xlsx"),
                   multiple = F
                 )
    ),
    # Main panel for displaying outputs ----
    mainPanel(
      titlePanel("Sliders"),
      # Output: Table summarizing the values entered ----
      tableOutput("values")
      
    )
  )
)
server <- function(input, output, session) {

  currentDF <- reactiveVal(defaultDF)
  
  # Show the values in an HTML table ----
  output$values <- renderTable({
    currentDF()
  })
  output$xlsxDownload <- downloadHandler(
    filename = 
      function() { "myDataframe.xlsx"
      },
    content = 
      function(file) {
        openxlsx::write.xlsx(
          currentDF(), 
          file)
      }
    
  )
  
  observe({
    file1 <- input$xlsxUpload
    if (!is.null(file1)) {
      
    
    ext <- tools::file_ext(file1$datapath)
    req(file1)
    validate(need(ext %in% c("xlsx"), 'All files must have extension xlsx')) # Add all other validation checks as well


    transformedData <- openxlsx::read.xlsx(file1$datapath)
    #do necessary checks and data transformations here
    transformedData
    currentDF(transformedData)
    }
  })
  
  observe({
    cdf <- currentDF()
    Map(function(Nm) updateSliderInput(
      session = session,
      inputId = Nm,
      value = cdf %>% filter(Name == Nm) %>% select(Value) %>% pull()
    ),
    c("A", "B", "C")
    )
  })
  
  observe({
    cdf <- currentDF()
    Map(function(Nm) updateTextInput(
      session = session,
      inputId = paste0("txt_", Nm),
      value = cdf %>% filter(Name == Nm) %>% select(Value) %>% pull()
    ),
    c("A", "B", "C")
    )
  })

  toListen <- reactive({
    list(input$A, input$B, input$C)
  })
  toListen2 <- reactive({
    list(input$txt_A, input$txt_B, input$txt_C)
  })
  
  observeEvent(toListen(),{ Map(function(id) {cdf <- currentDF() 
      cdf$Value[cdf$Name == id] <- input[[id]]
      currentDF(cdf)
  },
  c("A", "B", "C")
  )
  }
  )
  
  observeEvent(toListen2(),{ Map(function(id) {cdf <- currentDF() 
  cdf$Value[cdf$Name == id] <- input[[paste0("txt_", id)]]
  currentDF(cdf)
  },
  c("A", "B", "C")
  )
  }
  )
 
}
shinyApp(ui, server)

It allows:

  • to save and load a xlsx file with dataframe containing settings (values of A, B and C) on the client side. enter image description here
  • to change this dataframe when slider is moved and or text is input. enter image description here
  • to adjust positions of sliders / values in text inputs and rendered dataframe when the flie is loaded and/or any of the input controls value changes. enter image description here

Upvotes: 4

Related Questions