R shiny datatable with numericinput interactivity issue

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)