esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位
esquisserUI widgets gets dislocated with autoscaling of uiOutput in Shiny
当我切换到 show/hide 侧面板时,@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)
如果能在这两件事上得到一些帮助,我将不胜感激。
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",
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
根本不同。而对于模块,你只需要在服务器上调用一次。所以他们在观察者之外。
@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)
如果能在这两件事上得到一些帮助,我将不胜感激。
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",
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
根本不同。而对于模块,你只需要在服务器上调用一次。所以他们在观察者之外。