当插入新行的横纹闪亮时，电抗值重置为NA

问题描述

我有一个Shiny应用，该应用带有rhandsontable和一个信息框，该信息框根据初始预算（1000）和用户在rhandsontable中输入的值来报告剩余预算。

剩余预算的值将根据W列的值正确更新，但是，当插入新行时，该值将首先根据输入的值更改为NA，然后重新计算。 我想在添加新值之前将“剩余预算”信息框的值保持不变。在我的代码下面：

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

ui <-  fluidPage( fluidRow(column(6,uIoUtput("selA"))),fluidRow(column(6,rHandsontableOutput('tbl1'))),Box(title = "Remaining budget",width = 6,status = "info",textoutput("infoRestBudget"))))
                  
) 


server <- function(input,output,session){
  
  dt0 <- data.frame( A = c("S2","S2","S4","S4"),B = c("1","2","3","1","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",colWidths = 65,source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Z",colWidths = 60,source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Type_action",colWidths = 50,readOnly = TRUE,type = "text")  %>% 
      
      hot_col(col = "W",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)),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)

解决方法

尝试下面的代码。之所以会得到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'))),box(title = "Remaining budget",width = 6,status = "info",textOutput("infoRestBudget"))))
                  
) 


server <- function(input,output,session){
  
  dt0 <- data.frame( A = c("S2","S2","S4","S4"),B = c("1","2","3","1","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",colWidths = 65,default = "A",source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Z",colWidths = 60,source = 
                sort(unique(dt()$D))) %>% 
      hot_col(col = "Type_action",colWidths = 50,readOnly = TRUE,type = "text")  %>% 
      
      hot_col(col = "W",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)),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)