mengkilap - fungsi untuk tab berbeda dijalankan pada pemuatan pertama

Shiny menjalankan fungsi yang digunakan di tab lain saat pertama kali dimuat. Sebagai contoh minimal, lihat aplikasi berikut yang diadopsi dari di sini. Ada dua item menu pada aplikasi ini. Jika Anda mengklik item menu sidebar A, ia akan menjalankan fungsi renderUI yang akan menghasilkan item menu melalui output$A_panel. Aplikasi ini melakukannya dengan sempurna. Namun, jika Anda melihat konsol R, Anda akan melihat Inside A Panel dan Inside B Panel dicetak. Ini menyiratkan bahwa kedua fungsi renderUI dijalankan saat aplikasi pertama kali dimuat dan hanya menyembunyikannya kecuali pengguna mengklik item menu B.

Saya memiliki aplikasi yang menggunakan teknik serupa tetapi fungsi yang dijalankan menggunakan kueri SQL dan beberapa perhitungan yang tidak ingin saya lakukan pada pemuatan pertama. Ini sangat memperlambat aplikasi saya. Apakah ada cara untuk mencegah terjadinya eksekusi otomatis ini?

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 sumber

Jawaban (1)


arrow_upward
1
arrow_downward

ConditionalPanel mengontrol visibilitas UI, bukan eksekusi. Perbaikan cepat dalam hal ini adalah keluar dari fungsi berdasarkan nilai sidebarmenu seperti di bawah ini.
Dalam implementasinya, output renderUI untuk "b" hanya dijalankan ketika menunya adalah "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)

Namun, dalam implementasi ini komputasi dilakukan setiap kali Anda berpindah menu, karena perubahan pada sidebarmenu memicu renderUI. Ini mungkin bukan yang Anda inginkan karena Anda khawatir dengan tuntutan komputasi saat memuat menu "b". Anda mungkin ingin penghitungan dilakukan hanya setelah menu "b" dipilih, namun tidak pernah lagi.

Untuk melakukannya, Anda dapat membiarkan aplikasi mengingat apakah keluaranB telah dirender atau tidak menggunakan reactiveValues, dan menghentikan renderUI jika sudah dirender. Dalam implementasi di bawah ini Anda akan melihat pesan dicetak hanya sekali.

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
Jawaban yang bagus. Saya memang mencoba varian ` if(input$sidebarmenu != a) return()`. Itu tidak berhasil untuk saya. Tapi saya menggunakan versi mengkilap yang sangat tua. Saya akan menyalahkannya untuk saat ini. +1 untuk pendekatan kedua. - person Sal; 21.06.2017