我在应用程序的服务器部分使用不同的输入创建了一个闪亮的表单。我现在正尝试在表单中添加两个按钮，但是还没有找到正确的方法。我需要一个按钮，该按钮允许用户编辑表上的选定条目，另一个按钮允许用户从表中删除选定的条目，当然，一旦完成，就需要更新数据表。
这是一个可复制的示例。我将在这个示例中进行大部分修改，https://deanattali.com/2015/06/14/mimicking-google-form-shiny/
我的应用代码：
library(shiny)
library(tidyverse)
library(shinyWidgets)
# Define the fields we want to save from the form
fields <- c("q1", "q2", "q3", "q4", "q5", "q6")
# Save a response
# This is one of the two functions we will change for every storage type
saveData <- function(data) {
data <- as.data.frame(t(data))
if (exists("responses")) {
responses <<- rbind(responses, data)
} else {
responses <<- data
}
}
# Load all previous responses
# This is one of the two functions we will change for every storage type
loadData <- function() {
if (exists("responses")) {
responses
}
}
# Shiny app with 3 fields that the user can submit data for
shinyApp(
ui = fluidPage(
tags$br(),
dropdown(
htmlOutput("q1"),
htmlOutput("q2"),
htmlOutput("q3"),
htmlOutput("q4"),
htmlOutput("q5"),
htmlOutput("q6"),
actionButton("submit", "Submit"),
actionButton("edit", "Edit"),
style = "unite",
icon = icon("plus"),
status = "danger",
#width = "300px",
size = "m",
label = "Add new Record",
tooltip = TRUE,
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
)
),
tags$hr(),
downloadButton("downloadData", "Download"),
actionButton("deleteRow", "Delete Row"),
tags$hr(),
column(width = 12, DT::dataTableOutput("responses", width = '100%'))
),
server = function(input, output, session) {
output$q1 <- renderUI({
textInput("Q1", "...", "")
})
output$q2 <- renderUI({
textInput("Q2", "...", "")
})
output$q3 <- renderUI({
dateInput("Q3", "...")
})
output$q4 <- renderUI({
textAreaInput("Q4", "...")
})
output$q5 <- renderUI({
textAreaInput("Q5", "...")
})
output$q6 <- renderUI({
dateInput("Q6", "...")
})
# Whenever a field is filled, aggregate all form data
formData <- reactive({
data <- sapply(fields, function(x) input[[x]])
data
})
# When the Submit button is clicked, save the form data
observeEvent(input$submit, {
saveData(formData())
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responses <- DT::renderDataTable({
input$submit
loadData()
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste("questionnaire", ".csv", sep = "")
},
content = function(file) {
write.csv(loadData(), file, row.names = FALSE)
}
)
}
)
我为“编辑”和“删除”添加了动作链接按钮，但在编程方面需要一些帮助。
谢谢
答案 0 :(得分：0)
欢迎堆栈溢出。进行一些反应式编程会很有帮助。在这里，全局df被定义为保存原始数据帧。
按下submit或delete时将修改此数据框。
类似地，当按下按钮时，下载处理程序也会更新。
library(shiny)
library(tidyverse)
library(shinyWidgets)
# Define the fields we want to save from the form
fields <- c("q1", "q2", "q3", "q4", "q5", "q6")
# Shiny app with 3 fields that the user can submit data for
shinyApp(
ui = fluidPage(
tags$br(),
dropdown(
textInput("Q1", "...", ""),
textInput("Q2", "...", ""),
textInput("Q3", "...", ""),
textInput("Q4", "...", ""),
textInput("Q5", "...", ""),
textInput("Q6", "...", ""),
actionButton("submit", "Submit"),
actionButton("edit", "Edit"),
style = "unite",
icon = icon("plus"),
status = "danger",
#width = "300px",
size = "m",
label = "Add new Record",
tooltip = TRUE,
animate = animateOptions(
enter = animations$fading_entrances$fadeInLeftBig,
exit = animations$fading_exits$fadeOutRightBig
)
),
tags$hr(),
downloadButton("downloadData", "Download"),
actionButton("deleteRow", "Delete Row"),
tags$hr(),
column(width = 12, DT::dataTableOutput("responses", width = '100%'))
),
server = function(input, output, session) {
#initialiez a dataframe
df = data.frame(Q1 = character(0),
Q2 = character(0),
Q3 = character(0),
Q4 = character(0),
Q5 = character(0),
Q6 = character(0))
#Modify the dataframe when submit is clicked
observeEvent(input$submit,{
data = data.frame(Q1 = input$Q1,
Q2 = input$Q2,
Q3 = input$Q3,
Q4 = input$Q4,
Q5 = input$Q5,
Q6 = input$Q6)
df <<- rbind(df,data)
})
#Delete a row when clicked
observeEvent(input$deleteRow,{
df <<- df%>%
filter(row_number() < nrow(.))
})
# Show the previous responses
# (update with current response when Submit is clicked)
output$responses <- DT::renderDataTable({
#simply to induce reactivity
input$submit
input$deleteRow
return(df)
})
#Update the download handler then submit is clicked
observe({
input$submit
input$deleteRow
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste("questionnaire", ".csv", sep = "")
},
content = function(file) {
write.csv(df, file, row.names = FALSE)
}
)
})
}
)