下面的代码允许用户保存、加载和删除矩阵中的输入。这是为了保存场景。为了简洁起见,我想将“加载”(将保存的场景数据加载到矩阵中)功能移到模式对话框中。我有一个占位符,用于触发现在调用的模态对话
modify
。关于如何将“加载”功能移至模式对话中,有什么想法吗?一旦我了解了如何执行此操作,我将对“保存”和“删除”功能执行相同的操作。
下面说明了我正在尝试做的事情:
代码:
library(shiny)
library(shinyjs)
library(shinyMatrix)
ui <- fluidPage(
useShinyjs(),
h5(strong("Matrix inputs:")),
matrixInput(
"base_input",
value = matrix(rep(1,2), 2, 1, dimnames = list(c("A","B"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric"
),
h5(strong("Manipulate matrix inputs and output as dataframe:")),
tableOutput("result_table"),
h5(strong("Save, Load, and Delete User Inputs:")),
textInput("save_name", "Save As:"),
actionButton("save_btn", "Save"),
br(),br(),
actionButton('modify','Load saved inputs'),
selectInput("load_input", "Load Saved Inputs:", ""),
actionButton("load_btn", "Load"),
selectInput("delete_input", "Delete Saved Inputs:", ""),
actionButton("delete_btn", "Delete"),
hidden(downloadButton("save_file", "Download Saved Input")),
hidden(downloadButton("load_file", "Download Loaded Input"))
)
server <- function(input, output, session)({
observeEvent(input$save_btn, {
name <- input$save_name
values <- input$base_input
saveRDS(values, paste0(name, ".rds"))
})
observe({
saved_files <- list.files(pattern = "\\.rds$")
updateSelectInput(session, "load_input", choices = saved_files)
updateSelectInput(session, "delete_input", choices = saved_files)
})
observeEvent(input$modify,{
showModal(modalDialog(
h5("Would like to move the load section here...")
))
})
observeEvent(input$load_btn, {
file <- input$load_input
if (file.exists(file)) {
loaded_values <- readRDS(file)
updateMatrixInput(session, "base_input", value = loaded_values)
}
})
observeEvent(input$delete_btn, {
file <- input$delete_input
if (file.exists(file)) {
unlink(file)
}
})
matrix_data <- reactive({
matrix_df <- as.data.frame(
matrix(
input$base_input * 4, 2, 1, dimnames = list(c("A","B"), NULL)
)
)
colnames(matrix_df) <- "Matrix x 4"
matrix_df
})
output$result_table <- renderTable({
matrix_data()
}, rownames = TRUE, colnames = TRUE)
output$save_file <- downloadHandler(
filename = function() {
paste0(input$save_name, ".rds")
},
content = function(file) {
saveRDS(input$base_input, file)
}
)
output$load_file <- downloadHandler(
filename = function() {
input$load_input
},
content = function(file) {
file.copy(input$load_input, file)
}
)
})
shinyApp(ui, server)
为了达到您想要的结果,请将您的输入移动到
modalDialog
内。此外,我添加了对 input$modify
的反应性依赖,以便 selectInput
的选择得到更新。
注意:对于 reprex,我添加了代码来创建示例 rds 文件。我通过删除与删除和保存按钮相关的代码,将代码精简为更简单的示例。
library(shiny)
library(shinyjs)
library(shinyMatrix)
saveRDS(matrix(), "foo.rds")
ui <- fluidPage(
useShinyjs(),
h5(strong("Matrix inputs:")),
matrixInput(
"base_input",
value = matrix(rep(1, 2), 2, 1, dimnames = list(c("A", "B"), NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric"
),
h5(strong("Manipulate matrix inputs and output as dataframe:")),
tableOutput("result_table"),
h5(strong("Save, Load, and Delete User Inputs:")),
actionButton('modify','Load saved inputs'),
hidden(downloadButton("load_file", "Download Loaded Input"))
)
server <- function(input, output, session) {
({
observeEvent(input$modify, {
showModal(modalDialog(
selectInput("load_input", "Load Saved Inputs:", ""),
actionButton("load_btn", "Load"),
))
})
observeEvent(input$modify, {
saved_files <- list.files(pattern = "\\.rds$")
updateSelectInput(session, "load_input", choices = saved_files)
})
observeEvent(input$load_btn, {
file <- input$load_input
if (file.exists(file)) {
loaded_values <- readRDS(file)
updateMatrixInput(session, "base_input", value = loaded_values)
}
})
matrix_data <- reactive({
matrix_df <- as.data.frame(
matrix(
input$base_input * 4, 2, 1,
dimnames = list(c("A", "B"), NULL)
)
)
colnames(matrix_df) <- "Matrix x 4"
matrix_df
})
output$load_file <- downloadHandler(
filename = function() {
input$load_input
},
content = function(file) {
file.copy(input$load_input, file)
}
)
})
}
shinyApp(ui, server)