r - 如何修复 Shiny 中 esquisserUI 不弹出的过滤器选项？

Question

我对我的应用有一些要求。

{1} 重新调整 mainPanel 后，esquisserUI 过滤器不再弹出。这是我遵循的工作示例 https://dreamrs.github.io/esquisse/articles/shiny-usage.html此外，我还查看了这个 GitHub 问题，但它是为了禁用过滤器:https://github.com/dreamRs/esquisse/issues/71

关于一般信息的最终请求:

{2} server = FALSE 会为庞大的数据集做什么？ ( https://rstudio.github.io/DT/server.html ) DT 建议将其默认设置为 TRUE 状态，但是如果我这样做，我不会在下载时获得完整数据。我只获取当前页面中的数据。有没有预见到的问题？

谢谢，这是一个可重现的例子。

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)

# Credit: @Iz100 helped me a lot with UI.

ui <- fluidPage(
  
  theme = shinytheme("simplex"),
  
  
  useShinyjs(),
  
  # Create Right Side Text
  navbarPage( 
    
    title= div(HTML("G<em>T</em>")),
    
    tabPanel("Data Set Info",
             
             materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
                            value = TRUE, status = "warning"),
             sidebarLayout(
               # radio/action buttons
               sidebarPanel(
                 
                 id = "Sidebar",
                 
                 prettyRadioButtons(
                   inputId = "controller",
                   label = "Choose:", 
                   choices = c("About"= 1,
                               "iris"= 2,
                               "mtcars" = 3),
                   icon= icon("check"),
                   selected = 1,
                   status = "success",
                   animation="smooth"
                 ),
                 
                 br(),
                 br(),
                 a(actionButton(inputId = "admin_email", label = "Contact Admin", 
                                icon = icon("envelope", lib = "font-awesome")),
                   href="mailto:my_awesome_email_address.com")
               ),
               
               #panel where output is shown from server
               mainPanel(
                 id = "main_panel",
                 
                 tabsetPanel(
                   id = "hidden_tabs",
                   type = "hidden",
                   tabPanelBody(
                     "panel1", "navigation"
                   ),
                   
                   tabPanelBody(
                     "panel2", 
                     tabsetPanel(
                       tabPanel("Data", DT::DTOutput('panel1_data')),
                       tabPanel("Summary", verbatimTextOutput("panel1_sum")),
                       tabPanel(
                         "Plot",
                         esquisserUI(
                           id = "esquisse2",
                           header = FALSE, 
                           choose_data = FALSE
                         )
                       )
                     )
                   ),
                   tabPanelBody(
                     "panel3",
                     tabsetPanel(
                       tabPanel("Data", DT::DTOutput('panel3_data')),
                       tabPanel("Summary", verbatimTextOutput("panel3_sum")),
                       tabPanel(
                         "Plot",
                         esquisserUI(
                           id = "esquisse3",
                           header = FALSE, 
                           choose_data = FALSE
                         )
                       )
                     )
                   )
                 )
               )
             )
    ) ,
    #resizes the navbar tabs/button
    tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
  )
)

server <- function(input, output, session) {
  
  # this event hides the side panel when toggled on/off
  observeEvent(input$toggleSidebar, {
    shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
    if(!isTRUE(input$toggleSidebar)) {
      shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
    } else {
      shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
    }
    
  })
  
  
  myModal <- function() {
    div(id = "Download_DATA",
        modalDialog(easyClose = TRUE,
                    title = "Alert!",
                    "Please remove all the filters if you want a full dataset.",
                    br(),
                    br(), 
                    downloadButton("download_excel","Download as XLSX")
        )
    )
  }
  
  
  # here we put all the data
  data_sets <- list(df1 = data.frame(), 
                    df2= iris, 
                    df3 = mtcars)
  
  # store current dataset in reactive so we can work with plot panels
  data_to_use <- reactiveValues(name = "df", data = data.frame())
  
  # modules only need to be called it once but individually for esquisse
  callModule(
    module = esquisserServer,
    id = "esquisse2",
    data = data_to_use
  )
  callModule(
    module = esquisserServer,
    id = "esquisse3",
    data = data_to_use
  )
  
  observeEvent(input$controller, {
    
    # skip first panel since it is used to display navigation
    updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
    
    # enswure value is avilable throught selected tabSet
    req(input$controller)
    
    # get current data and df name
    data_to_use$data <- data_sets[[as.numeric(input$controller)]]
    data_to_use$name <- names(data_sets[as.numeric(input$controller)])
    
    # update table and sum
    output[[paste0('panel',  input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
      DT::datatable(data_to_use$data,
                    filter = 'top', 
                    extensions = 'Buttons',
                    options = list(scrollY = 600,
                                   scrollX = TRUE,
                                   dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
                                   lengthMenu=  list(c(10, 25, 50, -1), 
                                                     c('10', '25', '50','All')),
                                   buttons = list(
                                     list(extend = "collection", text = "Download", 
                                          filename = "data_excel",
                                          exportOptions = list(
                                            modifier = list(page = "all")
                                          ),
                                          action = DT::JS("function ( e, dt, node, config ) {
                                    Shiny.setInputValue('Download_DATA', true, {priority: 'event'});}"
                                          )
                                     )
                                   ),
                                   scrollCollapse= TRUE,
                                   lengthChange = TRUE, 
                                   widthChange= TRUE,
                                   rownames = TRUE))})
    
    output[[paste0('panel',  input$controller, '_sum')]] <- renderPrint(summary(data_to_use$data))
    
  })
  
  # observes if download is clicked
  observeEvent(input$Download_DATA, {
    showModal(myModal())
  })
  
  # writes to an excel file
  output$download_excel <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".xlsx", sep="")
    },
    content = function(file) {
      write.xlsx(data_to_use$data, file, row.names = FALSE)
    }
  )
  
  
}

