Question

我创建了一个（用于演示目的，可复制的）闪亮应用程序，其中ui通过单击“加载”按钮创建一些数据（DataPack）（包含两个元素的列表）。该列表的每个元素都是通过lapply函数中的server通过模块绘制的。

该应用正常运行，但是情节却以相反的顺序显示（DataPack$two和rnorm(n)^2与DataPack$one和rnorm(n)）相反，但预计显示为（ lapply(names(DataPack()), function(DataSetName) {...})）。如何按给定的顺序修复此/重复调用模块，该行为的解释是什么？

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的重复Shiny模块的顺序

1 个答案: