闪亮：保留 data.table 的行不在下一个会话中

Question

在开发一个应用程序时，我遇到了一件（很多）小事，我遇到了麻烦。

我让用户在 conditionalPanel 中填写 textInputs，然后单击 actionButton 另一个条件面板，其中包含 data.table 形式的相同信息，过来。

我的问题似乎是 rbind 函数与 assignment operator 结合使用。我不使用它，table(Panel2) 将仅包含来自 Panel1 的用户输入的第一行。如果我使用 rbind，它会 return 我期望的 table（多个输入行导致数据中的多个行。table）。

但是在关闭并重新启动我的应用程序后，rbind 正在将新输入添加到旧输入。

假设我的第一个输入是：

A B C

关闭并重新启动后，我输入：

D E F

结果会是

A B C

D E F 但我只想：D E F 出现在我的 table.

中

请看我的代码：

library(shiny)
library(DT)
library(data.table)

ui = fluidPage( 
  conditionalPanel(
    condition = "input.createTemplTable%2 == 0",
    actionButton("add", "Add new Row", icon=icon("plus", class=NULL, lib="font-awesome")),
    actionButton("remove", "Remove last Row", icon=icon("times", class = NULL, lib = "font-awesome")),
    fluidRow(
      column(2,
             textInput("first", label = h5("first"))
      ),
      column(2,
             textInput("second", label = h5("second"))
      ),
      column(2,
             textInput("third", label = h5("third"))
      )
    ), 
    tags$div(id = 'placeholder'),
    actionButton("createTemplTable", "Create Template")
  ),

  conditionalPanel(
    condition = "input.createTemplTable%2 == 1",
    #actionButton("return", "Return to Template Generator"),
    dataTableOutput("createdTempl")

  )
)

server = function(input, output) {

  ## keep track of elements inserted and not yet removed
  inserted <- reactiveValues(val = 0)
  tableColumns <- c("first", "second", "third")

  observeEvent(input$add, {
    id <- length(inserted$val) + 1
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui =tags$div(
        id = id,
        fluidRow(
          column(2,
                 textInput("first", label = (""))
          ),
          column(2,
                 textInput("second", label = (""))
          ),
          column(2,
                 textInput("third", label = (""))
          )

        ) 
      )
    )
    inserted$val <- c(inserted$val, id)

  })

  observeEvent(input$remove,{
    print(inserted$val)
    removeUI(
      selector = paste0('#', inserted$val[length(inserted$val)])
    )

    inserted$val <- inserted$val[-length(inserted$val)]
  })

  saveData <- function(data) {
    data <- as.data.table(t(data))
    if (exists("createdTempl")) {
       createdTempl <<- rbind(createdTempl, data)
     } else {
      createdTempl <<- data
    }
  }

  loadData <- function() {
    if (exists("createdTempl")) {
      createdTempl
    }
  }

  formData <- reactive({
    data <- sapply(tableColumns, function(x) input[[x]])
    data
  })

  observeEvent(input$createTemplTable, {
    saveData(formData())
  })

  output$createdTempl <- renderDataTable({
    input$createTemplTable
    loadData()  

  })

}

shinyApp(ui = ui, server = server)

我需要使用session吗？如果是，我该怎么做？谢谢！

Answer 1

