如何解决esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位
@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",tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",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",choose_data = FALSE
)
)
)
}
})
}
shinyApp(ui,server)
如果我能在这两件事上得到一些帮助，我将不胜感激。
解决方法
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来呈现新 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",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(),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",tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",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",esquisserUI(
id = "esquisse2",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"),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')),verbatimTextOutput("panel1_sum")),tabPanel(
"Plot",esquisserUI(
id = "esquisse2",choose_data = FALSE
)
)
)
),tabPanelBody(
"panel3",DT::dataTableOutput('panel3_data')),verbatimTextOutput("panel3_sum")),esquisserUI(
id = "esquisse3",choose_data = FALSE
)
)
)
)
)
)
)
)
)
server <- function(input,output,session) {
observeEvent(input$toggleSidebar,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(),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','_sum')]] <-
renderPrint(summary(data_to_use$data))
})
}
shinyApp(ui,server)
?tabsetPanel 给出了一个很好的例子，您可以如何使用 type = "hidden" 隐藏内容，以及如何将 tabsetPanel 嵌套在 tabsetPanel 中。因此，所有 UI 元素都会在启动时发送到客户端，它们只是隐藏起来，并在特定点击时显示。它与动态加载 UI 的 renderUI 有着根本的不同。而对于模块，你只需要在服务器上调用一次。所以他们在观察者之外。
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
