Реактивность динамического числа элементов ui

Question

У меня есть блестящий веб-интерфейс, который загружает произвольное количество данных из базы данных и отображает их. Этот подход очень похож на тот, который предлагается здесь: Add a dynamic UI element in R shiny data table.

Однако число рабочих данных может меняться при работе с интерфейсом, и в этом случае отображаемые данные должны быть перезагружены. Мой подход терпит неудачу с сообщением об ошибке

Ошибка в .getReactiveEnvironment() $ currentContext(): Операция не допускается без активного реактивным контекста. (Вы пытались сделать что-то , что может быть сделано только внутри реактивного выражения или наблюдателя.)

Я пытался построить минимальный пример, который делает ошибку воспроизводимой:

model.R

db <- list() 
getTables <- function(n){ 
    db <<- lapply(seq_len(n), data.frame, a = 1:2, b = LETTERS[1:2]) 
    return(db) 
} 
getTableIndex <- function(){ 
    seq_along(db) 
} 

server.R

library(shiny) 
shinyServer(function(input, output) { 
    db_tables <- getTables(3) 
    db_tab_ix <- getTableIndex() 

    output$tabs <- renderUI({ 
    tables <- lapply(db_tab_ix, function(x){ 
     tableOutput(paste("tab", x, sep="_")) 
    }) 
    tagList(tables) 
    }) 

    for(x in db_tab_ix){ 
    local({ 
     output[[paste("tab", x, sep="_")]] <- renderTable(db_tables[[x]]) 
    }) 
    } 
}) 

ui.R

shinyUI(fluidPage(
    mainPanel(
    uiOutput("tabs"), 
    sliderInput("tabs_no", "Integer:", min=1, max=3, value=1) 
) 
)) 

В этом примере все работает отлично. Проблема возникает при замене линии 3 server.R с

db_tables <- getTables(input$tabs_no) 

т.е. при попытке сделать данные реактивным.

Answer 1

Вот код, который работает, я не думаю, что вы действительно хотите какое-либо из этого глобальных присваиваемых вещей:

test <- function(){ 
    db <- list() 
    getTables <- function(n){ 
    db <- lapply(seq_len(n), data.frame, a = 1:2, b = LETTERS[1:2]) 
    return(db) 
    } 
    shinyApp(
    ui=fluidPage(
     mainPanel(
     uiOutput("tabs"), 
     sliderInput("tabs_no", "Integer:", min=1, max=3, value=1) 
    ) 
    ), 
    server=function(input, output) { 
     db_tables <- reactive({ 
     return(getTables(input$tabs_no)) 
     }) 
     output$tabs <- renderUI({ 
     tbl<-db_tables() 
     tables <- sapply(1:input$tabs_no, function(x){ 
      renderTable(tbl[[x]]) 
     }) 
     tagList(tables) 
     }) 
    } 
) 
}