修改 R/Shiny 中 valueBox 的颜色边框
Modifying the color border of valueBox in R/Shiny
我正在尝试使用十六进制颜色代码(例如“#12ff34”)格式修改 valueBox 的颜色边框。如何访问和设置这样的值?
在下面的三个值框(在“help('box')”中找到的示例的更短和修改版本),如何指定第一个应该有,比如说,红色边框,第二个黑色边框,第三个黄色边框?
谢谢
library(shiny)
library(shinydashboard)
# A dashboard body with a row of valueBoxes
body <- dashboardBody(
# valueBoxes
fluidRow(
valueBox(
uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
),
valueBox(
tagList("60", tags$sup(style="font-size: 20px", "%")),
"Approval Rating", icon = icon("line-chart"), color = "green"
),
valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
)
)
)
server <- function(input, output) {
output$orderNum <- renderText({
x = 789
})
output$progress <- renderUI({
tagList(8.90, tags$sup(style="font-size: 20px", "%"))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
我们可以使用 htmltools::tagQuery
来实现这一点 - 这里有一些关于如何应用它的选项:
library(shiny)
library(shinydashboard)
library(htmltools)
setBorderColor <- function(valueBoxTag, color){tagQuery(valueBoxTag)$find("div.small-box")$addAttrs("style" = sprintf("border-style: solid; border-color: %s; height: 106px;", color))$allTags()}
# A dashboard body with a row of valueBoxes
body <- dashboardBody(
fluidRow(
tagQuery(valueBox(
uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
))$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #FF0000;")$allTags(),
{vb2 <- valueBox(
tagList("60", tags$sup(style="font-size: 20px", "%")),
"Approval Rating", icon = icon("line-chart"), color = "green"
)
tagQuery(vb2)$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #000000;")$allTags()
},
{vb3 <- valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
)
setBorderColor(vb3, "#FFFF00")},
valueBoxOutput("vbox")
)
)
myPalette <- colorRampPalette(c("red", "yellow", "green"))( 100 )
server <- function(input, output) {
output$orderNum <- renderText({
x = 789
})
output$progress <- renderUI({
tagList(8.90, tags$sup(style="font-size: 20px", "%"))
})
output$vbox <- renderValueBox({
invalidateLater(500)
setBorderColor(valueBox(
"Title",
input$count,
icon = icon("credit-card")
), sample(myPalette, 1))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
我正在尝试使用十六进制颜色代码(例如“#12ff34”)格式修改 valueBox 的颜色边框。如何访问和设置这样的值?
在下面的三个值框(在“help('box')”中找到的示例的更短和修改版本),如何指定第一个应该有,比如说,红色边框,第二个黑色边框,第三个黄色边框?
谢谢
library(shiny)
library(shinydashboard)
# A dashboard body with a row of valueBoxes
body <- dashboardBody(
# valueBoxes
fluidRow(
valueBox(
uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
),
valueBox(
tagList("60", tags$sup(style="font-size: 20px", "%")),
"Approval Rating", icon = icon("line-chart"), color = "green"
),
valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
)
)
)
server <- function(input, output) {
output$orderNum <- renderText({
x = 789
})
output$progress <- renderUI({
tagList(8.90, tags$sup(style="font-size: 20px", "%"))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
我们可以使用 htmltools::tagQuery
来实现这一点 - 这里有一些关于如何应用它的选项:
library(shiny)
library(shinydashboard)
library(htmltools)
setBorderColor <- function(valueBoxTag, color){tagQuery(valueBoxTag)$find("div.small-box")$addAttrs("style" = sprintf("border-style: solid; border-color: %s; height: 106px;", color))$allTags()}
# A dashboard body with a row of valueBoxes
body <- dashboardBody(
fluidRow(
tagQuery(valueBox(
uiOutput("orderNum"), "New Orders", icon = icon("credit-card")
))$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #FF0000;")$allTags(),
{vb2 <- valueBox(
tagList("60", tags$sup(style="font-size: 20px", "%")),
"Approval Rating", icon = icon("line-chart"), color = "green"
)
tagQuery(vb2)$find("div.small-box")$addAttrs("style" = "border-style: solid; border-color: #000000;")$allTags()
},
{vb3 <- valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
)
setBorderColor(vb3, "#FFFF00")},
valueBoxOutput("vbox")
)
)
myPalette <- colorRampPalette(c("red", "yellow", "green"))( 100 )
server <- function(input, output) {
output$orderNum <- renderText({
x = 789
})
output$progress <- renderUI({
tagList(8.90, tags$sup(style="font-size: 20px", "%"))
})
output$vbox <- renderValueBox({
invalidateLater(500)
setBorderColor(valueBox(
"Title",
input$count,
icon = icon("credit-card")
), sample(myPalette, 1))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)