正如我在评论中提到的，全局变量在会话之间共享，因此，即使您重新启动应用程序，也会显示以前的数据。因此，您需要使用 reactiveValues 消除全局变量。虽然名称是 reactiveValue，但它实际上是一个反应变量，就像 R 中的所有其他变量一样，我们可以在 reactiveValues 中存储数据帧。在您的情况下，它将如下所示。我刚刚修改了您的服务器代码以消除对全局变量的使用。

 server = function(input, output) {

      ## keep track of elements inserted and not yet removed
      inserted <- reactiveValues(val = 0)
      tableColumns <- c("first", "second", "third")

      #Reactive value to store the data frame 
      createdTempl <- reactiveValues(val = NULL)

      observeEvent(input$add, {
        id <- length(inserted$val) + 1
        insertUI(
          selector = "#placeholder",
          where = "beforeBegin",
          ui =tags$div(
            id = id,
            fluidRow(
              column(2,textInput("first", label = (""))
              ),
              column(2,
                     textInput("second", label = (""))
              ),
              column(2,
                     textInput("third", label = (""))
              )

            ) 
          )
        )
        inserted$val <- c(inserted$val, id)

      })

      observeEvent(input$remove,{
        print(inserted$val)
        removeUI(
          selector = paste0('#', inserted$val[length(inserted$val)])
        )

        inserted$val <- inserted$val[-length(inserted$val)]
      })

      saveData <- function(data) {
        data <- as.data.table(t(data))
        if (!is.null(createdTempl$val)) {
          createdTempl$val <- rbind(createdTempl$val, data)
        } else {
          createdTempl$val <- data
        }
      }

      loadData <- function() {
        if (!is.null(createdTempl$val)) {
          createdTempl$val
        }
      }

      formData <- reactive({
        data <- sapply(tableColumns, function(x) input[[x]])
        data
      })

      observeEvent(input$createTemplTable, {
        saveData(formData())
      })

      output$createdTempl <- renderDataTable({
        input$createTemplTable
        loadData()  

      })

    }

希望对您有所帮助！

Answer 2

在 SBista 的帮助下，这是我对这个问题的最终解决方案：

library(shiny)
library(DT)
library(data.table)

ui = fluidPage( 
  conditionalPanel(
    condition = "input.createTemplTable%2 == 0",
    actionButton("add", "Add new Row", icon=icon("plus", class=NULL, lib="font-awesome")),
    actionButton("remove", "Remove last Row", icon=icon("times", class = NULL, lib = "font-awesome")),
    fluidRow(
      column(2,
             textInput("first", label = h5("first"))
      ),
      column(2,
             textInput("second", label = h5("second"))
      ),
      column(2,
             textInput("third", label = h5("third"))
      )
    ), 
    tags$div(id = 'placeholder'),
    actionButton("createTemplTable", "Create Template")
  ),

  conditionalPanel(
    condition = "input.createTemplTable%2 == 1",
    #actionButton("return", "Return to Template Generator"),
    dataTableOutput("createdTempl")

  )
)

server = function(input, output) {
  ## keep track of elements inserted and not yet removed
  inserted <- reactiveValues(val = 0)
  tableColumns <- c("first", "second", "third")

  #Reactive value to store the data
  createdTempl <- reactiveValues(val = NULL)
  observeEvent(input$add, {
    # browser()
    id <- length(inserted$val) + 1
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui =tags$div(
        id = id,
        fluidRow(
          column(2,textInput(paste0("first", id), label = (""))
          ),
          column(2,
                 textInput(paste0("second", id), label = (""))
          ),
          column(2,
                 textInput(paste0("third", id), label = (""))
          )

        ) 
      )
    )
    inserted$val <- c(inserted$val, id)

  })

  observeEvent(input$remove,{
    print(inserted$val)
    removeUI(
      selector = paste0('#', inserted$val[length(inserted$val)])
    )

    inserted$val <- inserted$val[-length(inserted$val)]
  })

  saveData <- function(data) {
    data <- as.data.table(t(data))
    if (!is.null(createdTempl$val)) {
      browser()
      createdTempl$val <- rbind(createdTempl$val, data)
    } else {
      createdTempl$val <- data
    }
  }

  loadData <- function() {
    if (!is.null(createdTempl$val)) {
      createdTempl$val
    }
  }

  formData <- reactive({
    # browser()
    if(length(inserted$val) >1){
      tabColNew <- sapply(inserted$val[2:length(inserted$val)], function(i){ c(paste0("first", i), paste0("second", i), paste0("third", i))})
      tableColumns <- rbind(tableColumns, t(tabColNew))
      data <- apply(tableColumns, 1, function(x){
        sapply(x, function(x)input[[x]])
      })
    }else{

      data <- sapply(tableColumns, function(x)input[[x]])
    }

    data
  })

  observeEvent(input$createTemplTable, {
    saveData(formData())
  })

  output$createdTempl <- renderDataTable({
    input$createTemplTable
    loadData()  

  })

}


shinyApp(ui = ui, server = server)

闪亮：保留 data.table 的行不在下一个会话中

Shiny: keeping rows of data.table not in next session

r

rbind

shiny

data.table