R shiny datatable with numericinput interactivity issue - r

Question

I want to create a table in RShiny with numericInput so that user-supplied values can be used immediately. I followed the code HERE, but as the variables (car models) changes, it stops printing the new values. It works fine until the user changes the input.
Here is the code:
library(shiny)
library(DT)
library(tidyverse)
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
title = 'selectInput or numericInput column in a table',
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "cars", label = "Car model", choices = rownames(mtcars), selected = rownames(mtcars)[1:6], multiple = T )
),
mainPanel(
DT::dataTableOutput('carTable'),
verbatimTextOutput('price')
)
)
)
server <- function(input, output, session) {
rvar <- reactiveValues(
DF = mtcars
)
observeEvent(input$cars,{
for (i in 1:nrow(rvar$DF)) {
rvar$DF$price[i] <- as.character(numericInput(paste0("price", i), "", 0, width = "100px"))
}
rvar$data <- rvar$DF[rownames(mtcars) %in% input$cars, ] %>% select(-price)
})
output$carTable = DT::renderDT({
data <- rvar$DF[rownames(mtcars) %in% input$cars, ] %>% mutate(carmodel = input$cars) %>% relocate(carmodel)
datatable(
data, escape = FALSE, selection = 'none',
options = list(
dom = 't',
paging = FALSE,
ordering = FALSE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }')
),
rownames = FALSE
)
}, server = FALSE)
output$price = renderPrint({
str(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]))
})
observe({
updatedPrice <- sapply(1:nrow(rvar$DF), function(i) input[[paste0("price", i)]]) %>% Reduce(c,.)
if(is.null(updatedPrice) | length(updatedPrice) != nrow(rvar$data)){
updatedPrice <- 0
}
isolate({
rvar$data$price <- updatedPrice
})
print(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]) %>% Reduce(c,.))
print(rvar$data)
})
observeEvent(input$cars, {
session$sendCustomMessage("unbindDT", "carTable")
})
}
shinyApp(ui, server)

Answer 1

Works like this. It took me several trials and I don't exactly remember what were the problems...
library(shiny)
library(DT)
library(tidyverse)
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
title = "selectInput or numericInput column in a table",
sidebarLayout(
sidebarPanel(
selectizeInput(
inputId = "cars", label = "Car model",
choices = rownames(mtcars), selected = rownames(mtcars)[1:6],
multiple = TRUE
)
),
mainPanel(
DTOutput("carTable"),
verbatimTextOutput("price")
)
)
)
server <- function(input, output, session) {
rvar <- reactiveValues(
DF = mtcars
)
observeEvent(input$cars, {
rvar$DF <- rvar$DF[rownames(mtcars) %in% input$cars, ]
for(i in 1:nrow(rvar$DF)) {
rvar$DF$price[i] <-
as.character(numericInput(paste0("price", i), "", 0, width = "100px"))
}
rvar$data <- rvar$DF %>% select(-price)
rvar$DTdata <- rvar$DF %>%
mutate(carmodel = input$cars) %>%
relocate(carmodel)
session$sendCustomMessage("unbindDT", "carTable")
})
output$carTable <- renderDT({
data <- rvar$DTdata
datatable(
data,
escape = FALSE, selection = "none",
options = list(
dom = "t",
paging = FALSE,
ordering = FALSE,
preDrawCallback =
JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback =
JS('function() { Shiny.bindAll(this.api().table().node()); }')
),
rownames = FALSE
)
},
server = FALSE
)
output$price <- renderPrint({
str(sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]))
})
observe({
updatedPrice <-
sapply(1:nrow(rvar$DF), function(i) input[[paste0("price", i)]]) %>%
Reduce(c, .)
if(is.null(updatedPrice) || length(updatedPrice) != nrow(rvar$data)) {
updatedPrice <- 0
}
isolate({
rvar$data$price <- updatedPrice
})
print(
sapply(1:nrow(rvar$data), function(i) input[[paste0("price", i)]]) %>%
Reduce(c, .)
)
print(rvar$data)
})
}
shinyApp(ui, server)