esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位答案

【问题标题】：esquisserUI widgets gets dislocated with autoscaling of uiOutput in ShinyesquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位
【发布时间】：2021-06-28 21:47:58
【问题描述】：

@lz100 在我切换到显示/隐藏侧面板时帮助我自动缩放uiOutput()。但是，当我实现 esquisserUI() 时，当您在侧面板中的单选按钮之间来回切换时，与之关联的小部件会移位。

另一个问题 - 在 esquisse (https://dreamrs.github.io/esquisse/articles/shiny-usage.html) 的参考页面中，他们在 UI 级别呈现了绘图，但是如何通过服务器来实现呢？

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

#Credit: @lz100 helped with auto uiOutput() scaling when sidebar is collapsed. Thank you.

#ui.r
ui <- fluidPage(
  
  useShinyjs(),
  
  # a switch for toggles
  dropdownButton(
    
    tags$h3("Toggle"),
    
    materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                   value = TRUE, status = "success"),
    
    circle = TRUE, status = "info",
    icon = icon("gear"), width = "300px",
    
    tooltip = tooltipOptions(title = "Choose for more options!")
  ),
  
  
  
  # Sidebar layout with input and output definitions 
  sidebarLayout(
    div( id ="Sidebar",
         # Sidebar panel for inputs
         sidebarPanel(
           uiOutput("rad")
         )),
    
    # Main panel for displaying outputs
    mainPanel(
      id = "main_panel",
      uiOutput("tabers")
    )
  )
)
#server.r

server <- function(input, output) {
  
  data_sets <- list(df1 = data.frame(), 
                    df2= iris, 
                    df3 = mtcars, 
                    df4= ToothGrowth)
  
  # an oberserevent for toggle given by @lz100
  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')")
    }
    
  })
  
  
  output$rad<-renderUI({
    radioButtons("radio", label = "",
                 choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3), 
                 selected = character(0))
  })
  
  
  observeEvent(input$tabs, {
    callModule(module = esquisserServer,id = "esquisse", 
               data_table = reactive(data_sets[[as.integer(input$radio)]]),
               data_name = reactive(names(data_sets[paste0("df",input$radio)])))
  })
  
  
  output$tabers<- renderUI({
    if(is.null(input$radio)) {
      tabsetPanel(
        id="tabC",
        type = "tabs",
        tabPanel("Welcome!")
      )
    }
    else if(input$radio==1){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Navigation...")
      )
    }
    else if(input$radio==2){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                             options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
        tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
        tabPanel(
          title = "Plot",
          esquisserUI(
            id = "esquisse",
            header = FALSE, 
            choose_data = FALSE
          )
        )
      ) 
    }
    else if(input$radio==3){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                             options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
        tabPanel(
          title = "Plot",
          esquisserUI(
            id = "esquisse",
            header = FALSE, 
            choose_data = FALSE
          )
        )
      ) 
    }
  })
}

shinyApp(ui, server)

如果我能在这两件事上得到一些帮助，我将不胜感激。

【问题讨论】：

标签： r shiny shinydashboard shiny-server shinyjs

【解决方案1】：

UI 很容易修复：只需添加这个

        mainPanel(
            id = "main_panel",
            tags$style('.sw-dropdown {display: inline-block};'),
            uiOutput("tabers")
        )

问题来自renderUI 在创建新 UI 时，它没有加载所需的 CSS。我不知道为什么，但我们可以通过添加我们的样式来强制它。

对于剧情问题，这里有几个问题：

esquisserServer、data 的输入必须是 reactiveValues 对象，因此您的 data_sets 是一个列表，将不起作用。
你为什么要观察input$tabs，我没有看到你有ID为'tabs'的地方。
对于esquisserUI 和esquisserServer，ID 参数必须一对一匹配，并且不能有重复项。您的所有 ID 都是“esquisse”。
由于您每次都使用renderUI 来呈现新的用户界面，这是一个异步函数。然后它会立即调用服务器callModule。但是，调用服务器时未准备好 UI。您将面临我刚刚发布给闪亮团队的相同问题：https://github.com/rstudio/shiny/issues/3348

我尝试使用固定数据集 df1 修复您的服务器，但仍然存在问题 4。您应该考虑是否真的需要renderUI。修复它可能非常棘手。

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

#Credit: @lz100 helped with auto uiOutput() scaling when sidebar is collapsed. Thank you.

#ui.r
ui <- fluidPage(
    
    useShinyjs(),
    
    # a switch for toggles
    dropdownButton(
        
        tags$h3("Toggle"),
        
        materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                       value = TRUE, status = "success"),
        
        circle = TRUE, status = "info",
        icon = icon("gear"), width = "300px",
        
        tooltip = tooltipOptions(title = "Choose for more options!")
    ),
    
    
    
    # Sidebar layout with input and output definitions 
    sidebarLayout(
        div( id ="Sidebar",
             # Sidebar panel for inputs
             sidebarPanel(
                 uiOutput("rad")
             )),
        
        # Main panel for displaying outputs
        mainPanel(
            id = "main_panel",
            tags$style('.sw-dropdown {display: inline-block};'),
            uiOutput("tabers")
        )
    )
)
#server.r

