Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Data frame won't update using observeEvent in Shiny R

Tags:

r

reactive

shiny

I am a novice programmer, please excuse if I am not clear or missing relevant information. I have a shiny app written that imports a dataframe from another set of code. I would like to update that dataframe with user input in the app. I have gotten this to work where I upload the dataframe as a reactive variable using the code below:

DATA

current.shiny <- data.frame("Task" = as.character(c("Task 1", "Task 2", "Task 3")), "Completed" = as.character(c("Yes", "NO", "Yes")),"Date.Completed" = as.Date(c("2020-10-19","2020-10-20", "2020-10-21")))

UI

ui<- fluidPage(
  
  # Application title
  titlePanel("Week of 11.02.2020"),
  
  # Sidebar with reactive inputs
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "task.choice", label = "Task",
                  choices =  c(as.list(current.shiny$Task))),
      selectInput(inputId = "completed", label = "Completed?",
                  choices = c("Yes" = "Yes", "No" = "No")),
      dateInput(inputId = "date.completed", label ="Date Completed"),
      actionButton("update","Update Sheet")
      
    ),
    
    # a table of reactive outputs
    mainPanel(
      mainPanel(
        
        #DT::dataTableOutput("dt_table", width = 500)
        
      )
    )
  ),
  # column(12,
  #        DT::dataTableOutput("data", width = "100%")),
  column(12,
         DT::dataTableOutput("xchange", width = "100%"))
)

SERVER 1


server <- function(input, output) {
# # Re-read data for any changes, write to csv new changes, ignore startup
 observeEvent(input$update,{
   test.data<-current.shiny
   test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
   ignoreInit=T
 })

 # #Reactive variable xchange that updates the values of data
 xchange<-reactive({
   test.data<-current.shiny
   test.data$Completed[test.data$Task == input$task.choice]<-as.character(input$completed)
   test.data$Date.Completed[test.data$Task == input$task.choice]<-as.Date(input$date.completed)
   test.data
 })

 #Display the most recent file, with the most recent changes
 output$xchange <- renderDataTable({
   datatable(xchange(), options = list(dom = "t"))
 })
}
shinyApp(ui,server)

This works to a degree. However, it is over-reactive in that I need it to only update the table once a button is pressed. The observeEvent function in the above code doesn't seem to do anything (it was mostly copy/pasted from another stack overflow thread). I've tried to set this up below, but I cannot get it to run.

SERVER 2

server <- function(input, output, session) {
  rxframe <- reactiveVal(
    as.data.frame(current.shiny)
  )
  observeEvent(input$update, {
    rxframe$Completed[rxframe$Task == input$task.choice]<-as.character(input$completed)
  })
  output$xchange <- shiny::renderTable( rxframe() )
}

shinyApp(ui, server)

Can anyone see some way that I am calling the observeEvent incorrectly that is causing it to not function properly? Any insight would be greatly appreciated, I've been stuck on this for some time.

like image 956
reidj Avatar asked Oct 30 '20 22:10

reidj


1 Answers

Your code directly reacted to every change because you are using reactive.

If you want to delay the reaction you can use observeEvent along with reactiveValues or eventReactive.

Here is an example using reactiveVal and observeEvent:

library(shiny)
library(DT)

current.shiny <- data.frame(
    "Task" = as.character(c("Task 1", "Task 2", "Task 3")),
    "Completed" = as.character(c("Yes", "NO", "Yes")),
    "Date.Completed" = as.Date(c("2020-10-19", "2020-10-20", "2020-10-21"))
  )

ui <- fluidPage(
  # Application title
  titlePanel("Week of 11.02.2020"),
  
  # Sidebar with reactive inputs
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "task.choice",
        label = "Task",
        choices =  c(as.list(current.shiny$Task))
      ),
      selectInput(
        inputId = "completed",
        label = "Completed?",
        choices = c("Yes" = "Yes", "No" = "No")
      ),
      dateInput(inputId = "date.completed", label = "Date Completed"),
      actionButton("update", "Update Sheet")
    ),
    mainPanel(column(
      12,
      DT::dataTableOutput("xchangeOut", width = "100%")
    ))
  ))

server <- function(input, output) {
  xchange <- reactiveVal(current.shiny)
  observeEvent(input$update, {
    test.data <- xchange()
    test.data$Completed[test.data$Task == input$task.choice] <-input$completed
    test.data$Date.Completed[test.data$Task == input$task.choice] <- input$date.completed
    xchange(test.data)
    # write.csv
  })
  
  #Display the most recent file, with the most recent changes
  output$xchangeOut <- renderDataTable({
    datatable(xchange(), options = list(dom = "t"))
  })
}

shinyApp(ui, server)
like image 111
ismirsehregal Avatar answered Nov 18 '22 18:11

ismirsehregal