使用rhandsontable

Question

在这个优秀的问题中：Shiny: Switching reactive datasets with Rhandsontable and external parameters数据框和rhandsontable输出具有相同的结构。

我正在尝试解决类似的问题，但是数据集不具有相同的结构，并且数据集是在嵌套列表中构建的。考虑这个带有两个输入选择器的例子：

根据输入选择器的不同，可以生成四种可能的表。他们是：

表1（清单1，＆＃34;第一＆＃34;）：

表2（清单1，＆＃34;第二＆＃34;）：

表3（清单2，＆＃34;第三＆＃34;）：

表4（清单2，＆＃34;第四＆＃34;）：

每个表都通过renderRHandsontable元素出现在同一个位置。我认为我的问题在于更新reactiveValue＆＃34;值＆＃34; - 如何更新列表的元素而不更新任何其他元素？这是一个显示正确的最小示例，但您无法更改任何元素（我正在尝试解决的问题）。

require(rhandsontable)
require(shiny)

# Create some fake lists
list_1 <- list()
list_2 <- list()
list_1[['first']] <- data.frame(matrix(1:4,ncol=4))
list_1[['second']] <- data.frame(matrix(1:2,ncol=2),bool=factor('a1',levels=c('a1','a2','a3')))
list_2[['third']] <- data.frame(matrix(7:9,ncol=3))
list_2[['fourth']] <- data.frame(matrix(10:11,ncol=2),bool=factor('b1',levels=c('b1','b2')))

ui <- fluidPage(sidebarLayout(sidebarPanel(
  selectInput(
    'list_selector', 'Select list:',
    choices = c('list_1', 'list_2')
  ),
  uiOutput("second_selectorUI")
),
mainPanel(rHandsontableOutput("out"))))

server <- function(input, output) {

  values = reactiveValues()
  values[["list_1"]] <- list_1
  values[["list_2"]] <- list_2

  # Feed user input back to the list
  observe({
    if (!is.null(input$out)) {
      temp <- hot_to_r(input$out)
      if (isolate(input$list_selector) %in% c('first','third')){
        values[[isolate(input$list_selector)]][[isolate(input$list_selector)]] <- temp$values #Returns to wide format
      } else {
        values[[isolate(input$list_selector)]][[isolate(input$list_selector)]] <- temp
      }
    }
  })

  # Why isn't values[["list_1"]][[input$second_list_selector]] allowed?
  list <- reactive({
    if (input$list_selector == "list_1") {
      values[["list_1"]]
    } else if (input$list_selector == "list_2"){
      values[["list_2"]]
    }
  })

  output$second_selectorUI <- renderUI({
    if (input$list_selector == 'list_1'){
      selectInput(inputId = "second_list_selector", label="Select element 1", 
                  choices = c('first', 'second'))
    } else if (input$list_selector == 'list_2'){
      selectInput(inputId = "second_list_selector", label="Select element 2", 
                  choices = c('third', 'fourth'))
    }
  })

  output$out <- renderRHandsontable({
    if (!is.null(list()) && !is.null(input$second_list_selector)){
      if (input$second_list_selector %in% c('first','third')){
        df <- list()[[input$second_list_selector]]
        df <- data.frame(values=as.numeric(df)) #Turns into long format
        rhandsontable(df, stretchH = "all", rowHeaderWidth = 300, width=600)
      } else if (input$second_list_selector %in% c('second','fourth')){
        df <- list()[[input$second_list_selector]]
        rhandsontable(df, stretchH = "all", rowHeaderWidth = 50, height = 300,width=600) %>%
          hot_col("bool", allowInvalid = FALSE)
      }
    }
  })
}

shinyApp(ui = ui, server = server)

Answer 1

这是一种方式：

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("sel_1", label = "Select list:", 
                  choices = c("list_1", "list_2")),
      selectInput("sel_2", label = "Select element 1",
                  choices = names(list_1))
    ),
    mainPanel(
      rHandsontableOutput("hot")
    )
  )
)

server <- function(input, output, session) {

  list_1$first <- data.frame(values = as.numeric(list_1$first))
  list_2$third <- data.frame(values = as.numeric(list_2$third))

  values <- reactiveValues(list_1 = list_1, list_2 = list_2)

  observe({
    x <- input$sel_1
    label <- paste("Select element", substr(x, nchar(x) - 1, nchar(x)))
    updateSelectInput(session, "sel_2", label, 
                      choices = names(values[[x]]))
  })

  # Key part: storing back the data in `values` every time there is a change
  observe({
    if (!is.null(input$hot) && !is.null(input$hot$changes$changes)) 
      values[[isolate(input$sel_1)]][[isolate(input$sel_2)]] <- hot_to_r(input$hot)
  })

  output$hot <- renderRHandsontable({
      df <- values[[input$sel_1]][[input$sel_2]]
      if (is.null(df)) return(NULL)
      if (input$sel_2 %in% c("first", "third")) {
        rhandsontable(df, stretchH = "all", rowHeaderWidth = 300, width = 600)
      } else {
        rhandsontable(df, stretchH = "all", rowHeaderWidth = 50, height = 300, width = 600) %>%
          hot_col("bool", allowInvalid = FALSE)
      }
  })

}

虽然小心这个答案，因为在我写这篇文章时，我偶尔会看到一些奇怪的不可重复的错误，比如错误的表被覆盖，我发现在rhandsontable的情况下很难控制反应性。 / p>