如何在本地硬盘驱动器上存储一个闪亮的React性 Dataframe 作为csv，并追加新条目

thtygnil 于 2022-12-06 发布在 React

关注(0)|答案(1)|浏览(139)

这是一个后续问题：How to use paste0 with input$ in shiny
我不知道这是否可行，我已经浏览了过去几年的所有持久存储历史（以下是前一个问题的代表性示例：r shiny: Load data in to form fields from previously persistent stored data

现在我想在shiny中创建一个表单，人们可以在其中填写表单并按下按钮发送数据，这是通过以下代码完成的：

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)

现在我想保存实际填写的数据到硬盘作为csv或任何其他格式。如果同一用户下次再来的新数据应追加到现有的数据。
这可能吗？

r

来源：https://stackoverflow.com/questions/74537975/how-to-store-a-shiny-reactive-data-frame-as-csv-on-hard-drive-locally-and-append

1条答案

按热度按时间

cwxwcias1#

下面是一个app.R，它可以根据您的评论执行所需的操作。

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)

它允许：