模块观察者问题

问题描述 投票：0回答：1

我在一个巨大的应用程序中遇到了观察者和模块的问题。我创建了一个较小的示例。

我想做的事：

  1. 用户做出选择
  2. 数据库调用是根据这些选择完成的 --> MAIN_DATA（不是动态的）
  3. 数据最初由单个单选按钮进行子过滤 --> MAIN_DATA_FILTERED（动态）
  4. 数据根据所选选项卡进行子过滤和显示（每个选项卡都有不同类型的可视化）。 --> MAIN_DATA_FILTERED_FILTERED（动态）

在其中一个可视化（选项卡之一）中，我使用传单作为位置选择器。最初进展顺利：选择一个区域 --> 按该区域过滤数据并以模式显示。

如果我更改了上一个选择菜单中的任何内容（第 4 步），但是我会遇到反应性问题。每次点击 1 次更改 = 1 个模态。 n 个更改 = n 个模态弹出，导致系统崩溃。该问题是由最后一个选择模块中的反应性问题引起的。我通过向该模块添加模态来将问题定位到该模块。这就是示例中所示的内容。

每当我更改此模块时，就会出现问题。

下面是我创建的片段：每当我更改选项卡时，它都会显示模式。将其更改为观察也没有帮助。当 input$tab 更改时，如何更改额外的选择，但确保不会创建额外的观察者？

现在：选项卡中的每个更改都会创建一个额外的观察者，选择中的每个更改都会为传单地图等创建一个额外的观察者。

# Load necessary libraries
library(shiny)
library(dplyr)

# Define the UI for the selections module
# This function creates a select input with multiple selection enabled
selectionsUI <- function(id) {
  ns <- NS(id)
  selectInput(ns("variableSelect"), "Choose some:", choices = c("X", "Z"), multiple = TRUE)
}

# Define the server logic for the selections module
# This function returns the selected variables from the select input
selectionsServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive({
      input$variableSelect
    })
  })
}

# Define the UI for the last selections module
# This function creates a button and an output UI element
lastSelectionsUI <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("infoButton"), "INFORMATION BUG"),
    uiOutput(ns("lastSelector"))
  )
}

# Define the server logic for the last selections module
# This function shows a modal when the button is clicked and updates the last filter based on the selected tab
lastSelectionsServer <- function(id, selectionsSnapshot, selectedTab) {
  moduleServer(id, function(input, output, session) {
    lastFilter <- reactiveVal(NULL)
    observeEvent(input$infoButton, {
      showModal(
        modalDialog(
          title = "This is not working??",
          paste0("Selected tab: ", selectedTab)
        )
      )
    })

    output$lastSelector <- renderUI({
      ns <- session$ns
      if (selectedTab == "Y below zero") {
        tagList(
          selectInput(label = "LAST FILTER", ns("filterAgain"), choices = selectionsSnapshot(), multiple = TRUE)
        )
      } else {
        tagList()
      }
    })

    observe({
      lastFilter(input$filterAgain)
      print(lastFilter())
    })

    return(lastFilter)
  })
}

# Define the UI for the test module
# This function creates a layout with two columns and a tabset panel
testUI <- function(id) {
  ns <- NS(id)
  tagList(
    column(2, uiOutput(ns("lastSelections"))),
    column(6, tabsetPanel(
      id = ns("tab"),
      tabPanel("Y above zero", uiOutput("Y_above_zero")),
      tabPanel("Y below zero", uiOutput(ns("Y_below_zero"))),
    ))
  )
}

