Reputation: 79276
This is a follow-up question to this: How to use paste0 with input$ in shiny
I don't know if this is possible and I have been through all the persistent storage history the last years (here is a representative example of a former question: r shiny: Load data in to form fields from previously persistent stored data
Now I want to create a form in shiny where people can fill in the form and press a button to send the data, this is done with this code:
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)
And NOW I would like to save the actual filled in data to the hard disk as csv or any other format. And if the same user comes again next time the new data should be appended to the existing data.
Is this possible?
Upvotes: 4
Views: 544
Reputation: 5263
Here is an app.R
that does the required actions from your comments.
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)
It allows:
Upvotes: 4