Блестящий: сохранение строк data.table не в следующем сеансе

Работая над приложением, я пришел к одной (из многих) мелочей, с которыми у меня возникли проблемы.

У меня есть пользователь, заполняющий textInputs в conditionalPanel, и после нажатия actionButton появляется другая условная панель, которая включает ту же информацию в форме data.table .

Моя проблема, похоже, заключается в функции rbind в сочетании с функцией assignment operator. Я не использую его, таблица (Panel2) будет включать только первую строку пользовательского ввода из Panel1. Если я использую rbind, он возвращает таблицу, которую я ожидаю (несколько входных строк приводят к нескольким строкам в таблице данных).

Но после закрытия и перезапуска моего приложения rbind добавляет новый ввод к старому.

Скажем, мой первый ввод будет:

A B C

после закрытия и перезапуска я набираю:

D E F

и результат был бы

A B C

D E F но я хочу только: D E F быть в моей таблице.

Пожалуйста, взгляните на мой код:

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)

Нужно ли использовать сеанс? Если да, то как бы я это сделал? Спасибо!


r data.table shiny rbind
person Rivka    schedule 31.05.2017    source источник
comment
Это происходит потому, что переменная createdTempl является глобальной переменной, которая является общей для всех сеансов. Вместо этого вы должны использовать реактивные значения.   -  person SBista    schedule 31.05.2017
comment
Как таблица может быть реактивным значением? Нет реактивной таблицы данных. Извините, я все еще новичок в блестящем .   -  person Rivka    schedule 31.05.2017

Ответы (2)


arrow_upward
1
arrow_downward

Как я уже упоминал в комментарии, глобальные переменные используются в разных сеансах, поэтому предыдущие данные отображались даже при перезапуске приложения. Итак, вам нужно исключить глобальные переменные, используя 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()  

      })

    }

Надеюсь, поможет!

person SBista    schedule 01.06.2017
comment
Теперь, независимо от того, использую ли я <<- или <-, таблица на странице 2. никогда не показывает более 1 строки. Я что-то упускаю? - person Rivka; 01.06.2017
comment
Я думаю, это потому, что вы создаете несколько textInput с одним и тем же inputId. Кроме того, ваша переменная tableColumns имеет значение только для textInput, first second и third, которые вы создали изначально. - person SBista; 01.06.2017
comment
Я изменил inputIds на сервере, так что по крайней мере вторая строка должна появиться, верно? Это не. - person Rivka; 01.06.2017
comment
Вы изменили свою переменную tableColumns? - person SBista; 01.06.2017
comment
Вам нужно изменить tableColumns так, чтобы новые inputId также были включены. - person SBista; 01.06.2017
comment
хорошо, я сделал. однако только сейчас он дает мне 2. строку, а имена столбцов не те, которые я изначально хотел. - person Rivka; 01.06.2017
comment
Давайте продолжим обсуждение в чате. - person Rivka; 01.06.2017

arrow_upward
0
arrow_downward

С помощью 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)
person Rivka    schedule 01.06.2017