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

Question

我想默认使用数据框中的一列显示数据 table，然后让用户使用拖放包 sortable 填充数据框中的其他列。

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

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

a <- c("13232","24343","A434535") 
b <- c("fsf","dfgds","ggdf")
c <- c("13232","24343","A434535") 
d <- c("fsf","dfgds","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)

虽然这很好用。当我尝试以模块化格式实现它时，数据 table 无法更新。

ui

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 = "bucket_list_group",
               orientation = "horizontal",
               add_rank_list(
                 text = "Contents Of Data Table",
                 labels = NULL,
                 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$p("Table"),
               DT::dataTableOutput(ns('table'))
             )
           )
  )

服务器

sort_server <- function(input, output, session,globalSession){
  ns <- session$ns
  a <- c("13232","24343","A434535") 
  b <- c("fsf","dfgds","ggdf")
  c <- c("13232","24343","A434535") 
  d <- c("fsf","dfgds","ggdf")
  
  data <-  data.frame(a,b,c,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)

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

Answer 1

您的代码存在一些问题：

UI 部分的括号不正确
您还需要对 bucket_list 中的 ID 使用 ns，即 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")
                   ),
                   add_rank_list(
                     text = "Contents Of Data Table",
                     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","24343","A434535") 
  d <- c("fsf","dfgds","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, output, session) {
  callModule(sort_server, "my_sort_module")
}

shinyApp(ui, server)

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

Passing reactive data table server to ui in modular shiny app

r

shiny

jquery-ui-sortable

dt

shinymodules