r-在数据表输出中添加动态ui

Question

我有一个包含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)

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