如何将用户输入插入R Shiny模态对话框?

nr9pn0ug  于 2024-01-03  发布在  其他
关注(0)|答案(1)|浏览(116)

下面的代码允许用户保存,加载和删除矩阵中的输入。这是用于保存场景。为了简洁起见,我想移动“加载”(将保存的场景数据加载到矩阵中)函数到模态对话框中。我有一个占位符用于触发模态对话框,现在称为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)

字符串

kdfy810k

kdfy810k1#

为了达到你想要的结果,将你的输入移到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)

字符串


的数据

相关问题