更新闪亮模块中的数据选择点
我面临着更新使用SelectInput和Shiny模块所选数据的问题。用几句话,当我选择要加载到SelectInput面板中的数据时,它会在第一个选择中对其进行更新,但是如果我想从数据集1转到数据集2,则数据将不会更新。 在您的CAND下方找到代码以重现特定问题。
# Libraries
pacman::p_load(shiny, shinydashboard,
tidyverse, data.table, DT, stringr,
ggplot2, plotly,
survival, survminer, GGally, scales,
shinycssloaders)
version <- 0.1
# GENERAL PARAMETERS
box.height <<- 700
select.box.height <<- 150
selectAB.box.height <<- 250
select.box.width <<- 12
# Data
men1_1.norm <<- as.numeric(rnorm(50))
men1_1.pois <<- as.numeric(rpois(50, lambda = 1))
men1_2.norm <<- as.numeric(rnorm(50, mean = 1))
men1_2.pois <<- as.numeric(rpois(50, lambda = 2))
# ui modules
LoadDataUI <- function(id,
label = "Select the data:",
sel = "Data 1",
choic = c('Data 1','Data 2')){
ns <- NS(id)
selectInput(ns("data.sel"),
label = label,
choices = choic,
selected = sel)
}
PlotUI <- function(id){
ns <- NS(id)
plotOutput(ns("plot"))
}
# ui
ui <- dashboardPage(
dashboardHeader(title = paste('My Dashboard',version,sep='')),
dashboardSidebar(
sidebarMenu(
id = "sbMenu",
#Tabs for different data displays
menuItem("1st Menu", tabName = "men1", icon = icon('microscope'))
)
),
dashboardBody(
tabItems(
tabItem(tabName = 'men1',
h2(strong('tab 1')),
fluidRow(
### !!!! TO REMOVE ERROR MESSAGES !!!!
# tags$style(type="text/css",
# ".shiny-output-error { visibility: hidden; }",
# ".shiny-output-error:before { visibility: hidden; }"
#,
box(title='Select data to load:', height= select.box.height, width = select.box.width,
LoadDataUI("data1")
),
box(title='Normal', height=box.height,
PlotUI("hist_norm1")
),
box(title='Poisson', height=box.height,
PlotUI("hist_pois1")
)
)
)
)
)
)
# server modules
Panel <- function(id){
moduleServer(
id,
function(input, output, session) {
return(
list(
data = reactive({input$data.sel})
)
)
}
)
}
LoadDataServer <- function(id, menu, data_selected
){
moduleServer(
id,
function(input, output, session){
dt <- reactive(data_selected)
data <- reactiveValues(norm = NULL,
pois = NULL)
data$norm <- reactive({get(paste0(menu(),"_", dt(), ".norm"), envir = .GlobalEnv)})
data$pois <- reactive({get(paste0(menu(),"_", dt(), ".pois"), envir = .GlobalEnv)})
return(
data
)
}
)
}
PlotServer <- function(id,data = NULL){
moduleServer(
id,
function(input, output, session) {
x <- reactive(as.numeric(data))
output$plot <- renderPlot({
hist(x(), col = 'darkgray', border = 'white')
})
# output$plot <- renderPlot({
# if(is.null(data)){return(NULL)}else{
# hist(data, col = 'darkgray', border = 'white')}
# })
}
)
}
# server
server <- function(input, output, session){
data1 <- Panel("data1")
observeEvent(data1$data(), {
updateSelectInput(session, 'data.sel', selected = input$data.sel)
})
pnl1 <- reactive(
switch(data1$data(),
"Data 1" = "1",
"Data 2" = "2")
)
d1 <- LoadDataServer("data1", menu = reactive({input$sbMenu}), data_selected = pnl1())
# Plot
# menu1
output$plot <- PlotServer("hist_norm1", data = d1$norm())
output$plot <- PlotServer("hist_pois1", data = d1$pois())
}
shinyApp(ui, server)
谢谢!
I am facing an issue in updating the data selected using SelectInput and modules in Shiny. In a few words, when I select the data to be loaded into the selectInput panel, it updates it on the first selection, but if I then want to go from dataset 1 to dataset 2, the data does not update.
Below you cand find the code to reproduce the specific problem.
# Libraries
pacman::p_load(shiny, shinydashboard,
tidyverse, data.table, DT, stringr,
ggplot2, plotly,
survival, survminer, GGally, scales,
shinycssloaders)
version <- 0.1
# GENERAL PARAMETERS
box.height <<- 700
select.box.height <<- 150
selectAB.box.height <<- 250
select.box.width <<- 12
# Data
men1_1.norm <<- as.numeric(rnorm(50))
men1_1.pois <<- as.numeric(rpois(50, lambda = 1))
men1_2.norm <<- as.numeric(rnorm(50, mean = 1))
men1_2.pois <<- as.numeric(rpois(50, lambda = 2))
# ui modules
LoadDataUI <- function(id,
label = "Select the data:",
sel = "Data 1",
choic = c('Data 1','Data 2')){
ns <- NS(id)
selectInput(ns("data.sel"),
label = label,
choices = choic,
selected = sel)
}
PlotUI <- function(id){
ns <- NS(id)
plotOutput(ns("plot"))
}
# ui
ui <- dashboardPage(
dashboardHeader(title = paste('My Dashboard',version,sep='')),
dashboardSidebar(
sidebarMenu(
id = "sbMenu",
#Tabs for different data displays
menuItem("1st Menu", tabName = "men1", icon = icon('microscope'))
)
),
dashboardBody(
tabItems(
tabItem(tabName = 'men1',
h2(strong('tab 1')),
fluidRow(
### !!!! TO REMOVE ERROR MESSAGES !!!!
# tags$style(type="text/css",
# ".shiny-output-error { visibility: hidden; }",
# ".shiny-output-error:before { visibility: hidden; }"
#,
box(title='Select data to load:', height= select.box.height, width = select.box.width,
LoadDataUI("data1")
),
box(title='Normal', height=box.height,
PlotUI("hist_norm1")
),
box(title='Poisson', height=box.height,
PlotUI("hist_pois1")
)
)
)
)
)
)
# server modules
Panel <- function(id){
moduleServer(
id,
function(input, output, session) {
return(
list(
data = reactive({input$data.sel})
)
)
}
)
}
LoadDataServer <- function(id, menu, data_selected
){
moduleServer(
id,
function(input, output, session){
dt <- reactive(data_selected)
data <- reactiveValues(norm = NULL,
pois = NULL)
data$norm <- reactive({get(paste0(menu(),"_", dt(), ".norm"), envir = .GlobalEnv)})
data$pois <- reactive({get(paste0(menu(),"_", dt(), ".pois"), envir = .GlobalEnv)})
return(
data
)
}
)
}
PlotServer <- function(id,data = NULL){
moduleServer(
id,
function(input, output, session) {
x <- reactive(as.numeric(data))
output$plot <- renderPlot({
hist(x(), col = 'darkgray', border = 'white')
})
# output$plot <- renderPlot({
# if(is.null(data)){return(NULL)}else{
# hist(data, col = 'darkgray', border = 'white')}
# })
}
)
}
# server
server <- function(input, output, session){
data1 <- Panel("data1")
observeEvent(data1$data(), {
updateSelectInput(session, 'data.sel', selected = input$data.sel)
})
pnl1 <- reactive(
switch(data1$data(),
"Data 1" = "1",
"Data 2" = "2")
)
d1 <- LoadDataServer("data1", menu = reactive({input$sbMenu}), data_selected = pnl1())
# Plot
# menu1
output$plot <- PlotServer("hist_norm1", data = d1$norm())
output$plot <- PlotServer("hist_pois1", data = d1$pois())
}
shinyApp(ui, server)
Thanks!
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
尝试一下
Try this
出现问题是因为您传递给
plotserver
的数据没有反应性。我已经进行了其他更改:get
;直接与数据对象合作更容易,更安全,loaddataserver
中删除data_selected
参数,因为此信息由input> Input $ data.sel 变量,但是,仅在模块中而不是主应用程序
server 中删除服务器
中才能访问。对于初始化,您仅需要在模块的UI部分(您已经实现的)中需要此信息。这使我可以在您的主应用程序代码,因为该模块处理了这一点。
如果将完整的
d1
将对象传递到plotserver
,则可以删除reactive({})
您当前需要传递> Norm
或POIS
数据。我建议您阅读如何传递模块和模块封码之间的数据,您可以从掌握闪亮<< /a>或我的模块介绍。
The problem arises because the data you pass to the
PlotServer
is not reactive. I've made the additional changes:get
; it's easier and safer to directly work with a data objectdata_selected
argument from theLoadDataServer
as this information is determined by theinput$data.sel
variable, however this is only accessible from within the module and not the the main appserver
. For the initialisation, you need this information only in the UI part of the module (which you already have implemented). This allows me to removeobserveEvent
code in your main appserver
as this is handled by the module.If you pass the complete
d1
object to thePlotServer
, you could remove thereactive({})
you currently need to pass thenorm
orpois
data.I recommend to read into how to pass data between modules and module capsulation, you can start with mastering shiny or my introduction to modules.