#runs the app
shinyApp(ui= ui, server= server)

Answer 1

1。我检查了 esquisserUI 的 HTML，如果您使用多个 esquisserUI，它们会为所有下拉菜单提供相同的 ID。这在 HTML 开发中是一个很大的 NO，并且会导致很多问题。他们称它为模块，但他们没有遵循 Shiny 模块指南，在何处对所有 UI ID 使用 NS()。简单的证明是在下面试试这个。然后取消注释第二组 esquisserUI 和 esquisserServer 并重试。您会发现下拉菜单不再有效。

library(esquisse)
ui <- fluidPage(
    esquisserUI(
        id = "esquisse1",
        header = FALSE, 
        choose_data = FALSE
    )#,
    # esquisserUI(
    #     id = "esquisse2",
    #     header = FALSE,
    #     choose_data = FALSE
    # )
)

server <- function(input, output, session) {
    data_to_use <- reactiveValues(data = iris, name = "iris")
    callModule(
        module = esquisserServer,
        id = "esquisse1",
        data = data_to_use
    )
    # callModule(
    #     module = esquisserServer,
    #     id = "esquisse2",
    #     data = data_to_use
    # )
}

shinyApp(ui, server)

目前没有直接的解决方法，除非您要求他们修复它。我们需要使用解决方法:

我在主面板中添加了一个名为“plot”的新选项卡，即 esquisserUI，并在数据面板中添加了两个按钮，因此当您单击按钮时，它会跳转到绘图包含正确数据的面板。

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)

# Credit: @Iz100 helped me a lot with UI.
ns <- NS("myapp")
ui <- fluidPage(
    
    theme = shinytheme("simplex"),
    
    
    useShinyjs(),
    
    # Create Right Side Text
    navbarPage( 
        
        title= div(HTML("G<em>T</em>")),
        
        tabPanel("Data Set Info",
                 
                 materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
                                value = TRUE, status = "warning"),
                 sidebarLayout(
                     # radio/action buttons
                     sidebarPanel(
                         
                         id = "Sidebar",
                         
                         prettyRadioButtons(
                             inputId = "controller",
                             label = "Choose:", 
                             choices = c("About"= 1,
                                         "iris"= 2,
                                         "mtcars" = 3,
                                         "plots" = 4),
                             icon= icon("check"),
                             selected = 1,
                             status = "success",
                             animation="smooth"
                         ),
                         
                         br(),
                         br(),
                         a(actionButton(inputId = "admin_email", label = "Contact Admin", 
                                        icon = icon("envelope", lib = "font-awesome")),
                           href="mailto:my_awesome_email_address.com")
                     ),
                     
                     #panel where output is shown from server
                     mainPanel(
                         id = "main_panel",
                         
                         tabsetPanel(
                             id = "hidden_tabs",
                             type = "hidden",
                             tabPanelBody(
                                 "panel1", "navigation"
                             ),
                             
                             tabPanelBody(
                                 "panel2", 
                                 tabsetPanel(
                                     tabPanel(
                                         "Data", DT::DTOutput('panel2_data'),
                                         actionButton("plot2", "Plot iris")
                                     ),
                                     tabPanel("Summary", verbatimTextOutput("panel2_sum"))
                                 )
                             ),
                             tabPanelBody(
                                 "panel3",
                                 tabsetPanel(
                                     tabPanel(
                                         "Data", DT::DTOutput('panel3_data'),
                                         actionButton("plot3", "Plot mtcars")
                                     ),
                                     tabPanel("Summary", verbatimTextOutput("panel3_sum"))
                                 )
                             ),
                             tabPanelBody(
                                 "panel4",
                                 esquisserUI(
                                     id = "esquisse",
                                     header = FALSE, 
                                     choose_data = FALSE
                                 )
                             )
                         )
                     )
                 )
        ),
        #resizes the navbar tabs/button
        tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
    )
)

