在RShiny中实时更新数据帧

时间:2018-07-17 11:03:37

标签: r shiny

我正在尝试通过构建我认为会非常简单但有用的应用程序来了解RShiny。我希望应用程序执行的操作是允许用户输入由日期,数字和字符组成的一些数据。然后,当用户按下“保存/提交”按钮时,此数据将附加到由以前的记录组成的预先存在的数据框中,并覆盖这些记录的.csv。我还希望这些数据以用户界面中表格的形式呈现给用户,一旦用户按下保存/提交按钮,表格便会更新。

我已经设法使大多数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)

1 个答案:

答案 0 :(得分:1)

我做了一些小调整。

  • isolate的正文中不需要observeEvent;它对主体中的值没有反应性的依赖。
  • 我将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)