r - 在 R Shiny 中，如何在侧边栏面板的指定部分周围绘制一个框？

Question

我正在为 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)

Answer 1

也许用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..."))