使用shiny中的dropdown编辑和保存datatable

Question

我正在开发一个闪亮的应用程序，它创建了一个数据表，可以在全球范围内编辑和保存为数据帧对象。

我面临的问题是:数据帧作为下拉菜单选项- name列。保存数据帧后，输出即为as.character输出。示例如下：

library(shiny)
ui <- fluidPage(
DT::dataTableOutput("shinytest")
)

server <- function(input, output) {

  df <- data.frame(Number = NA, 
                   Pages  = NA,
                   Name  = as.character(selectInput(paste0("sel", 1), "", choices = c("x","y"), width = "100px"))
)
  
   rv <- reactiveVal(df)
  
  output$shinytest <- DT::renderDataTable ({
    DT::datatable(rv(), editable = TRUE, escape = FALSE, selection = 'none'
    )
    
  })
  
  observeEvent(input$shinytest_cell_edit, {
    info <- input$shinytest_cell_edit
    newdf <- rv()
    newdf[info$row, info$col] <- info$value
    rv(newdf)
    x <<- rv()
  })
}
shinyApp(ui, server)

对于全局环境中的x:在列名下面：<div class="form-group shiny-input-container" style="width:100px;">\n <label class="control-label" id="sel1-label" for="sel1"></label>\n <div>\n <select id="sel1"><option value="x" selected>x</option>\n<option value="y">y</option></select>\n <script type="application/json" data-for="sel1" data-nonempty="">{"plugins":["selectize-plugin-a11y"]}</script>\n </div>\n</div>

基于@GyD在this帖子中找到的代码

任何帮助都是非常感谢的。

Answer 1

在服务器内部创建了一个数据帧，将selectInput作为名称列中的数据馈送，这导致纯html在最终对象(x)中显示为文本。我将selectInput移到了ui中，以便可以为该列选择名称，尽管我不知道selectInput是否选择实际的列名，但这很容易更正。

我添加了一个选择行数的输入和一个操作按钮，以避免在再次编辑输入时丢失所有数据。

library(shiny)
library(DT)
library(tidyverse)


ui <- fluidPage(
    selectInput(inputId = 'selection1', "", choices = c("x","y"), selected = 'x', width = "100px"),
    numericInput('number_of_rows', 'How many rows?',value = 5),
    actionButton('update', 'Refresh Table'),
    DTOutput("shinytest")
)

server <- function(input, output, session) {
    
    
    
    df <- eventReactive(input$update, {tibble(Number = '', 
                                              Pages  = '',
                                              Name  = as.character(input$selection1),.rows = input$number_of_rows
    )})
    
    rv <- reactive(df())
    
    output$shinytest <- renderDT({
        datatable(rv(), editable = TRUE, escape = FALSE, selection = 'none')
    })
    
    observe({
        newdf <<- df()
    })
    
    observeEvent(input$shinytest_cell_edit, {
        
        info <- input$shinytest_cell_edit
        newdf[info$row, info$col] <<- info$value
        
    })
}

shinyApp(ui, server)