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.
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With