r语言 - 在DT:反应表中嵌入混合数字输入和选择输入的列

Question

目前的问题与我之前的问题有关，关于在DT中嵌入带有混合数字输入和选择输入的列。

提供的解决方案工作得很好，但是当我使用反应表时就会出现问题。

更详细地说，我有一个主表(Project表)。在选择一行之后，将过滤第二个表，生成一个反应表(子项目表)，其中嵌入了带有numericInput和selectInput的列。它工作正常，但是当我在项目表中选择新行时，子项目表中的嵌入列没有更新。

我怀疑这个问题与JS代码执行的列绑定有关，但由于我对JS一无所知，因此我不可能找出答案。

感谢您的宝贵时间!下面是一个示例代码:

library(shiny)
library(shinydashboard)
library(DT)
library(tidyverse)
# data
df=structure(list(Project = c("P1", "P1", "P2", "P2", "P1", "P1", 
"P2", "P2", "P1", "P1", "P2", "P2", "P1", "P1", "P2", "P1"), 
sub.proj = c("sp1", "sp2", "sp3", "sp4", "sp1", "sp2", "sp3", 
"sp4", "sp1", "sp2", "sp3", "sp4", "sp1", "sp2", "sp4", "sp1"
), Param.Type = c("SimCat", "SimCat", "SimCat", "SimCat", 
"SimCat", "SimCat", "SimCat", "SimCat", "SimNum", "SimNum", 
"SimNum", "SimNum", "SimNum", "SimNum", "SimNum", "SimNum"
), PARAM = c("v1", "v1", "v1", "v1", "v2", "v2", "v2", "v2", 
"v3", "v3", "v3", "v3", "v4", "v4", "v4", "v5"), measurement = c("v11", 
"v12", "v13", "v14", "v21", "v22", "v23", "v24", "1", "2", 
"3", "4", "11", "12", "13", "100")), row.names = c(NA, -16L
), class = c("tbl_df", "tbl", "data.frame"))
# Prject table
df1=df %>% select("Project" , "sub.proj" ) %>% unique()
# sub-proj table
df2=df 
# params table : gives choices for selectInput for categorical PARAM
aa=df %>% select("PARAM", "measurement" ,"Param.Type" ) %>% unique() %>% filter(PARAM %in% c("v1","v2")) %>% rename(choice.val=measurement, Param.Name=PARAM)


ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(),

dashboardBody(

tabsetPanel(
tabPanel('Triplets', 
fluidRow(

hr(),
column(12, 
dataTableOutput('project_table'), 
actionButton("go", "TEST"),
verbatimTextOutput('sel'),
dataTableOutput('subproject_table'),

dataTableOutput('test_table'))


)
)
)
)
)

# SERVER -----------------------------------

server <- function(input, output) { 



output$project_table <- renderDataTable(df1, options = list(pageLength = 10))


vars.long.sel.df <- reactive({



s=input$project_table_rows_selected

print(s)

project <- unique(df1[s,c("Project")])
vars.long.sel=df2 %>% filter(Project%in%project)  %>% mutate(test.val=NA) %>% rowid_to_column("row")


for (i in 1:nrow(vars.long.sel)) {


if (vars.long.sel$Param.Type[i]=="SimCat") {


vars.long.sel$test.val[i] <- as.character(selectInput(paste0("sel", vars.long.sel$row[i]), "", choices =aa$choice.val[aa$Param.Name==vars.long.sel$PARAM[i]],selected = vars.long.sel$measurement[i], width = "100px"))
} else {
vars.long.sel$test.val[i] <- as.character(numericInput(paste0("sel",vars.long.sel$row[i]), "", value=as.numeric(vars.long.sel$measurement[i]), width = "100px"))
}
}

vars.long.sel


})



output$subproject_table <- DT::renderDataTable({

req(input$project_table_rows_selected)
vars.long.sel.df()


},
escape = FALSE, selection = 'none', server = F,
options = list( dom = 'Bfrtip', paging = FALSE, ordering = FALSE, buttons = c( 'excel')), extensions = 'Buttons'
,
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)



#   # TEST btn --------------------------

output$sel = renderPrint({
str(sapply(1:nrow(vars.long.sel.df()), function(i) input[[paste0("sel", i)]]))
})




}
shinyApp(ui, server)

Answer 1

这看起来和这个问题是一样的。我没有尝试过，因为你的帖子中没有包括library()电话。试:

ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(),

dashboardBody(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),

tabsetPanel(
tabPanel('Triplets', 
fluidRow(
hr(),
column(12, 
DTOutput('project_table'), 
actionButton("go", "TEST"),
verbatimTextOutput('sel'),
DTOutput('subproject_table'),
DTOutput('test_table'))
)
)
)
)
)

# SERVER -----------------------------------
server <- function(input, output, session) { 

output$project_table <- renderDT(df1, options = list(pageLength = 10))

vars.long.sel.df <- reactive({
s=input$project_table_rows_selected
print(s)
project <- unique(df1[s,c("Project")])
vars.long.sel=df2 %>% filter(Project%in%project)  %>% mutate(test.val=NA) %>% rowid_to_column("row")
for (i in 1:nrow(vars.long.sel)) {
if (vars.long.sel$Param.Type[i]=="SimCat") {
vars.long.sel$test.val[i] <- as.character(selectInput(paste0("sel", vars.long.sel$row[i]), "", choices =aa$choice.val[aa$Param.Name==vars.long.sel$PARAM[i]],selected = vars.long.sel$measurement[i], width = "100px"))
} else {
vars.long.sel$test.val[i] <- as.character(numericInput(paste0("sel",vars.long.sel$row[i]), "", value=as.numeric(vars.long.sel$measurement[i]), width = "100px"))
}
}
vars.long.sel
})

observeEvent(vars.long.sel.df(), {
session$sendCustomMessage("unbindDT", "subproject_table")
})

output$subproject_table <- renderDT({
req(input$project_table_rows_selected)
vars.long.sel.df()
},
escape = FALSE, selection = 'none', server = F,
options = list( dom = 'Bfrtip', paging = FALSE, ordering = FALSE, buttons = c( 'excel')), extensions = 'Buttons'
,
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)



#   # TEST btn --------------------------
output$sel = renderPrint({
str(sapply(1:nrow(vars.long.sel.df()), function(i) input[[paste0("sel", i)]]))
})

}

shinyApp(ui, server)