блестящий - функция для разных вкладок выполняется при первой загрузке

Shiny выполняет функции, используемые в других вкладках при первой загрузке. В качестве минимального примера посмотрите на следующее приложение, которое взято из здесь. В этом приложении есть два пункта меню. Если вы нажмете на элемент меню боковой панели A, он должен выполнить функцию renderUI, которая создаст пункт меню через output$A_panel. Это приложение делает это отлично. Однако, если вы посмотрите на свою консоль R, вы увидите, что печатаются как Inside A Panel, так и Inside B Panel. Это означает, что обе функции renderUI были выполнены при первой загрузке приложения, и блестящие просто скрыли их, если пользователь не щелкнет пункт меню B.

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

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(
sidebarMenu(id = "sidebarmenu",
            menuItem("A", tabName = "a",  icon = icon("group", lib="font-awesome")),
            menuItem("B", tabName = "b", icon = icon("check-circle", lib = "font-awesome")),
            conditionalPanel("input.sidebarmenu === 'a'",
                             uiOutput('A_panel')
                             ),
            conditionalPanel("input.sidebarmenu === 'b'",
                             uiOutput('B_panel')
                            )
),
sliderInput("x", "Outside of menu", 1, 100, 50)
),
dashboardBody()
)

server <- function(input, output) {

output$A_panel <- renderUI({
       cat('Inside A Panel \n')
       sliderInput("b", "Under A", 1, 100, 50)
})
output$B_panel <- renderUI({
       cat('Inside B Panel \n')
       sliderInput("b", "Under B", 1, 100, 50)
        })

}
shinyApp(ui, server)

r shiny shinydashboard
person Sal    schedule 20.06.2017    source источник

Ответы (1)


arrow_upward
1
arrow_downward

ConditionalPanel управляет видимостью пользовательского интерфейса, а не выполнением. Быстрое решение в этом случае — выйти из функции на основе значения sidebarmenu, как показано ниже.
В реализации вывод renderUI для «b» выполняется только тогда, когда в меню указано «b».

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(id = "sidebarmenu",
                menuItem("A", tabName = "a",  icon = icon("group", lib="font-awesome")),
                menuItem("B", tabName = "b", icon = icon("check-circle", lib = "font-awesome")),
                conditionalPanel("input.sidebarmenu == 'a'",
                                 uiOutput('A_panel')
                ),
                conditionalPanel("input.sidebarmenu == 'b'",
                                 uiOutput('B_panel')
                )
    ),
    sliderInput("x", "Outside of menu", 1, 100, 50)
  ),
  dashboardBody()
)

server <- function(input, output) {

  output$A_panel <- renderUI({
    if(input$sidebarmenu != "a") return()
    cat('Inside A Panel \n')
    sliderInput("b", "Under A", 1, 100, 50)
  })
  output$B_panel <- renderUI({
    if(input$sidebarmenu != "b") return()
    cat('Inside B Panel \n')
    sliderInput("b", "Under B", 1, 100, 50)
  })

}
shinyApp(ui, server)

Однако в этой реализации вычисление выполняется каждый раз, когда вы переключаете меню, поскольку изменение в sidebarmenu запускает renderUI. Это может быть не совсем то, что вам нужно, так как вас беспокоят сложные вычисления при загрузке меню «b». Вы можете захотеть, чтобы вычисления происходили только после выбора меню «b», но никогда больше.

Для этого вы можете позволить приложению запомнить, был ли outputB обработан или нет с использованием reactiveValues, и завершить renderUI, если он уже был обработан. В приведенной ниже реализации вы увидите сообщение, напечатанное только один раз.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(id = "sidebarmenu",
                menuItem("A", tabName = "a",  icon = icon("group", lib="font-awesome")),
                menuItem("B", tabName = "b", icon = icon("check-circle", lib = "font-awesome")),
                conditionalPanel("input.sidebarmenu == 'a'",
                                 uiOutput('A_panel')
                ),
                conditionalPanel("input.sidebarmenu == 'b'",
                                 uiOutput('B_panel')
                )
    ),
    sliderInput("x", "Outside of menu", 1, 100, 50)
  ),
  dashboardBody()
)

server <- function(input, output) {

  RV <- reactiveValues(b_ui_flg=FALSE)

  output$A_panel <- renderUI({
    if(input$sidebarmenu != "a") return()
    cat('Inside A Panel \n')
    sliderInput("b", "Under A", 1, 100, 50)
  })

  observeEvent(input$sidebarmenu, {
    if(input$sidebarmenu != "b") return()
    if (RV$b_ui_flg) return() 
    RV$b_ui_flg <- TRUE
    cat('Inside B Panel \n')
    output$B_panel <- renderUI({
      sliderInput("b", "Under B", 1, 100, 50)
    })
  })

}
shinyApp(ui, server)
person Kota Mori    schedule 20.06.2017
comment
Отличный ответ. Я пробовал вариант `if(input$sidebarmenu != a) return()`. Это не сработало для меня. Но я был на очень старой блестящей версии. Я буду винить это сейчас. +1 за второй подход. - person Sal; 21.06.2017