使用 lapply 和 insertUI 重复闪亮模块的顺序

Question

我创建了一个闪亮的应用程序（出于演示目的可重现），其中 ui 通过单击 "Load" 按钮创建了一些数据 (DataPack)（包含两个元素的列表） .此列表的每个元素都是通过使用 server 函数中的 lapply 的模块绘制的。

该应用程序有效，但是，情节以相反的顺序出现（DataPack$two 和 rnorm(n)^2 在 DataPack$one 和 rnorm(n) 之前）但预计将显示为称为 (lapply(names(DataPack()), function(DataSetName) {...}))。我如何修复 this/repeat 以完全给定的顺序调用模块以及该行为的解释是什么？

library(shiny)
library(TTR)

Module_ui <- function(id) {
  ns <- shiny::NS(id)
  shiny::uiOutput(ns("Plot"))
}

Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData, xlim) {

  AnalysedPack <- eventReactive(c(
    InputButton_GetData(),
    input$InputButton_ProcessData), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <-
        runMean(DataPack()[[DataSetName]],
                min(input$NumericInput_BW,
                    length(DataPack()[[DataSetName]])))

      return(AnalysedPack)

    })

  output[['Plot']] <- renderUI({

    ns <- session$ns

    tags$div(
      id = environment(ns)[['namespace']],
      tagList(
        fluidRow(
          column(2, column(12, fluidRow(
            numericInput(
              inputId = ns("NumericInput_BW"),
              label   = NULL,
              min     = 1,
              max     = 100,
              value   = 10,
              step    = 1))),
            fluidRow(
              column(12, actionButton(
                ns("InputButton_ProcessData"),
                "Process", width = "100%")))),
          column(10, 
                 renderPlot({
                   message(paste("Base_Plot", DataSetName))
                   plot(DataPack()[[DataSetName]],
                        xlim = c(xlim()[1],
                                 xlim()[2]))
                   lines(AnalysedPack(),
                         col = "tomato", lwd = 2)
                 }) ) )
      )
    )

  })

}



ui <- fluidPage(

  fluidRow(

    column(
      6,
      column(
        12,
        fluidRow(h4("Data Generation")),
        fluidRow(actionButton(
          "InputButton_GetData", "Load", width = "100%")))),

    column(
      6,
      column(
        12,
        fluidRow(h4("Update Plot")),
        sliderInput(
          "SliderInput_xAxis",
          label = NULL,
          min = 0,
          max = 150,
          value = c(0, 150),
          animate = TRUE)
      )
    ),
    column(12, actionButton('addButton', '', icon = icon('plus')))

  )

)



server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  SliderInput_xAxis_rx   <-
    reactive(input$SliderInput_xAxis)
  InputButton_GetData_rx <-
    reactive(input$InputButton_GetData)

  observeEvent(input$InputButton_GetData, {
    lapply(names(DataPack()), function(DataSetName) {

      id <- sprintf('Plot%s', DataSetName)

      insertUI(
        selector = "#addButton",
        where = "afterEnd",
        ui = Module_ui(id)
      )
      callModule(
        Module_Server, id,
        DataPack            = DataPack,
        DataSetName         = DataSetName,
        InputButton_GetData = InputButton_GetData_rx,
        xlim                = SliderInput_xAxis_rx)

    })
  })

}



shinyApp(ui, server)

Answer 1

此代码：

  insertUI(
    selector = "#addButton",
    where = "afterEnd",
    ui = Module_ui(id)
  )

在元素 #addButton 之后插入 UI。所以第一次调用生成，示意性地：

#addButton
ui1

而第二次调用与第一次调用一样，在 #addButton 之后插入，而不是在 ui1 之后插入：

#addButton
ui2
ui1

所以，颠倒名字。

使用 lapply 和 insertUI 重复闪亮模块的顺序

Order of repeated Shiny Modules using lapply and insertUI

r

shiny

shiny-reactivity

shinyapps

shinymodules