在数据表输出中添加动态ui答案

【问题标题】：adding dynamic ui in data table output在数据表输出中添加动态ui
【发布时间】：2021-03-25 18:32:03
【问题描述】：

我有一个包含 3 列（名称、编号和状态）的数据表。 Name 列包含所有值，Number 列包含一些缺失值，Status 列包含所有行为空白。我正在尝试在 Status 列的空白行中添加动态生成的 ui,(selectInput) 并将其显示为数据表输出。

我的代表-

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)

【问题讨论】：

我误解了你的问题！
没问题。你能帮我吗 - stackoverflow.com/questions/66704069/…

标签： r shiny

【解决方案1】：

我在 Rcommunity

中找到了解决方案

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]]))
    })
  }
)

【讨论】：