r-在RShiny中实时更新数据帧



我正试图通过构建一个我认为非常简单但有用的应用程序来了解RShiny。我希望该应用程序允许用户输入一些由日期、数字和字符组成的数据。然后,当用户按下保存/提交按钮时,该数据将被附加到由以前的记录组成的预先存在的数据帧上,并重写这些记录的.csv。我还希望这些数据以UI中的表格的形式呈现给用户,一旦用户按下保存/提交按钮,该表格就会更新。

我已经设法使大多数UI功能正常工作,然而,我遇到了真正的困难1(以正确的格式保存数据和2(更新UI上显示的表。我目前保存数据的方法包括创建一个单独的输入值列表,并将其绑定到原始数据帧。然而,输入值的格式似乎都恢复到了日期特别有问题的因素,因为据我所知,输出毫无意义。在更新UI方面,我试图在数据帧之外创建一个反应对象,并将该对象用作renderDataTable中显示的数据,但这种方法似乎没有影响。

我在下面创建了一个虚拟的最小示例。

感谢您提前提供的帮助。

require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame 
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- isolate(c(input$SessionDate, input$SessionValue, input$SessionPerson))
isolate(df <- rbind(as.matrix(df), unlist(newLine)))
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactive({
df
})
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application 
shinyApp(ui = ui, server = server)

我做了一些小调整。

  • observeEvent的主体中不需要isolate;它不需要对其主体中的值进行被动依赖
  • 我把ReactiveDf变成了reactiveVal,而不是reactive。这允许您从observeEvent内部写入其值
  • 与其行绑定一个矩阵并取消列出一个列表——问题是所有新值都被解析到同一个类,而它们显然不是——可能更容易绑定两个data.frames,所以用newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)创建newLine

因此,一个工作示例如下所示。希望这能有所帮助!

require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame 
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)
df <- rbind(df, newLine)
ReactiveDf(df) # set reactiveVal's value.
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactiveVal(df)
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application 
shinyApp(ui = ui, server = server)

最新更新