在模块化闪亮应用程序中将反应式数据表服务器传递给 ui

问题描述

默认情况下，我想显示一个数据表，其中包含数据框中的一列，然后让用户使用可排序的拖放包填充数据框中的其他列。

通过一个文件闪亮的应用程序运行时，我在这里有一个工作示例。

   library(shiny)
library(sortable)
library(DT)

a <- c("13232","24343","A434535") 
b <- c("fsf","dfgds","ggdf")
c <- c("13232","A434535") 
d <- c("fsf","ggdf")

data <-  data.frame(a,b,c,d)

ui <- fluidPage(
  tags$head(
    tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
  ),fluidRow(
    tags$b("Data Table"),width = 12,bucket_list(
      header = "Drag the items in any desired bucket",group_name = "bucket_list_group",orientation = "horizontal",add_rank_list(
        text = " Specific Variables",labels = colnames(data),input_id = "rank_list_1"
      ),add_rank_list(
        text = "Contents Of Data Table",labels = NULL,input_id = "rank_list_2"
      ))
  ),fluidRow(
    column(
      width = 12,tags$b("Result"),column(
        width = 12,tags$p("Table"),DTOutput('tbl')
      )
    )
  )
)

server <- function(input,output) {
  output$tbl = renderDT(cbind(data[1],data[,c(input$rank_list_2)]),options = list(lengthChange = FALSE)
  )
}
shinyApp(ui,server)

虽然这工作正常。当我尝试以模块化格式实现此功能时，数据表无法更新。

界面

sort_ui <- function(id) {
  ns <- NS(id)
  tagList(
    tabsetPanel(
  tabPanel("Data Table",fluidRow(
             tags$b("Data Table"),bucket_list(
               header = "Drag the items in any desired bucket",add_rank_list(
                 text = "Contents Of Data Table",input_id = "rank_list_1"
               ))
           ),input_id = "rank_list_2"
               ))
           ),fluidRow(
             
             column(
               width = 12,DT::dataTableOutput(ns('table'))
             )
           )
  )

服务器

sort_server <- function(input,output,session,globalSession){
  ns <- session$ns
  a <- c("13232","A434535") 
  b <- c("fsf","ggdf")
  c <- c("13232","A434535") 
  d <- c("fsf","ggdf")
  
  data <-  data.frame(a,d)
  

x <- data[1]
data <- reactive(cbind(x,ihc[,c(input$rank_list_2)]))

output$table = DT::renderDataTable(data(),options = list(stateSave = TRUE)
                                   
)
proxy <- dataTableProxy('table',session = globalSession)
}

我用

调用模块

callModule(sort_server,"my_sort_module",globalSession = session)

不确定我在这里做错了什么。

解决方法

您的代码存在一些问题：

• UI 部分中的括号不正确
• 您还需要将 ns 用于 bucket_list 中的 ID，即 group_name 和 input_id
• 您在服务器部分的数据聚合不完全正确
• 我不确定您为什么使用全局会话，我会使用默认值，以便模块能够顺利运行

library(shiny)
library(sortable)
library(DT)

sort_ui <- function(id) {
  ns <- NS(id)
  tagList(
    tabsetPanel(
      tabPanel("Data Table",fluidRow(
                 tags$b("Data Table"),width = 12,bucket_list(
                   header = "Drag the items in any desired bucket",group_name = ns("bucket_list_group"),orientation = "horizontal",add_rank_list(
                     text = "Contents Of Data Table",labels = colnames(data),input_id = ns("rank_list_1")
                   ),labels = NULL,input_id = ns("rank_list_2")
                   ))
               ),fluidRow(
                 
                 column(
                   width = 12,tags$p("Table"),DT::dataTableOutput(ns('table'))
                 )
               )
      )
    )
  )
}

sort_server <- function(input,output,session){
  ns <- session$ns
  a <- c("13232","24343","A434535") 
  b <- c("fsf","dfgds","ggdf")
  c <- c("13232","A434535") 
  d <- c("fsf","ggdf")
  
  data <- data.frame(a,b,c,d)
  
  table_data <- reactive({
    cbind(data[1],data[,c(input$rank_list_2)])
  })
  
  output$table = DT::renderDataTable(table_data(),options = list(stateSave = TRUE)
                                     
  )
  proxy <- dataTableProxy('table')
}

ui <- fluidPage(
  tags$head(
    tags$style(HTML(".bucket-list-container {min-height: 350px;}"))
  ),sort_ui("my_sort_module")
  
)

server <- function(input,session) {
  callModule(sort_server,"my_sort_module")
}

shinyApp(ui,server)