server <- function(input, output, session) {
    
    # this event hides the side panel when toggled on/off
    observeEvent(input$toggleSidebar, {
        shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
        if(!isTRUE(input$toggleSidebar)) {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
        } else {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
        }
        
    })
    
    
    myModal <- function() {
        div(id = "Download_DATA",
            modalDialog(easyClose = TRUE,
                        title = "Alert!",
                        "Please remove all the filters if you want a full dataset.",
                        br(),
                        br(), 
                        downloadButton("download_excel","Download as XLSX")
            )
        )
    }
    
    
    # here we put all the data
    data_sets <- list(df1 = data.frame(), 
                      df2= iris, 
                      df3 = mtcars)
    
    # store current dataset in reactive so we can work with plot panels
    data_to_use <- reactiveValues(name = "df", data = data.frame())
    
    # modules only need to be called it once but individually for esquisse
    callModule(
        module = esquisserServer,
        id = "esquisse",
        data = data_to_use
    )
    # go to plot panel if plot button clicked
    observeEvent(c(input$plot2, input$plot3), {
        updatePrettyRadioButtons(session, "controller", selected = 4)
    }, ignoreInit = TRUE)
    
    observeEvent(input$controller, {
        
        # skip first panel since it is used to display navigation
        updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
        
        # enswure value is avilable throught selected tabSet
        # only render data if data panels are selected
        req(input$controller %in% 2:3)
        
        # get current data and df name
        data_to_use$data <- data_sets[[as.numeric(input$controller)]]
        data_to_use$name <- names(data_sets[as.numeric(input$controller)])
        
        # update table and sum
        output[[paste0('panel',  input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
            DT::datatable(data_to_use$data,
                          filter = 'top', 
                          extensions = 'Buttons',
                          options = list(scrollY = 600,
                                         scrollX = TRUE,
                                         dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
                                         lengthMenu=  list(c(10, 25, 50, -1), 
                                                           c('10', '25', '50','All')),
                                         buttons = list(
                                             list(extend = "collection", text = "Download", 
                                                  filename = "data_excel",
                                                  exportOptions = list(
                                                      modifier = list(page = "all")
                                                  ),
                                                  action = DT::JS("function ( e, dt, node, config ) {
                                    Shiny.setInputValue('Download_DATA', true, {priority: 'event'});}"
                                                  )
                                             )
                                         ),
                                    scrollCollapse= TRUE,
                                    lengthChange = TRUE, 
                                    widthChange= TRUE,
                                    rownames = TRUE))})
        
        output[[paste0('panel',  input$controller, '_sum')]] <- renderPrint(summary(data_to_use$data))
        
    })
    
    # observes if download is clicked
    observeEvent(input$Download_DATA, {
        showModal(myModal())
    })
    
    # writes to an excel file
    output$download_excel <- downloadHandler(
        filename = function() {
            paste("data-", Sys.Date(), ".xlsx", sep="")
        },
        content = function(file) {
            write.xlsx(data_to_use$data, file, row.names = FALSE)
        }
    )
    
    
}

#runs the app
shinyApp(ui= ui, server= server)

2. 因此 server = TRUE 仅将整个数据集的一小部分发送到大型数据集的 UI。当您滚动或跳转页面时，将发送新数据。这样可以节省时间并具有更好的性能。如果为FALSE，所有数据将被一次发送。想象一下，每次启动应用程序时，您都需要在浏览器中加载一个 2GB 的表，这将有多慢。对于小型数据集，您可以将其保留为 FALSE。

更新似乎 esquisse 人修复了这个错误。安装开发版本，然后:

ui <- fluidPage(
    esquisse_ui(
        id = "esquisse1",
        header = FALSE
    ),
    esquisse_ui(
        id = "esquisse2",
        header = FALSE
    )
)

server <- function(input, output, session) {
    data_to_use <- reactiveValues(data = iris, name = "iris")
    esquisse_server(id = "esquisse1", data_rv = data_to_use)
    esquisse_server(id = "esquisse2", data_rv = data_to_use)
}

shinyApp(ui, server)