1

我有一个带有 rhandsontable 和一个信息框的 Shiny 应用程序，它根据初始预算 (1000) 和用户在 rhandsontable 中输入的值报告剩余预算。

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

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)
4

1 回答 1

0

试试下面的代码。你得到 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)
于 2020-09-01T15:13:05.120 回答