具有模块反应性的闪亮仪表板
Shiny Dashboard with Modules reactiveness
您好,我有点卡在 Shiny 仪表板上,我试图将一些功能剥离到 ui(和服务器)模块和子模块中。
我要实现的是这个
library(shiny)
runApp(list(
ui = basicPage(
selectInput("select", "Select columns to display", names(mtcars), multiple =
TRUE),
h2('The mtcars data'),
dataTableOutput('mytable')
),
server = function(input, output) {
output$mytable = renderDataTable({
columns = names(mtcars)
if (!is.null(input$select)) {
columns = input$select
}
mtcars[,columns,drop=FALSE]
})
}
))
到目前为止通过这个嵌入了带有模块(基于傀儡骨架)的 Shinydashbaord ...
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
# app_ui
app_ui <- function(request) {
tagList(
shinydashboardPlus::dashboardPagePlus(
header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
enable_rightsidebar = FALSE),
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
mod_test_sidebar_ui("test_ui_1"))
),
#
body = shinydashboard::dashboardBody(shinydashboard::tabItems(
mod_test_body_ui("test_ui_1"))
)
, rightsidebar = NULL,
, title = "Testing Shiny modules"
)
)
}
# app_server
app_server <- function(input, output, session) {
shiny::moduleServer(id = "test_ui_1", module = mod_test_server)
}
## THE MODULES #######################################################
# the sidebar module
mod_test_sidebar_ui <- function(id) {
ns <- NS(id)
shinydashboard::menuItem("Module Testing",
tabName = "tab_testing_mod",
icon = icon("th"))
}
#---------------------------------
# the body module b/c wanna use tabs I decided to add one more mod layer
mod_test_body_ui <- function(id) {
ns <- NS(id)
shinydashboard::tabItem(tabName = "tab_testing_mod",
mod_test_modules_ui(id)
)
}
# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
ns <- NS(id)
fluidRow(
shinydashboard::box(
title = "Select Cols",
selectInput("select", "Select columns", names(mtcars), multiple = TRUE)
)
,
shinydashboard::box(
title = "Data Viewer",
width = 10,
DT::dataTableOutput(ns('data_table'))
)
)
}
#---------------------------------
#module server
mod_test_server <- function(input, output, session) {
ns <- session$ns
output[['data_table']] <- renderDataTable({
#output$data_table <- renderDataTable({
columns = names(mtcars)
if (!is.null(input$select)) {
columns = input$select
}
mtcars[,columns,drop=FALSE]
}, filter = 'top')
}
####################################################################
run_app <- function(...) {
shiny::shinyApp(
ui = app_ui,
server = app_server)
}
#---------------------------------
run_app()
以上是归结为最少代码行的问题,因此它卡在了我现在的同一点上。无论我尝试什么,模块版本都不会像第一个示例那样更新(过滤)所选数据列。
我 quite 确定我没有正确掌握该命名空间上下文(尤其是在服务器端)。我 guess/hope 有人会很容易发现我的错误。
正如@SmokeShakers 所指出的那样
# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
ns <- NS(id)
fluidRow(
shinydashboard::box(
title = "Select Cols",
selectInput("select", "Select columns", names(mtcars), multiple = TRUE)
)
,
shinydashboard::box(
title = "Data Viewer",
width = 10,
DT::dataTableOutput(ns('data_table'))
)
)
}
selectInput("select", ...
在代码行 6 中应该是 selectInput(ns("select"), ...
然后一切顺利运行。
您好,我有点卡在 Shiny 仪表板上,我试图将一些功能剥离到 ui(和服务器)模块和子模块中。 我要实现的是这个
library(shiny)
runApp(list(
ui = basicPage(
selectInput("select", "Select columns to display", names(mtcars), multiple =
TRUE),
h2('The mtcars data'),
dataTableOutput('mytable')
),
server = function(input, output) {
output$mytable = renderDataTable({
columns = names(mtcars)
if (!is.null(input$select)) {
columns = input$select
}
mtcars[,columns,drop=FALSE]
})
}
))
到目前为止通过这个嵌入了带有模块(基于傀儡骨架)的 Shinydashbaord ...
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
# app_ui
app_ui <- function(request) {
tagList(
shinydashboardPlus::dashboardPagePlus(
header = shinydashboardPlus::dashboardHeaderPlus(title = "module_test",
enable_rightsidebar = FALSE),
sidebar = shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
mod_test_sidebar_ui("test_ui_1"))
),
#
body = shinydashboard::dashboardBody(shinydashboard::tabItems(
mod_test_body_ui("test_ui_1"))
)
, rightsidebar = NULL,
, title = "Testing Shiny modules"
)
)
}
# app_server
app_server <- function(input, output, session) {
shiny::moduleServer(id = "test_ui_1", module = mod_test_server)
}
## THE MODULES #######################################################
# the sidebar module
mod_test_sidebar_ui <- function(id) {
ns <- NS(id)
shinydashboard::menuItem("Module Testing",
tabName = "tab_testing_mod",
icon = icon("th"))
}
#---------------------------------
# the body module b/c wanna use tabs I decided to add one more mod layer
mod_test_body_ui <- function(id) {
ns <- NS(id)
shinydashboard::tabItem(tabName = "tab_testing_mod",
mod_test_modules_ui(id)
)
}
# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
ns <- NS(id)
fluidRow(
shinydashboard::box(
title = "Select Cols",
selectInput("select", "Select columns", names(mtcars), multiple = TRUE)
)
,
shinydashboard::box(
title = "Data Viewer",
width = 10,
DT::dataTableOutput(ns('data_table'))
)
)
}
#---------------------------------
#module server
mod_test_server <- function(input, output, session) {
ns <- session$ns
output[['data_table']] <- renderDataTable({
#output$data_table <- renderDataTable({
columns = names(mtcars)
if (!is.null(input$select)) {
columns = input$select
}
mtcars[,columns,drop=FALSE]
}, filter = 'top')
}
####################################################################
run_app <- function(...) {
shiny::shinyApp(
ui = app_ui,
server = app_server)
}
#---------------------------------
run_app()
以上是归结为最少代码行的问题,因此它卡在了我现在的同一点上。无论我尝试什么,模块版本都不会像第一个示例那样更新(过滤)所选数据列。 我 quite 确定我没有正确掌握该命名空间上下文(尤其是在服务器端)。我 guess/hope 有人会很容易发现我的错误。
正如@SmokeShakers 所指出的那样
# the ('additional') body_ui "content" module
mod_test_modules_ui <- function(id) {
ns <- NS(id)
fluidRow(
shinydashboard::box(
title = "Select Cols",
selectInput("select", "Select columns", names(mtcars), multiple = TRUE)
)
,
shinydashboard::box(
title = "Data Viewer",
width = 10,
DT::dataTableOutput(ns('data_table'))
)
)
}
selectInput("select", ...
在代码行 6 中应该是 selectInput(ns("select"), ...
然后一切顺利运行。