在反应性 dataframe 内部具有隔离或非反应性柱

Question

我有一个反应式 dataframe（称为selected_df() ），其中我试图整合来自input$tableID_cells_selected和另一个 dataframe 的信息。

第二个反应式 dataframe 称为storage_df() ，为 1 行 2 列。 它从按下的操作按钮中收集背景颜色和文本标签，然后该数据将 static 保留在storage_df()中，直到按下不同的按钮。

selected_df()然后在选择表中的单元格时（或每当input$plate_cells_selected更新时）从storage_df()收集有关上次按下按钮的信息，并将这些数据显示在同一行中。

问题是selected_df()必须在响应式环境中引用storage_df() ，因此它会更新selected_df()中cond_selected和color_selected列中的所有值。 我不想让storage_df()中的那些旧值更新并替换为storage_df()中存在的任何新值。 我希望selected_df()的旧行保留这些旧值，并且selected_df()的新行具有storage_df()的新值。 所以基本上， storage)df()在按钮单击时更新，因为它是反应性的，但是由selected_df()对storage_df()的引用不会是反应性的。

我在这里有一个 gif，希望能解释我正在尝试做的事情，以防万一这令人困惑。 这是以前的尝试，但它是我最接近成功的一次。 在 gif 中， selected_df()的 color 和 cond 列设置如下，例如： cond_selected = isolate(paste0(rep(storage_df()[[1,2]]))) ，这样当一个新的按钮被按下。 selected_df()中cond_selected列的前三行理想情况下应保持 gse1，而后三行应为 cox8a。 如您所见，这不是发生的事情。

换句话说，这就是我在这个 gif 末尾的这些列中的内容：

这就是我在这些专栏中想要的：

我最近的尝试（包含在我的 MRE 中）。 我想如果我只尝试更新最后添加的行的值，因为我认为selected_df()可能会在选择新单元格时附加，那么这可能会起作用。 但是，应用程序崩溃并且只给出这个警告，它通常给出这个警告是因为selected_df()在选择单元格之前没有行：