# Define the server logic for the test module
# This function creates a reactive expression that filters data based on the selected tab and the last filter
testServer <- function(id, data, selectionsSnapshot) {
  moduleServer(id, function(input, output, session) {
    output$lastSelections <- renderUI({
      ns <- session$ns
      lastSelectionsUI(ns("last"))
    })

    lastFilter <- reactiveVal(NULL)
    observeEvent(input$tab, {
      print("working")
      myFilter <- lastSelectionsServer("last", selectionsSnapshot, input$tab)
      lastFilter(myFilter)
    })

    observe({
      print("*****")
      print(lastFilter())
      print("******")
    })

    # Create a reactive expression that filters data based on the selected tab and the last filter
    filteredData <- reactive({
      df <- data()
      if (input$tab == "Y above zero") {
        df <- df[df$Y > 0, ]
      } else if (input$tab == "Y below zero") {
        df <- df[df$Y <= 0, ]
      }

      # Filter based on the last filter
      if (!is.null(lastFilter())) {
        filterValue <- lastFilter()()
        df <- df %>% select(all_of(filterValue))
      }
      df
    })

    # Add an action button to the UI for each tab
    output$Y_above_zero <- renderUI({
      if (input$tab == "Y above zero") {
        actionButton(ns("showDataAbove"), "Show Data")
      }
    })

    output$Y_below_zero <- renderUI({
      if (input$tab == "Y below zero") {
        ns <- session$ns
        actionButton(ns("showDataBelow"), "Show Data")
      }
    })

    # Show the filtered data in a modal when the button is clicked
    observeEvent(input$showDataAbove, {
      showModal(modalDialog(
        title = "Data where Y is above zero",
        renderTable(filteredData())
      ))
    })

    observeEvent(input$showDataBelow, {
      showModal(modalDialog(
        title = "Data where Y is below zero",
        renderTable(filteredData())
      ))
    })
  })
}

# Define the main page UI
# This function creates a layout with a main filter, an intermediate filter, and a test module
mainPageUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    h1("Main filter"),
    selectionsUI(ns("selections")),
    actionButton(ns("getData"), "Get data from database"),
    tags$hr(),
    tags$br(),
    h1("Intermediate on-the-fly filter"),
    radioButtons(ns("testFilter"), "Filter data", choices = c("X Above zero", "X Below zero")),
    tags$hr(),
    tags$br(),
    wellPanel(fluidRow(testUI(ns("test"))))
  )
}

# Define the main page server
# This function gets data from a database and starts the test server when the test filter is changed
mainPageServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    selections <- selectionsServer("selections")

    observeEvent(input$getData, {
      req(selections)
      print("Getting data from database")
      # Save a snapshot of the selections
      selectionsSnapshot <- reactiveVal(selections())

      # Get some data from a database
      data <- reactive({
        data.frame(X = rnorm(10), Y = rnorm(10), Z = rnorm(10))
      })
      print("Got data from database")
      observeEvent(input$testFilter, {
        # Filter the initial data on the fly
        filteredData <- reactive({
          if (input$testFilter == "X Above zero") {
            data()[data()$X > 0, ]
          } else {
            data()[data()$X <= 0, ]
          }
        })

        # Start the test server inside of this observeEvent
        testServer("test", filteredData, selectionsSnapshot)
      })
    })
  })
}

# Define the shiny server
server <- shinyServer(function(global, input, output, session) {
  observe({
    mainPageServer(("main_page"))
  })
})

# Define the shiny UI
ui <- fluidPage(mainPageUI("main_page"))

# Run the application
shinyApp(ui = ui, server = server)
r shiny
1个回答
0
投票

您在两个服务器模块中的 

ns <- session$ns
中有 
renderUI
。你可以把它们放在外面。接下来，您将在观察者内部定义响应式对象。在这种情况下您可以使用 
eventReactive
。试试这个

# Load necessary libraries
library(shiny)
library(dplyr)

# Define the UI for the selections module
# This function creates a select input with multiple selection enabled
selectionsUI <- function(id) {
  ns <- NS(id)
  selectInput(ns("variableSelect"), "Choose some:", choices = c("X", "Z"), multiple = TRUE)
}

# Define the server logic for the selections module
# This function returns the selected variables from the select input
selectionsServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive({
      input$variableSelect
    })
  })
}

# Define the UI for the last selections module
# This function creates a button and an output UI element
lastSelectionsUI <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("infoButton"), "INFORMATION BUG"),
    uiOutput(ns("lastSelector"))
  )
}

# Define the server logic for the last selections module
# This function shows a modal when the button is clicked and updates the last filter based on the selected tab
lastSelectionsServer <- function(id, selectionsSnapshot, selectedTab) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    lastFilter <- reactiveVal(NULL)
    observeEvent(input$infoButton, {
      showModal(
        modalDialog(
          title = "This is not working??",
          paste0("Selected tab: ", selectedTab)
        )
      )
    })
    
    output$lastSelector <- renderUI({
      if (selectedTab == "Y below zero") {
        tagList(
          selectInput(label = "LAST FILTER", ns("filterAgain"), choices = selectionsSnapshot(), multiple = TRUE)
        )
      } else {
        tagList()
      }
    })
    
    observe({
      lastFilter(input$filterAgain)
      print(lastFilter())
    })
    
    return(lastFilter)
  })
}

