r - 在模块化闪亮应用程序中将反应式数据表服务器传递给 ui
问题描述
我想默认显示一个数据表,其中包含数据框中的一列,然后让用户使用可排序的拖放包从数据框中填充其他列。
通过一个文件闪亮的应用程序运行时,我在这里有一个工作示例。
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)
虽然这工作正常。当我尝试以模块化格式实现这一点时,数据表无法更新。
用户界面
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)
不知道我在这里做错了什么。
解决方案
您的代码存在一些问题:
- UI 部分的括号不正确
- 您还需要对
ns
中的 id 使用bucket_list
,即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)
推荐阅读
- python - Kivy 滑块触发器切换按钮
- python - 从 pandas.read_sql_query().to_dict() 获取下一个键并用于字典理解
- python - 获取元素而不是 xpath 的另一种方法
- fonts - 你能把两种不同的字体组合成一个可变字体轴吗
- firebase-cloud-messaging - Firebase:FCM:Android/iOS 可折叠和不可折叠通知的有效负载语法
- javascript - 从全屏退出时如何停止图像间隔?
- stored-procedures - db2 中等效的表值参数
- javascript - 严重部署错误 ApostropheCMS 垃圾文件夹中的重复密钥错误
- c# - C#如何检测串口物理断开
- cuda - 有没有办法在 Windows 10 上使用 conda 更新 cuda 驱动程序