我正在为 Shiny App 开发侧边栏面板,您可以在下面的 MWE 代码中看到简化版本。侧边栏将主要有用户输入和操作按钮(触发模态对话框)来向用户解释输入。为了更好地引导用户完成复杂模型的输入过程,如底部图像所示,使用突出显示框更好地格式化侧边栏面板会很有帮助。我画了那些粗线框,这样你就可以看到我想要得到的东西。此外,更改该框中的颜色阴影的能力将非常有帮助。关于如何做这两个(盒子+阴影)的任何想法?如果两者都不可能,我会采纳任何建议!
我一直在玩弄fluidRow(column...))
,但还没有成功。
请注意,如果用户单击“显示”复选框,侧边栏面板可能会扩展,我希望突出显示框扩展以适应扩展后的尺寸,如第二张图片所示。
MWE代码:
library(shiny)
library(shinyjs)
f <- function(action,i){as.character(checkboxInput(paste0(action,i),label=NULL))}
actions <- c("show", "reset")
tbl <- t(outer(actions, c(1,2), FUN = Vectorize(f)))
colnames(tbl) <- c("Show", "Reset")
rownames(tbl) <- c("2nd input", "3rd input")
firstInput <- function(inputId){
matrixInput(inputId,
value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
secondInput <- function(inputId,x){
matrixInput(inputId,
value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
ui <- fluidPage(
tags$head(
tags$style(HTML(
"td .checkbox {margin-top: 0; margin-bottom: 0;}
td .form-group {margin-bottom: 0;}"
))
),
br(),
sidebarLayout(
sidebarPanel(
uiOutput("panel"),
),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output){
input1 <- reactive(input$input1)
input2 <- reactive(input$input2)
output$panel <- renderUI({
tagList(
useShinyjs(),
strong(helpText("SLIDER INPUT HERE...")),
div(style = "margin-top: 15px"),
firstInput("input1"),
strong(helpText("Generate curves (Y|X):")),
tableOutput("checkboxes"),
hidden(uiOutput("secondInput")),
strong(helpText("ADDITIONAL SCENARIOS...")),
)
})
output[["checkboxes"]] <-
renderTable({tbl},
rownames = TRUE, align = "c",
sanitize.text.function = function(x) x
)
observeEvent(input[["show1"]], {
if(input[["show1"]]){
shinyjs::show("secondInput")
} else {
shinyjs::hide("secondInput")
}
})
output$secondInput <- renderUI({
req(input1())
secondInput("input2",input$input1[1,1])
})
outputOptions(output,"secondInput",suspendWhenHidden = FALSE)
output$plot1 <-renderPlot({
req(input2())
plot(rep(input2(),times=5))
})
}
shinyApp(ui, server)
最佳答案
也许用wellPanel
:
output$panel <- renderUI({
tagList(
useShinyjs(),
strong(helpText("SLIDER INPUT HERE...")),
div(style = "margin-top: 15px"),
wellPanel(
firstInput("input1"),
strong(helpText("Generate curves (Y|X):")),
tableOutput("checkboxes"),
hidden(uiOutput("secondInput"))
),
strong(helpText("ADDITIONAL SCENARIOS..."))
)
})
我没试过,但我认为你可以用内联样式改变背景颜色:
wellPanel(
style = "background-color: cyan;",
firstInput("input1"),
strong(helpText("Generate curves (Y|X):")),
tableOutput("checkboxes"),
hidden(uiOutput("secondInput"))
),
strong(helpText("ADDITIONAL SCENARIOS..."))
关于r - 在 R Shiny 中,如何在侧边栏面板的指定部分周围绘制一个框?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/69347850/