Warning: Error in [: subscript out of bounds

诚实的免责声明

我知道我可能会以一种奇怪的方式解决这个问题，这是一个奇怪的问题。 但是，如果有任何方法可以将storage_df()中的值强制为 static 一旦它们到达selected_df() ，并且有人可以帮助我解决这个问题，我会很感激给他们寄钱买甜甜圈或其他东西。 谢谢！！

此外，这是我的 MRE 和最新尝试，以及我目前需要帮助来弄清楚的内容：

library(shiny)
library(colourpicker)
library(dplyr)
library(DT)
library(glue)
library(shinyWidgets)


####Create the matrix and organization for the 96 well plate####
plate96 <- function(id) {
  div(
    style = "position: relative; height: 500px",
    tags$style(HTML('
          
        .wells {
            transform: translateX(50%);
        }

        .wells table.dataTable tr:nth-child(9) td { /*for the row 9, need to make it not look like a row*/
            border-bottom: unset;
        }

        .wells tbody tr td:not(:first-of-type) {
            border: 1px solid black;
            height: 15px;
            width: 15px;
            padding: 15px;
            font-size: 0;
        }
    ')),
    div(
      style = "position: absolute; left: 50%; transform: translateX(-100%);",
      div(
        class = "wells",
        DTOutput(id, width = "90%", height= "100%")
      )
    )
  )
}

####Create the matrix and organization for the 96 well plate####

renderPlate96 = function(id, colors = rep("white", 108)) {
  
  plate <- matrix(1:108, 
                  nrow = 9, 
                  ncol = 12, 
                  byrow = TRUE, 
                  dimnames = list(LETTERS[1:9], 1:12))
  
  colnames (plate) = stringr::str_pad(colnames(plate), 2, "left", "0")
  
  return(plate_return1 <-
           datatable(
             plate,
             options = list(dom = 't', ordering = F),
             selection = list(mode = 'multiple', 
                              target = "cell"),
             class = 'cell-border compact'
           ) %>%
           formatStyle(
             1:12,
             cursor = 'pointer',
             backgroundColor = styleEqual(1:108, colors, default = NULL)
           )
  )
}

storage_df <- (data.frame(
  matrix(ncol = 2, nrow = 1),
  color_selected = NA,
  cond_selected = NA
))

# app code
ui <- fluidPage(
  
  plate96("plate"),
  tags$b("Wells Selected:"),
  verbatimTextOutput("plateWells_selected"),
  
  br(),
  helpText("Step 1: Add in a couple of buttons"),
  numericInput("num_conds", 
               label = h3("Enter the number of treatments/ conditions"),
               min = 1,
               max = 20,
               value = 1),
  
  htmlOutput("cond_buttons", align = 'center'),
  
  helpText("Step 2: Type in any name for a condition for the buttons"),
  uiOutput("boxes_conds"),
  
  helpText("Step 3: Choose any color for the buttons"),
  uiOutput("cond_colors"),
  
  helpText("Step 4: Select cells from the table above"),
  DT::dataTableOutput("selected_table"),
  
  DT::dataTableOutput("storage_table"),

)

server <- function(input, output, session){
  
  ### ★★ ↓↓↓↓ PROBLEM AREA ↓↓↓↓ ★★ ###
  
  ####Storage data.frame for when the buttons are clicked####
  observeEvent(input$num_conds, {
    lapply(1:input$num_conds, function(x){
      
      observeEvent(input[[paste0("cond_buttons",x)]], {
        newdf <- tibble(
          color_selected =  input[[paste0("colors",x)]],
          cond_selected = input[[paste0("condID",x)]]
        )
        storage_df(newdf)
      })
    })
  })
  
  storage_df <- reactiveVal(tibble::tribble(
    ~color_selected, ~cond_selected
  ))
  
  output$storage_table <- renderDataTable(
    req(storage_df()), 
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE,
                   stringsAsFactors = FALSE
    )
  )
  
  
  ####Create a DT that stores the values of the cells selected in the plate####
  selected_df <- reactive(data.frame(rows = req(input$plate_cells_selected[,1]),
                                     columns = req(input$plate_cells_selected[,2]),
                                     color_selected = 0,
                                     cond_selected = 0,
                                     stringsAsFactors = FALSE),
  )
  
####Take out this portion of the code if trying to reproduce my GIF###
  observeEvent(input$plate_cells_selected, {
    selected_df() %>% mutate(selected_df(), color_selected = replace(color_selected, color_selected== '0', isolate(paste0(rep(storage_df()[[1,1]]))))
    
  )})
####Take out this portion of the code if trying to reproduce my GIF###

  
  output$selected_table <- renderDataTable(
    req(selected_df()),
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE,
                   lengthChange = FALSE
    )
  )
  ### ★★ ↑↑↑↑ PROBLEM AREA ↑↑↑↑ ★★ ###
  
  #....#
  
  #Past here isn't as important to the question...#
  
  ####Input for user browse and data upload####
  output$contents <- renderTable({ req(input$data)  })
  
  #####Slider for frames per second####
  output$value <- renderPrint({ input$Frames })
  
  #####Check boxes for no-movement cell exclusion####
  output$value <- renderPrint({ input$emptyWell_checkbox })
  
  #####Number output for number of conditions#####
  output$value <- renderPrint({ input$num_conds })
  
  #### Condition boxes for UI text input####
  output$boxes_conds <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      cond_names <- textInput(paste0("condID", i),
                              label = paste0("Treatment/ Conditions: ", i),
                              placeholder = "Enter condition..."
      )
    })
  })
  
  #### Color selection for UI input####
  output$cond_colors <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      colourInput(paste0("colors", i),
                  label = (paste0("Select a color for condition ", i)),
                  show = c("both"),
                  value = "black",
                  palette = c("limited"),
      )
    })
  })
  
  #### Create action buttons for conditions to be selected####
  output$cond_buttons <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      
      bg = input[[paste0("colors", i)]]
      style = paste0(
        collapse = " ",
        glue("background-color:{bg};
                  color:#ffffff;
                  border-color:#000000")
      )
      
      label = input[[paste0("condID", i)]]
      
      actionButton(paste0("cond_buttons", i),
                   label = label,
                   style = style, 
      )
    })
  })
  
  ####Create the 96 well plate image####
  output$plate <- renderDT({
    renderPlate96()
  })
  
  output$plateWells_selected <- renderPrint({
    input$plate_cells_selected
  })
}
shinyApp(ui = ui, server = server)

