reactive value resets to NA when new row inserted rhandsontable shiny

Question

I have a Shiny app with a rhandsontable and an infobox which reports the remaining budget, based on an initial budget (1000) and the values users put in the rhandsontable.

The value of the remaining budget updates correctly based on the value of the W column, however, when inserting a new row the value first changes to NA, before it gets recomputed, based on the value entered. I would like to value of the Remaining Budget infobox to stay the same until the new values are added. Below my code:

library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)

ui <-  fluidPage( fluidRow(column(6, uiOutput("selA"))),
                  fluidRow(column(6, rHandsontableOutput('tbl1'))),
                  fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
                      textOutput("infoRestBudget"))))
                  
) 


server <- function(input, output, session){
  
  dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
                     B = c("1","2","3","1","2","3"),
                     C = c(10,20,30,40,15,25),
                     D  = c("A","B","C","D","E","F"))
  
  # get the data for the selected BA
  dt <- reactive(subset(dt0, A %in% input$selA))
  
  # Render selectInput selBA
  output$selA <- renderUI({
    ba <- as.vector( unique(dt0$A) )
    selectInput("selA","Choose BA", choices = ba)    
  })
  
  DF <- data.frame("X" = c(""),
                   "Y" = c(""),
                   "Z" = c(""),
                   "Type_action" = c(""),
                   "W" = NA_integer_)
  
  values <- reactiveValues(data = DF)
  Y      <- reactiveVal()
  Z      <- reactiveVal()
  
  observe({
    if(!is.null(input$tbl1)){
      values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
    }
  })
  
  observeEvent(input$tbl1,{
    Y(hot_to_r(input$tbl1)$Y)},
    ignoreInit= TRUE
  )
  
  observeEvent(input$tbl1,{
    Z(hot_to_r(input$tbl1)$Z)}, 
    ignoreInit= TRUE
  )
  
  output$tbl1 = renderRHandsontable({
    req(input$selA)
    
    tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width = 
                                1000, height = 200) %>% 
      hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>% 
      hot_col(col = "X", type = "dropdown", colWidths = 90, source = 
                sort(unique(dt()$B))) %>% 
      hot_col(col = "Y", type = "dropdown", colWidths = 65, source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Z", type = "dropdown", colWidths = 60,source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text")  %>% 
      
      hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric") 
      
    
    if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r]) 
       && !is.na(values$data$Z[input$tbl1_select$select$r])){
      values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
      
    if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r]) 
         && !is.na(values$data$Z[input$tbl1_select$select$r])){
        val <- 100
        values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
      }
      
    }
    
    tmpTable
  })
  
 

val_W <- reactiveVal()

observeEvent(input$tbl1,{
  val_W(hot_to_r(input$tbl1)$W)}, 
  ignoreInit= TRUE
)

budget <- 1000
restBudget <- reactiveValues(val = budget)

observeEvent(input$tbl1, { 
    if(is.null(input$tbl1)){ 
      restBudget$val <- budget} else{
         restBudget$val <- budget - sum(as.numeric(val_W()))
       }
     
  }, ignoreInit = TRUE)

output$infoRestBudget <- renderText({
  
  req(input$tbl1)
  euro <- "\u20AC"
  res <- paste(euro, "", restBudget$val)
  res
  
}) 
}
shinyApp(ui, server)

Answer 1

Попробуйте приведенный ниже код. Вы получаете NA, потому что появляются новые строки без данных. Когда в X, Y или Z есть NA, "Остаточный бюджет" -NA, потому что для его расчета требуются значения, отличные от NA. Когда вы добавляете новую строку, вы вводите в расчет NA, и она становится NA.

Решение - установить значения по умолчанию для ваших новых строк. В объектах hot_col(...) вы можете установить значение по умолчанию для столбцов в новых строках.

Я установил X = 1, Y = A, Z = A, но используйте то, что вы считаете лучшим для вашего приложения.

library(shiny)
library(rhandsontable)
library(dplyr)
library(shinydashboard)

ui <-  fluidPage( fluidRow(column(6, uiOutput("selA"))),
                  fluidRow(column(6, rHandsontableOutput('tbl1'))),
                  fluidRow(column(6,box(title = "Remaining budget", width = 6, status = "info",
                                        textOutput("infoRestBudget"))))
                  
) 


server <- function(input, output, session){
  
  dt0 <- data.frame( A = c("S2","S2","S2","S4","S4","S4"),
                     B = c("1","2","3","1","2","3"),
                     C = c(10,20,30,40,15,25),
                     D  = c("A","B","C","D","E","F"))
  
  # get the data for the selected BA
  dt <- reactive(subset(dt0, A %in% input$selA))
  
  # Render selectInput selBA
  output$selA <- renderUI({
    ba <- as.vector( unique(dt0$A) )
    selectInput("selA","Choose BA", choices = ba)    
  })
  
  DF <- data.frame("X" = c(""),
                   "Y" = c(""),
                   "Z" = c(""),
                   "Type_action" = c(""),
                   "W" = NA_integer_)
  
  values <- reactiveValues(data = DF)
  Y      <- reactiveVal()
  Z      <- reactiveVal()
  
  observe({
    if(!is.null(input$tbl1)){
      values$data <- as.data.frame(hot_to_r(req(input$tbl1)))
    }
  })
  
  observeEvent(input$tbl1,{
    Y(hot_to_r(input$tbl1)$Y)},
    ignoreInit= TRUE
  )
  
  observeEvent(input$tbl1,{
    Z(hot_to_r(input$tbl1)$Z)}, 
    ignoreInit= TRUE
  )
  
  output$tbl1 = renderRHandsontable({
    req(input$selA)
    
    tmpTable <- rhandsontable(values$data, rowHeaders = FALSE, selectCallback = TRUE, width = 
                                1000, height = 200) %>% 
      hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") %>% 
      hot_col(col = "X", type = "dropdown", colWidths = 90, default = "1" , source = 
                sort(unique(dt()$B))) %>% 
      hot_col(col = "Y", type = "dropdown", colWidths = 65, default = "A", source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Z", type = "dropdown", colWidths = 60, default = "A", source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Type_action", colWidths = 50, readOnly = TRUE, type = "text")  %>% 
      
      hot_col(col = "W", colWidths = 50, readOnly = TRUE, type = "numeric") 
    
    
    if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r]) 
       && !is.na(values$data$Z[input$tbl1_select$select$r])){
      values$data$Type_action <- ifelse(match(Y(), LETTERS) < match(Z(), LETTERS),"Upgrade","Downgrade")
      
      if(!is.null(input$tbl1_select$select$r) && !is.na(values$data$Y[input$tbl1_select$select$r]) 
         && !is.na(values$data$Z[input$tbl1_select$select$r])){
        val <- 100
        values$data$W <- ifelse((match(Y(), LETTERS) < match(Z(), LETTERS)), val, -val)
      }
      
    }
    
    tmpTable
  })
  
  
  
  val_W <- reactiveVal()
  
  observeEvent(input$tbl1,{
    val_W(hot_to_r(input$tbl1)$W)}, 
    ignoreInit= TRUE
  )
  
  budget <- 1000
  restBudget <- reactiveValues(val = budget)
  
  observeEvent(input$tbl1, { 
    if(is.null(input$tbl1)){ 
      restBudget$val <- budget} else{
        restBudget$val <- budget - sum(as.numeric(val_W()))
      }
    
  }, ignoreInit = TRUE)
  
  output$infoRestBudget <- renderText({
    
    req(input$tbl1)
    euro <- "\u20AC"
    res <- paste(euro, "", restBudget$val)
    res
    
  }) 
}
shinyApp(ui, server)