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)
Try the code below. You are getting NA because the new rows appear with no data in them. When there is an NA in X, Y, or Z "Remaining Budget" is NA because it needs non-NA values to be calculated. When you add a new row you introduce NAs to the calculation so it becomes NA.
The solution is to set default values for your new rows. In the hot_col(...) objects you can set a default value for columns in new rows.
I have set X = 1, Y = A, Z = A but use whatever you think is best for your application.