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

Question

uiOutput()@lz100 帮助我在切换到显示/隐藏侧面板时自动缩放。但是，当我实现 时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)

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

Answer 1

用户界面很容易修复：只需添加这个

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

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

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

1. esquisserServer,的输入data必须是一个reactiveValues对象，所以你data_sets是一个列表并且不起作用。
2. 你为什么要观察input$tabs，我没有看到你有ID的地方'tabs'。
3. 对于esquisserUIand esquisserServer， ID 参数必须一对一匹配，并且不能有重复项。您的所有 ID 都是“esquisse”。
4. 由于您renderUI每次都使用渲染新 UI，这是一个异步函数。然后它会立即调用服务器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 元素都会在启动时发送给客户端，它们只是被隐藏，并在某个点击时显示出来。renderUI它与动态加载 UI的地方根本不同。对于模块，您只需要在服务器上调用一次。所以他们离开了观察者。