Generate datatable values dynamically based on inputs from another column - r

Question

I have created a datatable which has selectInput widgets in one of the columns. Another column of the datatable should take inputs given in the first column, and use them to look up a number from my data source. The inputs are binding correctly in Shiny, by using preDrawCallback and drawCallback functions, but lookup values are not updating when the inputs change. Strangely, they do update when I do the lookup in a separate data table. A reproducible example is here:
library(shiny)
library(DT)
data <- data.frame(c(1:7),c(21:27))
shinyApp(
server = shinyServer(function(input, output) {
output$table <- DT::renderDataTable({
Rows <- c(1:7)
temp <- data.frame(Rows)
temp[,"Item"] <- ""
temp[,"Value"] <- ""
temp$Rows <- NULL
sapply(1:7, FUN = function(i) {
temp$Item[i] <<- as.character(selectInput(paste("Item.1.1",i, sep = "."), "",
choices = setNames(c(1:7),c(1:7)),
selected = 1,
multiple = FALSE))
})
sapply(1:7, FUN = function(i) {
temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
})
datatable(temp, escape = FALSE, rownames = FALSE,
options = list(sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',
columnDefs = list(list(className = 'dt-center', targets = 0:1)),
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
))
}, server = FALSE)
}),
ui = fluidPage(
dataTableOutput("table")
)
)
That gives the error "Error in temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1", :
replacement has length zero".
I have tried adding this to server:
test <- reactive({
data.frame(c(ifelse(is.null(input$Item.1.1.1),"",data[eval(parse(text = paste("input$Item.1.1",1, sep = "."))),2]),
ifelse(is.null(input$Item.1.1.2),"",data[input$Item.1.1.2,2]),
ifelse(is.null(input$Item.1.1.3),"",data[input$Item.1.1.3,2]),
ifelse(is.null(input$Item.1.1.4),"",data[input$Item.1.1.4,2]),
ifelse(is.null(input$Item.1.1.5),"",data[input$Item.1.1.5,2]),
ifelse(is.null(input$Item.1.1.6),"",data[input$Item.1.1.6,2]),
ifelse(is.null(input$Item.1.1.7),"",data[input$Item.1.1.7,2])))
})
Then, when I comment out the appropriate sapply within my renderDataTable and instead assign temp[,"Value"] <- test(), I get 21 down the second column of my datatable, and it does not change when the selectInputs are changed.
As a test, I have tried including this in my serve, coupled with a corresponding dataTableOutput() in my ui:
output$test1 <- DT::renderDataTable({
test()
})
test1 behaves as expected if and only if the second sapply is commented out inside of renderDataTable. If it is not commented out, both tables have a column of unresponsive 21s.
This has been driving me batty all day, so any thoughts would improve my life greatly!

Answer 1

You are using the select input values too early:
sapply(1:7, FUN = function(i) {
temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
})
By the time you use these values, the select inputs have not even been rendered on the page yet, so not surprisingly, you get NULL's. You cannot assign NULL to tmp$Value[i].
Then regarding the failure with:
temp[,"Value"] <- test()
I don't understand what this means: test() returns a data frame, and temp[, "Value"] is a vector. I think you should use c() instead of data.frame() in the reactive.
Something off-topic since I really cannot help it: it is almost always a bad idea to use eval(parse(text = ...)). You can just use input[paste("Item.1.1", i, sep = ".")] instead of constructing the R code and eval() it. Both input$foo and input['foo'] give you the value of the input with id foo. The latter form is more suitable in this case.