esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位
Posted
技术标签:
【中文标题】esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位【英文标题】：esquisserUI widgets gets dislocated with autoscaling of uiOutput in Shiny 【发布时间】：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)
如果我能在这两件事上得到一些帮助，我将不胜感激。
【问题讨论】：
【参考方案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，请（如果你是）在此链接中提供答案，以便我给你代表：***.com/questions/66937761/…以上是关于esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位的主要内容，如果未能解决你的问题，请参考以下文章
Shiny 中两个相关的 selectizeInput 小部件的反应式更新