应要求更新

这是重现您在 GIF 中看到的内容所需的部分代码。 这不是我最近的尝试，也不是我在故障排除方面需要的帮助，这只是为了提供我用来制作 GIF 的东西来解释我想要的东西。 只需在我的 MRE 中用此代码替换类似版本的代码，然后取出变异 function。 要删除的变异 function 已在我的 MRE 中由注释标记。

####Create a DT that stores the values of the cells selected in the plate####
  selected_df <- reactive(data.frame(rows = req(input$plate_cells_selected[,1]),
                                     columns = req(input$plate_cells_selected[,2]),
                                     color_selected = isolate(paste0(rep(storage_df()[[1,1]]))),
                                     cond_selected = isolate(paste0(rep(storage_df()[[1,2]]))),
                                     stringsAsFactors = FALSE)
  )

Answer 1

尝试这个

library(shiny)
library(colourpicker)
library(dplyr)
library(DT)
library(glue)
library(shinyWidgets)


####Create the matrix and organization for the 96 well plate####
plate96 <- function(id) {
  div(
    style = "position: relative; height: 500px",
    tags$style(HTML('
          
        .wells {
            transform: translateX(50%);
        }

        .wells table.dataTable tr:nth-child(9) td { /*for the row 9, need to make it not look like a row*/
            border-bottom: unset;
        }

        .wells tbody tr td:not(:first-of-type) {
            border: 1px solid black;
            height: 15px;
            width: 15px;
            padding: 15px;
            font-size: 0;
        }
    ')),
    div(
      style = "position: absolute; left: 50%; transform: translateX(-100%);",
      div(
        class = "wells",
        DTOutput(id, width = "90%", height= "100%")
      )
    )
  )
}

####Create the matrix and organization for the 96 well plate####

renderPlate96 = function(id, colors = rep("white", 108)) {
  
  plate <- matrix(1:108, 
                  nrow = 9, 
                  ncol = 12, 
                  byrow = TRUE, 
                  dimnames = list(LETTERS[1:9], 1:12))
  
  colnames (plate) = stringr::str_pad(colnames(plate), 2, "left", "0")
  
  return(plate_return1 <-
           datatable(
             plate,
             options = list(dom = 't', ordering = F),
             selection = list(mode = 'multiple', 
                              target = "cell"),
             class = 'cell-border compact'
           ) %>%
           formatStyle(
             1:12,
             cursor = 'pointer',
             backgroundColor = styleEqual(1:108, colors, default = NULL)
           )
  )
}

storage <- (data.frame(
  #matrix(ncol = 2, nrow = 1),
  color_selected = NA,
  cond_selected = NA
))

# app code
ui <- fluidPage(
  
  plate96("plate"),
  tags$b("Wells Selected:"),
  verbatimTextOutput("plateWells_selected"),
  
  br(),
  helpText("Step 1: Add in a couple of buttons"),
  numericInput("num_conds", 
               label = h3("Enter the number of treatments/ conditions"),
               min = 1,
               max = 20,
               value = 1),
  
  htmlOutput("cond_buttons", align = 'center'),
  
  helpText("Step 2: Type in any name for a condition for the buttons"),
  uiOutput("boxes_conds"),
  
  helpText("Step 3: Choose any color for the buttons"),
  uiOutput("cond_colors"),
  
  helpText("Step 4: Select cells from the table above"),
  DTOutput("selected_table"),
  
  DTOutput("storage_table"),
  
)

server <- function(input, output, session){
  
  ### ★★ ↓↓↓↓ PROBLEM AREA ↓↓↓↓ ★★ ###
  # storage_df <- reactiveVal(tibble::tribble(
  #   ~color_selected, ~cond_selected
  # ))
  
  storage_df <- reactiveVal(storage)
  
  ####Storage data.frame for when the buttons are clicked####
  observeEvent(input$num_conds, {
    lapply(1:input$num_conds, function(x){
      
      observeEvent(input[[paste0("cond_buttons",x)]], {
        newdf <- data.frame(
          color_selected =  input[[paste0("colors",x)]],
          cond_selected = input[[paste0("condID",x)]]
        )
        storage_df(newdf)
      }, ignoreInit = TRUE)
    })
  })
  
  output$storage_table <- renderDataTable(
    req(storage_df()), 
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE,
                   stringsAsFactors = FALSE
    )
  )
  
  selected <- reactiveValues(df=NULL)

  observeEvent(input$plate_cells_selected, {
    n = dim(req(input$plate_cells_selected))[1]
    ####Create a DT that stores the values of the cells selected in the plate####
    selected$df <- rbind(selected$df,data.frame(rows = input$plate_cells_selected[n,1],
                                                columns = input$plate_cells_selected[n,2], 
                                                color_selected = storage_df()[1,1], cond_selected = storage_df()[1,2]))
  })
  

  ####Create a DT that stores the values of the cells selected in the plate####
  selected_df <- reactive(data.frame(rows = req(input$plate_cells_selected[,1]),
                                     columns = req(input$plate_cells_selected[,2]),
                                     stringsAsFactors = FALSE) %>% mutate(color_selected = c(0), cond_selected = c(0))
  )

  output$selected_table <- renderDT(
    #selected_df(), 
    selected$df,
    options = list(paging = FALSE,
                   ordering = FALSE,
                   scrollx = FALSE,
                   searching = FALSE,
                   lengthChange = FALSE
    )
  )
  ### ★★ ↑↑↑↑ PROBLEM AREA ↑↑↑↑ ★★ ###
  
  #....#
  
  #Past here isn't as important to the question...#
  
  ####Input for user browse and data upload####
  output$contents <- renderTable({ req(input$data)  })
  
  #####Slider for frames per second####
  output$value <- renderPrint({ input$Frames })
  
  #####Check boxes for no-movement cell exclusion####
  output$value <- renderPrint({ input$emptyWell_checkbox })
  
  #####Number output for number of conditions#####
  output$value <- renderPrint({ input$num_conds })
  
  #### Condition boxes for UI text input####
  output$boxes_conds <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      cond_names <- textInput(paste0("condID", i),
                              label = paste0("Treatment/ Conditions: ", i),
                              placeholder = "Enter condition..."
      )
    })
  })
  
  #### Color selection for UI input####
  output$cond_colors <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      colourInput(paste0("colors", i),
                  label = (paste0("Select a color for condition ", i)),
                  show = c("both"),
                  value = "black",
                  palette = c("limited"),
      )
    })
  })
  
  #### Create action buttons for conditions to be selected####
  output$cond_buttons <- renderUI({
    num_conds = as.integer(input$num_conds)
    
    lapply(1:num_conds, function(i) {
      
      bg = input[[paste0("colors", i)]]
      style = paste0(
        collapse = " ",
        glue("background-color:{bg};
                  color:#ffffff;
                  border-color:#000000")
      )
      
      label = input[[paste0("condID", i)]]
      
      actionButton(paste0("cond_buttons", i),
                   label = label,
                   style = style, 
      )
    })
  })
  
  ####Create the 96 well plate image####
  output$plate <- renderDT({
    renderPlate96()
  })
  
  output$plateWells_selected <- renderPrint({
    input$plate_cells_selected
  })
}
shinyApp(ui = ui, server = server)