R闪亮：更改checkboxGroupInput中各个复选框的颜色

Question

我希望将实际单个复选框的颜色从 checkboxGroupInput 中的标准闪亮蓝色更改。

我找到了以下代码作为这个问题的答案Coloring the checkboxGroupInput choices，它将改变字体的颜色，但不会改变复选框本身。

library("shiny")

ui <- fluidPage(
  checkboxGroupInput(
    inputId = "my_cbgi",
    label = "Choose Something", 
    choiceNames = list(
      tags$span("A", style = "color: red;"),
      tags$span("B", style = "color: red;"), 
      tags$span("C", style = "color: blue;"), 
      tags$span("D", style = "font-weight: bold;")
    ),
    choiceValues = c("A", "B", "C", "D")
  )
)

server <- function(input, output) {

}

shinyApp(ui = ui, server = server)

有没有办法修改它来改变单个复选框的颜色？提前感谢您的帮助。

Answer 1

您可以对shinyWidgets 包中的prettyCheckboxGroup 执行以下操作：

library(shiny)
library(shinyWidgets)

items <- c("One", "Two", "Three")

CSS <- "
/* CSS for the labels */
.pretty input[value=One]~.state span {
  color: red;
  font-weight: bold;
}
/* CSS for the checkboxes */
.pretty input[value=One]~.state label:after, 
.pretty input[value=One]~.state label:before {
  background-color: red;
}
.pretty input[value=Two]~.state label:after, 
.pretty input[value=Two]~.state label:before {
  background-color: green;
}
.pretty input[value=Three]~.state label:after, 
.pretty input[value=Three]~.state label:before {
  background-color: blue;
}
/* CSS for the checked checkboxes */
.pretty.p-default input:checked~.state label:after {
  background-color: yellow !important;
}
"

ui <- fluidPage(
  tags$head(tags$style(HTML(CSS))),
  h1("Hello World"),
  prettyCheckboxGroup("numbers", label="Choose numbers", 
                      choiceNames = items, choiceValues = items, 
                      selected = items),
  verbatimTextOutput("value")
)

server <- function(input,output,session){
  output$value <- renderText(input$numbers)
}

shinyApp(ui, server)

Answer 2

对您的问题的简短回答是，这不是很直接，如果您不愿意直接弄乱 HTML 和 CSS，我建议您不要在这上面浪费时间。

要为复选框checkBoxGroupInput 生成容器，请在后台使用shiny:::generateOptions。查看源代码表明不幸的是，更改单个复选框的样式并不容易，因为默认情况下它将相同的class="checkbox" 应用于每个div（注释中指向的answer 仅解释了如何设置默认值所有选择的样式）。

我能看到的唯一补救方法是将原始 HTML 直接插入您的 UI。根据评论中的answer，即使您“仍然不能将样式（边框等）直接应用于复选框元素并且让这些样式影响 HTML 复选框的显示”这一事实也很复杂。我自己对 CSS 很陌生，但是通过搜索链接的引用，这基本上意味着您必须从头开始创建 HTML 复选框并覆盖默认复选框（显然您可以隐藏默认复选框，但我没有成功那个）。

通过以下所有内容，您将找到适用于您的案例的工作示例以及它在代码下方生成的输出。请注意，我在每种情况下都使用单独的包装器（.my_checkBox_red、.my_checkBox_blue 和 .my_checkBox_grey）。可能有一种方法可以通过更改相关样式（colour:、background-colour:）更有效地做到这一点，但我无法弄清楚这一点。此外，肯定可以很容易地改进以下内容的一件事是自动生成长 HTML 字符串，但我现在没有时间这样做。如果您想自己动手，闪亮的函数checkBoxGroupInput 和shiny:::generateOptions 可能是一个很好的起点，或者只是使用sprintf、paste、...构建您自己的函数。

希望这会有所帮助！

library("shiny")

ui <- fluidPage(
  # The below now creates a custom css class. 
  tags$head(
    tags$style(HTML('
      .my_checkBox_red input[type="checkbox"]:before {
          border: 2px solid;
          color: red;
          background-color: white;
          content: "";
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
      
      .my_checkBox_red input[type="checkbox"]:checked:after {
          border: 2px solid;
          color: red;
          background-color: #ffcccc;
          content: "✓";
          font-size: smaller;
          vertical-align: middle;
          text-align: center;
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
      
      .my_checkBox_blue input[type="checkbox"]:before {
          border: 2px solid;
          color: blue;
          background-color: white;
          content: "";
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
      
      .my_checkBox_blue input[type="checkbox"]:checked:after {
          border: 2px solid;
          color: blue;
          background-color: #ccccff;
          content: "✓";
          font-size: smaller;
          vertical-align: middle;
          text-align: center;
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
      
      .my_checkBox_grey input[type="checkbox"]:before {
          border: 2px solid;
          color: grey;
          background-color: white;
          content: "";
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
      
      .my_checkBox_grey input[type="checkbox"]:checked:after {
          border: 2px solid;
          color: grey;
          background-color: #e6e6e6;
          content: "✓";
          font-size: smaller;
          vertical-align: middle;
          text-align: center;
          height: 15px;
          left: 0;
          position: absolute;
          top: 0;
          width: 15px;
      }
    '))
  ),
  tags$div(
    HTML(
      '<div id="my_cbgi" class="form-group shiny-input-checkboxgroup shiny-input-container">
        <label class="control-label" for="my_cbgi">Choose Something</label>
        <div class="shiny-options-group">
          <div class="my_checkBox_red">
            <div class="checkbox">
              <label>
                <input type="checkbox" name="my_cbgi" value="A"/>
                <span><span style="color: red;">A</span></span>
              </label>
            </div>
          </div>
          <div class="my_checkBox_red">
            <div class="checkbox">
              <label>
                <input type="checkbox" name="my_cbgi" value="B"/>
                <span><span style="color: red;">B</span></span>
              </label>
            </div>
          </div>
          <div class="my_checkBox_blue">
            <div class="checkbox">
              <label>
                <input type="checkbox" name="my_cbgi" value="C"/>
                <span><span style="color: blue;">C</span></span>
              </label>
            </div>
          </div>
          <div class="my_checkBox_grey">
            <div class="checkbox">
              <label>
                <input type="checkbox" name="my_cbgi" value="D"/>
                <span><span style="font-weight: bold;">D</span></span>
              </label>
            </div>
          </div>
        </div>
      </div>'
    )
  ),
  textOutput("choice")
)

server <- function(input, output) {
  output$choice = renderText({
    input$my_cbgi
  })
}

shinyApp(ui = ui, server = server)