更新闪亮模块中的数据选择点

发布于 2025-02-08 06:03:48 字数 3873 浏览 2 评论 0原文

我面临着更新使用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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

殤城〤 2025-02-15 06:03:48

尝试一下

version <- 0.1

# GENERAL PARAMETERS

box.height <<- 500
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(150, mean = 1))
men1_2.pois <<- as.numeric(rpois(150, 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)
  tagList(
    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(
        switch(data_selected(),
               "Data 1" = "1",
               "Data 2" = "2")
      )
      observe({print(dt())})
      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){
  moduleServer(
    id,
    function(input, output, session) {
      #x <- reactive(as.numeric(data))
      
      output$plot <- renderPlot({
        x <- as.numeric(data())
        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 = data1$data )
  
  # Plot
  
  # menu1
  PlotServer("hist_norm1", data = reactive(d1$norm()) )
  PlotServer("hist_pois1", data = reactive(d1$pois()) )
}

shinyApp(ui, server)

Try this

version <- 0.1

# GENERAL PARAMETERS

box.height <<- 500
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(150, mean = 1))
men1_2.pois <<- as.numeric(rpois(150, 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)
  tagList(
    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(
        switch(data_selected(),
               "Data 1" = "1",
               "Data 2" = "2")
      )
      observe({print(dt())})
      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){
  moduleServer(
    id,
    function(input, output, session) {
      #x <- reactive(as.numeric(data))
      
      output$plot <- renderPlot({
        x <- as.numeric(data())
        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 = data1$data )
  
  # Plot
  
  # menu1
  PlotServer("hist_norm1", data = reactive(d1$norm()) )
  PlotServer("hist_pois1", data = reactive(d1$pois()) )
}

shinyApp(ui, server)
北城半夏 2025-02-15 06:03:48

出现问题是因为您传递给plotserver的数据没有反应性。我已经进行了其他更改:

  • 将数据存储在开始列表中,以避免使用get;直接与数据对象合作更容易,更安全,
  • loaddataserver中删除data_selected参数,因为此信息由input> Input $ data.sel 变量,但是,仅在模块中而不是主应用程序服务器中才能访问。对于初始化,您仅需要在模块的UI部分(您已经实现的)中需要此信息。这使我可以在您的主应用程序 server 中删除代码,因为该模块处理了这一点。
# Libraries

# pacman::p_load(shiny, shinydashboard,
#                tidyverse, data.table, DT, stringr,
#                ggplot2, plotly,
#                survival, survminer, GGally, scales,
#                shinycssloaders)

library(shiny)
library(shinydashboard)
library(ggplot2)

version <- 0.1

# GENERAL PARAMETERS

box.height <<- 700
select.box.height <<- 150
selectAB.box.height <<- 250
select.box.width <<- 12

# Data

data_object <- list(
  men1_1 = list(
    norm = as.numeric(rnorm(50)),
    pois = as.numeric(rpois(50, lambda = 1))
  ),
  men1_2 = list(
    norm = as.numeric(rnorm(50, mean = 1)),
    pois = as.numeric(rpois(50, lambda = 2))
  )
)

# ui modules

LoadDataUI <- function(id, 
                       label = "Select the data:", 
                       sel = "Data 1", 
                       choic = c('Data 1' = "1",'Data 2'  = "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
){
  moduleServer(
    id,
    function(input, output, session){
      
      data <- reactiveValues(norm = NULL,
                             pois = NULL)
      observeEvent(input$data.sel, {
        data$norm <- data_object[[paste0(menu(), "_", input$data.sel)]][["norm"]]
        data$pois <- data_object[[paste0(menu(), "_", input$data.sel)]][["pois"]]
      }) 
      
      return(
        data
      )
    }
  )
}


PlotServer <- function(id,data = NULL){
  moduleServer(
    id,
    function(input, output, session) {
      output$plot <- renderPlot({
        hist(data(), col = 'darkgray', border = 'white')
      })
    }
  )
}


# server

server <- function(input, output, session){
  
  d1 <- LoadDataServer("data1", menu = reactive({input$sbMenu}))
  
  # Plot
  
  # menu1
  output$plot <- PlotServer("hist_norm1", data = reactive({d1$norm}))
  output$plot <- PlotServer("hist_pois1", data = reactive({d1$pois}))
}

shinyApp(ui, server)

如果将完整的d1将对象传递到plotserver,则可以删除reactive({})您当前需要传递> NormPOIS数据。

我建议您阅读如何传递模块和模块封码之间的数据,您可以从掌握闪亮<< /a>或我的模块介绍

The problem arises because the data you pass to the PlotServer is not reactive. I've made the additional changes:

  • stored the data in the beginning in a list to avoid using get; it's easier and safer to directly work with a data object
  • removed the data_selected argument from the LoadDataServer as this information is determined by the input$data.sel variable, however this is only accessible from within the module and not the the main app server. For the initialisation, you need this information only in the UI part of the module (which you already have implemented). This allows me to remove observeEvent code in your main app server as this is handled by the module.
# Libraries

# pacman::p_load(shiny, shinydashboard,
#                tidyverse, data.table, DT, stringr,
#                ggplot2, plotly,
#                survival, survminer, GGally, scales,
#                shinycssloaders)

library(shiny)
library(shinydashboard)
library(ggplot2)

version <- 0.1

# GENERAL PARAMETERS

box.height <<- 700
select.box.height <<- 150
selectAB.box.height <<- 250
select.box.width <<- 12

# Data

data_object <- list(
  men1_1 = list(
    norm = as.numeric(rnorm(50)),
    pois = as.numeric(rpois(50, lambda = 1))
  ),
  men1_2 = list(
    norm = as.numeric(rnorm(50, mean = 1)),
    pois = as.numeric(rpois(50, lambda = 2))
  )
)

# ui modules

LoadDataUI <- function(id, 
                       label = "Select the data:", 
                       sel = "Data 1", 
                       choic = c('Data 1' = "1",'Data 2'  = "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
){
  moduleServer(
    id,
    function(input, output, session){
      
      data <- reactiveValues(norm = NULL,
                             pois = NULL)
      observeEvent(input$data.sel, {
        data$norm <- data_object[[paste0(menu(), "_", input$data.sel)]][["norm"]]
        data$pois <- data_object[[paste0(menu(), "_", input$data.sel)]][["pois"]]
      }) 
      
      return(
        data
      )
    }
  )
}


PlotServer <- function(id,data = NULL){
  moduleServer(
    id,
    function(input, output, session) {
      output$plot <- renderPlot({
        hist(data(), col = 'darkgray', border = 'white')
      })
    }
  )
}


# server

server <- function(input, output, session){
  
  d1 <- LoadDataServer("data1", menu = reactive({input$sbMenu}))
  
  # Plot
  
  # menu1
  output$plot <- PlotServer("hist_norm1", data = reactive({d1$norm}))
  output$plot <- PlotServer("hist_pois1", data = reactive({d1$pois}))
}

shinyApp(ui, server)

If you pass the complete d1 object to the PlotServer, you could remove the reactive({}) you currently need to pass the norm or pois 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.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文