server <- function(input, output) {
    
    data_sets <- list(df1 = data.frame(), 
                      df2= iris, 
                      df3 = mtcars, 
                      df4= ToothGrowth)
    data_rea <- reactiveValues(df1 = data.frame(), 
                               df2= iris, 
                               df3 = mtcars, 
                               df4= ToothGrowth)
    # an oberserevent for toggle given by @lz100
    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')")
        }
        
    })
    
    
    output$rad<-renderUI({
        radioButtons("radio", label = "",
                     choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3), 
                     selected = character(0))
    })
    
    
    observeEvent(input$radio, {
        callModule(module = esquisserServer,id = "esquisse1", 
                   data = data_rea[['df1']])
    })
    
    
    output$tabers<- renderUI({
        if(is.null(input$radio)) {
            tabsetPanel(
                id="tabC",
                type = "tabs",
                tabPanel("Welcome!")
            )
        }
        else if(input$radio==1){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Navigation...")
            )
        }
        else if(input$radio==2){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                                     options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
                tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
                tabPanel(
                    title = "Plot",
                    esquisserUI(
                        id = "esquisse1",
                        header = FALSE, 
                        choose_data = FALSE
                    )
                )
            ) 
        }
        else if(input$radio==3){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                                     options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
                tabPanel(
                    title = "Plot",
                    esquisserUI(
                        id = "esquisse2",
                        header = FALSE, 
                        choose_data = FALSE
                    )
                )
            ) 
        }
    })
}

shinyApp(ui, server)

更新

试试这个：

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

ui <- fluidPage(
    useShinyjs(),
    # a switch for toggles
    dropdownButton(
        tags$h3("Toggle"),
        materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                       value = TRUE, status = "success"),
        circle = TRUE, status = "info",
        icon = icon("gear"), width = "300px"
    ),
    sidebarLayout(
        sidebarPanel(
            id = "Sidebar",
            radioButtons("controller", "Controller", 1:3, 1)
        ),
        mainPanel(
            id = "main_panel",
            
            tabsetPanel(
                id = "hidden_tabs",
                type = "hidden",
                tabPanelBody(
                    "panel1", "navigation"
                ),
                tabPanelBody(
                    "panel2", 
                    tabsetPanel(
                        tabPanel("Data", DT::dataTableOutput('panel1_data')),
                        tabPanel("Summary", verbatimTextOutput("panel1_sum")),
                        tabPanel(
                            "Plot",
                            esquisserUI(
                                id = "esquisse2",
                                header = FALSE, 
                                choose_data = FALSE
                            )
                        )
                    )
                ),
                tabPanelBody(
                    "panel3",
                    tabsetPanel(
                        tabPanel("Data", DT::dataTableOutput('panel3_data')),
                        tabPanel("Summary", verbatimTextOutput("panel3_sum")),
                        tabPanel(
                            "Plot",
                            esquisserUI(
                                id = "esquisse3",
                                header = FALSE, 
                                choose_data = FALSE
                            )
                        )
                    )
                )
            )
        )
        )
    )
)

server <- function(input, output, session) {
    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')")
        }
        
    })
    
    data_sets <- list(df1 = data.frame(), 
                     df2= iris, 
                     df3 = mtcars, 
                     df4= ToothGrowth)
    # store current dataset
    data_to_use <- reactiveValues(name = "df", data = data.frame())
    
    # modules only needto be called it once
    callModule(
        module = esquisserServer,
        id = "esquisse2",
        data = data_to_use
    )
    callModule(
        module = esquisserServer,
        id = "esquisse3",
        data = data_to_use
    )
    
    observeEvent(input$controller, {
        updateTabsetPanel(session, "hidden_tabs", selected = paste0("panel", input$controller))
        # skip first panel since it is used to display navigation
        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::renderDataTable(data_to_use$data)
        output[[paste0('panel',  input$controller, '_sum')]] <-
            renderPrint(summary(data_to_use$data))
    })
    
    
}

shinyApp(ui, server)

?tabsetPanel 给出了一个非常好的示例，您可以如何使用type = "hidden" 隐藏内容，并且可以将tabsetPanel 嵌套在tabsetPanel 中。所以所有的 UI 元素都会在启动时发送给客户端，它们只是被隐藏，并在某个点击时显示出来。它与动态加载 UI 的renderUI 根本不同。对于模块，您只需要在服务器上调用一次。所以他们离开了观察者。

【讨论】：

嗨@Iz100！再次感谢你的帮助，你太棒了。我需要renderUI 来轻松添加或删除mainPanel 中的选项卡。通过服务器做是我知道的唯一方法。我试图寻找一个优雅的解决方案；通过UI搜索了很多如何做到这一点，但一无所获。我得到的最接近的方法是不在选项卡上放任何东西，但随后一个空选项卡将留在tabsetPanel 中，占用烦人的空间。感谢您的帮助和在您的帖子朋友中添加的建议:)
@Iz100，您能想到为每个操作按钮分配指定数量的面板吗？任何提示或资源都将受到欢迎:)
@Iz100，您是一位了不起的先生。非常感谢您这几天的帮助！保重人。
@Iz100，不幸的是，esquisse 小部件现在没有弹出。您认为这可能是由于主面板的自动缩放造成的吗？
嗨@Iz100，请（如果你是）在此链接中提供答案，以便我给你代表：stackoverflow.com/questions/66937761/…