Adding dynamic ui in data table output

[Ankush]

Hi all, I have a data table with 3 Columns (Name, Number and Status). Name column has all values, Number column has some missing values and Status column have all rows as blanks.
I am trying to add dynamically generated ui,(selectInput), in the blank rows of Status column and show it as a datatable output.
My reprex-

library(reshape2)
library(reshape)
library(tidyverse)
library(dplyr)
library(shiny)
library(shinydashboard)
library(magrittr)
library(devtools)
library(devtools)

ui<- fluidPage({
  fluidRow(4,
           DTOutput("dt"))
})


server<- function(input, session, output)
{
#Creating reactive data table(as my datatable is also dynamically generated in real project)
  dt<- reactive({
    dt<- data.table("Name"=c("A", "B", "C", "D", "E", "F", "G"), "Number"=c(1,2,3,4,"",6, ""),"status"=c(rep(NA, 7)),stringsAsFactors = F)
 return(dt)
     })

# Creating dynamic selectInput
  slct<- reactive({
    lapply(1:nrow(dt()), function(i)
    {
     selectInput(paste("a",i), "Status", c("Open", "Close")) 
    })
  })
  
#Check for blank condition of Status column and adding dynamic selectInput in blanks
  opt<- reactive({
    ifelse(dt()$status=="NA", slct(), dt()$status)
  })
  
# Data table output
  observe({
    output$dt<- renderDataTable({
     opt()
    })
  })
  
}

shinyApp(ui,server)

[nirgrahamuk]

You are trying to do something quite complicated, it requires js callbacks in DT and use of bind and unbind etc.
Here is an example

library(shiny)
library(DT)
shinyApp(
  ui <- fluidPage(
    title = 'Slider Inputsa table',
    DT::dataTableOutput('foo'),
    verbatimTextOutput('sel')
  ),
  server <- function(input, output, session) {
    m <- matrix(
      1:12, nrow = 12, ncol = 1, byrow = TRUE,
      dimnames = list(month.abb, "initial_slider_values")
    )
    m2 <- m
    for (i in seq_len(nrow(m))) {

      m2[i, ] <-selectInput(inputId = month.abb[i],
                          label = month.abb[i],
                          choices = c(m[i, ],m[i, ]-1),
                          selected = m[i,]) %>% as.character
      }
    m2
    output$foo = DT::renderDataTable(
      m2, escape = FALSE, selection = 'none', server = FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS("table.rows().every(function(i, tab, row) {
          var $this = $(this.node());
          $this.attr('id', this.data()[0]);
          $this.addClass('shiny-input-slider-input');
        });
        Shiny.unbindAll(table.table().node());
        Shiny.bindAll(table.table().node());")
    )
    output$sel <- renderPrint({
      str(sapply(month.abb, function(i) input[[i]]))
    })
  }
)

I adapted this from
Radio buttons in a table (shinyapps.io)

[Ankush]

Hi Nir, It's working as expected Could you help me understand this more precisely?? Like why did you change the selectInput to as.character and the JS part?

[nirgrahamuk]

datatable cells can contain text or numbers, in this case you want text that is escapable (i.e. interpratble HTML) so casting the output of the shiny tags gives us the html text code for placing the input widgets.

[nirgrahamuk]

no its too big for me, I only look at minimal codes.