User input in DataTable used for recalculation and update of column in Shiny

Question

I want to create a web app, which allows user to enter input in numericInput object, which is embedded in DataTable and recalculates result (multiplication of column with some static values and a user input column) in another column.

I believe that when I set a reactive function which wraps around merging dataset and user input column and later I call it from RenderDataTable, that I somehow break the reactivity and I don't have a clue how to keep reactivity within table dependent on user input (which is also in the table). Please help.

Reproducible example to where I am stuck:

library(shiny)
library(DT) 

set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
                 group = c("G","M","O","F","L"),
                 val = sample(1:100, 5, replace=TRUE))

ui <- fluidPage(
      titlePanel(paste0("entity - ", unique(db$ent))),
          sidebarLayout(
               sidebarPanel(
                   helpText("Shiny app calculation")
               ),
               mainPanel(
                   DT::dataTableOutput("table")
               ))
      )


numericText <- function(FUN, id_nums, id_base, label, value, ...) {
                        inputs <- 1:length(id_nums)
                        for (i in 1:length(inputs)) {
                        inputs[i] <- as.character(FUN(paste0(id_base, 
                                     id_nums[i]), label, value, ...))
                        }
return(inputs)
}

inputs <- numericText(numericInput,
                  id_nums = as.character(1:5),
                  id_base = "input_", 
                  label = NULL,
                  value = 0)

db <- data.frame(db,
             num = inputs)


server <- function(input, output, session) {

    shinyValue = function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
    value = input[[paste0(id, i)]]
    if (is.null(value)) NA else value
    }))
}

output_table <- reactive({
        data.frame(db, calc = shinyValue("input_", 5))
})

output$table <- renderDataTable({ 
  datatable(output_table(), rownames = FALSE, escape = FALSE, selection 
  = 'none', options = list(paging = FALSE, ordering = FALSE, searching 
  = FALSE, preDrawCallback = JS('function() { 
  Shiny.unbindAll(this.api().table().node()); }'), drawCallback = 
  JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
  })
 }

shinyApp(ui = ui, server = server)

Also maybe it helps - I was able to do this if I remove reactive expression from the dataframe and if I write result in another output type(however this is not a solution, since my main purpose is to write it in another column in DataTable):

library(shiny)
library(DT) 

set.seed(21)
db <- data.frame(ent = rep(x = 1,5),
                 group = c("G","M","O","F","L"),
                 val = sample(1:100, 5, replace=TRUE))

ui <- fluidPage(
      titlePanel(paste0("entity - ", unique(db$ent))),
          sidebarLayout(
               sidebarPanel(
                   helpText("Shiny app calculation")
               ),
               mainPanel(
                   DT::dataTableOutput("table"),
                   verbatimTextOutput("text")
               ))
      )


numericText <- function(FUN, id_nums, id_base, label, value, ...) {
                        inputs <- 1:length(id_nums)
                        for (i in 1:length(inputs)) {
                        inputs[i] <- as.character(FUN(paste0(id_base, 
                                     id_nums[i]), label, value, ...))
                        }
return(inputs)
}

inputs <- numericText(numericInput,
                  id_nums = as.character(1:5),
                  id_base = "input_", 
                  label = NULL,
                  value = 0)

db <- data.frame(db,
             num = inputs)


server <- function(input, output, session) {

    shinyValue = function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
    value = input[[paste0(id, i)]]
    if (is.null(value)) NA else value
    }))
}

output_table <- db

output$table <- renderDataTable({ 
  datatable(output_table, rownames = FALSE, escape = FALSE, selection 
  = 'none', options = list(paging = FALSE, ordering = FALSE, searching 
  = FALSE, preDrawCallback = JS('function() { 
  Shiny.unbindAll(this.api().table().node()); }'), drawCallback = 
  JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
  })
 }

output$text <- reactive({shinyValue("input_", 5) * db$val
})


shinyApp(ui = ui, server = server)

Answer 1

I couldn't fully understand your code so I've myself produced another reproducible example based on a bunch of other answers especially this one.

library(shiny)
library(data.table)
library(rhandsontable)

DF = data.frame(num = 1:10, qty = rep(0,10), total = 1:10,
                stringsAsFactors = FALSE)
#DF = rbind(DF, c(0,0,0))

ui = fluidPage(
  titlePanel("Reactive Table "),
  fluidRow(box(rHandsontableOutput("table", height = 400)))  
)
server = function(input, output) {

  data <- reactiveValues(df=DF)



  observe({
    input$recalc
    data$df <- as.data.frame(DF)
  })

  observe({
    if(!is.null(input$table))
      data$df <- hot_to_r(input$table)
  })


  output$table <- renderRHandsontable({
    rhandsontable(data$df)
  })




  output$table <- renderRHandsontable({

      data$df$total       <- data$df$num * data$df$qty
      print(sum(data$df$num*data$df$price) )

    rhandsontable(data$df, selectCallback = TRUE) 
  })


}
shinyApp(ui, server)

The very first idea is to use rhandsontable which is specifically for this kind of purpose.