# Define the UI for the test module
# This function creates a layout with two columns and a tabset panel
testUI <- function(id) {
  ns <- NS(id)
  tagList(
    column(2, uiOutput(ns("lastSelections"))),
    column(6, tabsetPanel(
      id = ns("tab"),
      tabPanel("Y above zero", uiOutput("Y_above_zero")),
      tabPanel("Y below zero", uiOutput(ns("Y_below_zero"))),
    ))
  )
}

# Define the server logic for the test module
# This function creates a reactive expression that filters data based on the selected tab and the last filter
testServer <- function(id, data, selectionsSnapshot) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    output$lastSelections <- renderUI({
      # ns <- session$ns
      lastSelectionsUI(ns("last"))
    })
    
    lastFilter <- reactiveVal(NULL)
    observeEvent(input$tab, {
      print("working")
      myFilter <- lastSelectionsServer("last", selectionsSnapshot, input$tab)
      lastFilter(myFilter)
    })
    
    observe({
      print("*****")
      print(lastFilter())
      print("******")
    })
    
    # Create a reactive expression that filters data based on the selected tab and the last filter
    filteredData <- reactive({
      df <- data()
      if (input$tab == "Y above zero") {
        df <- df[df$Y > 0, ]
      } else if (input$tab == "Y below zero") {
        df <- df[df$Y <= 0, ]
      }
      
      # Filter based on the last filter
      if (!is.null(lastFilter())) {
        filterValue <- lastFilter()()
        df <- df %>% select(all_of(filterValue))
      }
      df
    })
    
    # Add an action button to the UI for each tab
    output$Y_above_zero <- renderUI({
      if (input$tab == "Y above zero") {
        actionButton(ns("showDataAbove"), "Show Data")
      }
    })
    
    output$Y_below_zero <- renderUI({
      if (input$tab == "Y below zero") {
        ns <- session$ns
        actionButton(ns("showDataBelow"), "Show Data")
      }
    })
    
    # Show the filtered data in a modal when the button is clicked
    observeEvent(input$showDataAbove, {
      showModal(modalDialog(
        title = "Data where Y is above zero",
        renderTable(filteredData())
      ))
    })
    
    observeEvent(input$showDataBelow, {
      showModal(modalDialog(
        title = "Data where Y is below zero",
        renderTable(filteredData())
      ))
    })
  })
}

# Define the main page UI
# This function creates a layout with a main filter, an intermediate filter, and a test module
mainPageUI <- function(id) {
  ns <- NS(id)
  fluidPage(
    h1("Main filter"),
    selectionsUI(ns("selections")),
    actionButton(ns("getData"), "Get data from database"),
    tags$hr(),
    tags$br(),
    h1("Intermediate on-the-fly filter"),
    radioButtons(ns("testFilter"), "Filter data", choices = c("X Above zero", "X Below zero")),
    tags$hr(),
    tags$br(),
    wellPanel(fluidRow(testUI(ns("test"))))
  )
}

# Define the main page server
# This function gets data from a database and starts the test server when the test filter is changed
mainPageServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    selections <- selectionsServer("selections")
    
    # observeEvent(input$getData, {
      # req(selections())
      print("Getting data from database")
      # Save a snapshot of the selections
      selectionsSnapshot <- reactiveVal(selections())
      
      # Get some data from a database
      data <- eventReactive(input$getData,  {
        data.frame(X = rnorm(10), Y = rnorm(10), Z = rnorm(10))
      })
      print("Got data from database")
      # observeEvent(input$testFilter, {
        # Filter the initial data on the fly
        filteredData <- eventReactive(input$testFilter, {
          req(data())
          if (input$testFilter == "X Above zero") {
            data()[data()$X > 0, ]
          } else {
            data()[data()$X <= 0, ]
          }
        })
        
        # Start the test server inside of this observeEvent
        testServer("test", filteredData, selectionsSnapshot)
      # })
    # })
  })
}

# Define the shiny server
server <- shinyServer(function(global, input, output, session) {
  observe({
    mainPageServer(("main_page"))
  })
})

# Define the shiny UI
ui <- fluidPage(mainPageUI("main_page"))

# Run the application
shinyApp(ui = ui, server = server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.