Adding dynamic ui in data table output

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)

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)

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

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.

This post was flagged by the community and is temporarily hidden.

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

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.