閃亮：保留data.table行不在下一個會話

在應用程序上工作我來到一個（很多）小事情，我遇到了麻煩。閃亮：保留data.table行不在下一個會話

我有用戶填寫textInputs在conditionalPanel並單擊actionButton另一個conditionalPanel，包括在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)

我需要使用會話？如果是的話，我會怎麼做？謝謝！

來源

2017-05-31 Rivka

這是發生，因爲變量'createdTempl'是跨會話共享的全局變量。您應該使用反應值。 – SBista

如何將表格作爲reactiveValue？沒有reactiveDataTable。對不起，我還是很新的閃亮。 – Rivka

正如我在評論中所提到的那樣，全局變量是跨會話共享的，因此即使重新啓動應用程序時也顯示先前的數據。所以，你需要使用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() 

     }) 

    }

希望它有幫助！

來源

2017-06-01 05:19:01 SBista

現在，無論是使用'<< - '還是'<-'，第2頁上的表格都不會顯示多於一行。我錯過了什麼嗎？ – Rivka

我想這是因爲你使用相同的'inputId'創建了多個'textInput'。另外，你的'tableColumns'變量只有最初創建的'textInput'，'first'' second'和'third'的值。 – SBista

我改變了服務器中的'inputIds'，所以至少應該顯示第二行，對吧？它不是。 – Rivka

隨着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)

來源

2017-06-01 09:23:49 Rivka

閃亮：保留data.table行不在下一個會話

回答

相關問題