Рендеринг динамически загруженного интерфейса в цикле показывает только последнее значение

Question

У меня есть приложение Shiny, которое динамически загружает любое количество outputPlot интерфейсов. В следующем примере я просто перебираю первые три буквы алфавита.

Чтобы отобразить график в динамически загружаемых интерфейсах, я вызываю renderPlot в цикле следующим образом:

for (a in LETTERS[1:3]) {
 output[[paste0('p',a)]] <-  renderPlot(plot.df(df, a))
}   

, но в результате все три выходных графика (pA, pB и pC) все отображаются с plot.df(df, 'C')). Мне кажется, renderPlot отображается после завершения цикла и a = 'C'. Вместо этого выходные интерфейсы pA, pB и pC должны были отображаться с plot.df(df, 'A'), plot.df(df, 'B') и plot.df(df, 'C') соответственно. Но это явно не тот случай при просмотре вывода.

У меня был предыдущий успех с этим, если выходной интерфейс был модулем и в цикле вызывал callModule, что каким-то образом вызывало оценку аргументов. Но сейчас я пытаюсь избежать создания отдельного модуля для моего выходного интерфейса.

Полный воспроизводимый пример

library(shiny)
library(dplyr)

# Define UI for application that draws a histogram
ui <- fluidPage(
    plotOutput('pltA'),plotOutput('pltB'),plotOutput('pltC'),
    tags$hr(),
    tags$div(id='placeholder')
)

col <- c(A='#66bd63', B='#fdae61', C='#74add1')
plot.df <- function(df, a) {
    #browser()
    df <- filter(df, letter==a)
    if (nrow(df) == 0) return()
    plot(df$i, df$y, type='p', col=col[a], pch=19, main=a)
}

# Define server logic required to draw a histogram
server <- function(input, output, session) {

    my_data <- reactiveVal(data.frame())
    autoInvalidate <- reactiveTimer(2000)

    # Generate some random data and assign to one of three different letters:
    observe({
        autoInvalidate()

        a <- sample(LETTERS[1:3], 1)
        data.frame(y=rnorm(5), letter=a) %>%
            bind_rows(isolate(my_data())) %>%
            group_by(letter) %>%
            mutate(i=seq_along(y)) %>%
            my_data
    })

    # Proof of function making a plot.
    output$pltA <- renderPlot(plot.df(my_data(), 'A'))
    output$pltB <- renderPlot(plot.df(my_data(), 'B'))
    output$pltC <- renderPlot(plot.df(my_data(), 'C'))

    # Dynamically load output UIs.
    observe({
      let <- unique(my_data()$letter)
      if (is.null(let)) return()

      for (l in let) {
          if (is.null(session$clientData[[paste0('output_p',l,'_hidden')]])) {
              insertUI('#placeholder', 'beforeEnd', ui=plotOutput(paste0('p',l)))
          }
      }
    })

    # Update dynamically loaded plots
    observe({
        df <- my_data()
        if (nrow(df) == 0) return()

        for (a in LETTERS[1:3]) {
            cat('Updating ', a, '\n')
            output[[paste0('p',a)]] <- renderPlot(plot.df(df, a))
        }
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

Вы должны использовать local (см. здесь ).

for (a in LETTERS[1:3]) {
  local({
    aa <- a
    output[[paste0('p',aa)]] <- renderPlot(plot.df(df, aa))
  })
}