を使用してカスタマイズしようとvalueboxesしshinydashboardていcssます。私が見つけている問題は次のとおりです。
valueboxすべてにcss変更を適用する特定のタグを付けることはできませんcssサーバー側からの入力に基づいてリアクティブにする方法がわかりません以下は、私がやろうとしていることを説明する私のコードです。各値ボックスには、数値のパーセンテージに対して異なる色のフォントが必要です。
library (shiny)
library (shinydashboard)
library (shinydashboardPlus)
rm(list=ls())
###########################/ui.R/##################################
#Header----
header <- dashboardHeaderPlus(
title = "Test",
enable_rightsidebar = TRUE,
rightSidebarIcon = "sliders"
)
#Right SideBar----
rightsidebar <- rightSidebar()
#SideBar----
sidebar <- dashboardSidebar(
#Sidebar Menu----
div(id = "sidebarChoices",
#style = "position: fxed; overflow: visible;",
sidebarMenu(id = "menuChoice",
menuItem("Functional Dashboards", tabName = "MetricMenu", icon = icon("dashboard"),
menuSubItem("Operations", tabName = "OpsMetricSubMenu", icon = icon("angle-double-right"))
)
)
)
)
#Body----
body <- dashboardBody(
#OPS Page----
tags$head(tags$style(HTML("
.small-box {background-color: #000000 !important;border-radius: 1vh !important; border-color: #D20000 !important;}
.small-box .icon-large {font-size: 8vh !important; bottom: -2vh !important; color: #999999 !important;}
.small-box h3 {font-size: 4vh !important; color: #D20000 !important;}
.small-box p {font-size: 1vh !important;}
"))),
#OPERATIONS KPI----
tabItem(tabName = "OpsMetricSubMenu",
#First Row: KPI Metrics----
div(id = "Ops_FirstRow",
fluidRow(
valueBoxOutput("Box1", width = 2),
valueBoxOutput("Box2", width = 2),
valueBoxOutput("Box3", width = 2),
valueBoxOutput("Box4", width = 2)
)
)
)
)
#Builds Dashboard Page----
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
###########################/server.R/###############################
server <- function(input, output, session) {
output$Box1 <- renderValueBox({
Value <- 50
if (Value <= 100 & Value >= 90) {Color = "#FFFFFF"
} else if (Value < 90 & Value >= 80) {Color = "#F6FC00"
} else if (Value < 80) {Color = "#D20000"
} else {Color = "FFFFFF"}
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$Box2 <- renderValueBox({
Value <- 85
if (Value <= 100 & Value >= 90) {Color = "#FFFFFF"
} else if (Value < 90 & Value >= 80) {Color = "#F6FC00"
} else if (Value < 80) {Color = "#D20000"
} else {Color = "FFFFFF"}
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$Box3 <- renderValueBox({
Value <- 110
if (Value <= 100 & Value >= 90) {Color = "#FFFFFF"
} else if (Value < 90 & Value >= 80) {Color = "#F6FC00"
} else if (Value < 80) {Color = "#D20000"
} else {Color = "FFFFFF"}
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$Box4 <- renderValueBox({
Value <- 98
if (Value <= 100 & Value >= 90) {Color = "#FFFFFF"
} else if (Value < 90 & Value >= 80) {Color = "#F6FC00"
} else if (Value < 80) {Color = "#D20000"
} else {Color = "FFFFFF"}
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
}
#Combines Dasboard and Data together----
shinyApp(ui, server)
以下の解決策はうまくいきます！
library (shiny)
library (shinydashboard)
library (shinydashboardPlus)
library (ggplot2)
library (leaflet)
library (date)
library (tidyr)
library (dplyr)
library (data.table)
library (zoo)
library (tibble)
library (billboarder)
library (scales)
library (highcharter)
library (quantmod)
library (gplots)
library (RColorBrewer)
library (plotrix)
library (RODBC)
library (png)
library (rpivotTable)
library (lubridate)
library (timeDate)
library (shinycssloaders)
library (shinyjs)
library (DT)
library (rintrojs)
library (profvis)
library (bit64)
library (collapsibleTree)
rm(list=ls())
###########################/ui.R/##################################
#Header----
header <- dashboardHeaderPlus(
title = tagList(
span(class = "logo-lg", "MRO Dash"),
imageOutput("HLogo")),
tags$li(class = "dropdown",
tags$a(htmlOutput("Refresh"))
),
enable_rightsidebar = TRUE,
rightSidebarIcon = "sliders"
)
#Right SideBar----
rightsidebar <- rightSidebar()
#SideBar----
sidebar <- dashboardSidebar(
#Sidebar Menu----
div(id = "sidebarChoices",
#style = "position: fxed; overflow: visible;",
sidebarMenu(id = "menuChoice",
menuItem("Functional Dashboards", tabName = "MetricMenu", icon = icon("dashboard"),
menuSubItem("Operations", tabName = "OpsMetricSubMenu", icon = icon("angle-double-right"))
)
)
)
#End )----
) #dashboard sidebar end
#Body----
body <- dashboardBody(
useShinyjs(),
#CSS Formatting----
#Background colors----
#tags$head(tags$style(HTML(".sidebar {height: 90vh; overflow-y: auto;}"))),
tags$head(tags$link(rel="shortcut icon", href="favicon.ico")),
# /* other links in the sidebarmenu when hovered */
# .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{background-color: #E4551F;}
tags$head(tags$style(HTML('
/*** FORMATTING BACKGROUND COLORS ***/
/* Top Left of Header Background */
.skin-blue .main-header .logo {background-color: #000000;}
/*Top Left of Header when Hovered */
.skin-blue .main-header .logo:hover {background-color: #E4551F;}
/* Rest of the Header Background */
.skin-blue .main-header .navbar {background-color: #000000;}
/* Main SideBar Background */
.skin-blue .main-sidebar {background-color: #1A1A1A;}
/* Tabs in SideBar Background */
.skin-blue .main-sidebar .sidebar .sidebar-menu a{background-color: #1A1A1A;}
/* Active Tab in SideBar Background */
.skin-blue .main-sidebar .sidebar .sidebar-menu .active a{background-color: #E4551F;}
/* Left bar on Sidebar */
.skin-blue .sidebar-menu > li.active > a {border-left-color: #E4551F;}
.skin-blue .sidebar-menu > li.active > a, .skin-blue .sidebar-menu > li:hover > a {border-left-color: #E4551F;}
/* toggle button when hovered */
.skin-blue .main-header .navbar .sidebar-toggle:hover{background-color: #E4551F;}
/* Right SideBar Background */
.control-sidebar-dark+.control-sidebar-bg {background: #1A1A1A;}
.control-sidebar-dark+.nav.nav-tabs.nav-justified.control-sidebar-tabs {background: #1A1A1A;}
.control-sidebar-dark+.control-sidebar.control-sidebar-dark.control-sidebar-open {background: #1A1A1A;}
/* Body Background */
.content-wrapper, .right-side {background-color: #FFFFFF;}
'))),
#Header Logo----
tags$head(tags$style(HTML('
.main-header .logo {
padding: 0px 0px;
}
'))),
#Boxes----
tags$head(tags$style(HTML('
.box.box-primary{
border-top-color:#E4551F;
border-bottom-color:#E4551F;
border-color: #E4551F
border-left-color:#E4551F;
border-right-color:#E4551F;
}
.box.box-solid.box-primary{
border-color: #E4551F
}
.box.box-solid.box-primary>.box-header{
background-color: #E4551F;
}
'))), #.nav.nav-tabs.shiny-tab-input.shiny-bound-input > li[class=active] > a {border-top-color:#E4551F;}
#Icon----
tags$style('.fa-plus-square-o {color:#E4551F}'),
#OPS Page----
tags$head(tags$style(HTML("
.small-box {background-color: #000000 !important;border-radius: 1vh !important; box-shadow: 0.3vh 0.3vh 0vh #CCCCCC;}
.small-box .icon-large {font-size: 8vh !important; bottom: -2vh !important; color: #999999 !important;}
.small-box h3 {font-size: 4vh !important;}
.small-box p {font-size: 1vh !important; color: #FFFFFF !important;}
.white .small-box h3{color: #FFFFFF !important;}
.yellow .small-box h3{color: #F6FC00 !important;}
.red .small-box h3{color: #D20000 !important;}
#DailyLinearityShip {height:25vh !important;}
#MonthlyLinearityShip {height:25vh !important;}
"))),
#OPERATIONS KPI----
tabItem(tabName = "OpsMetricSubMenu",
#First Row: KPI Metrics----
div(id = "Ops_FirstRow",
fluidRow(
valueBoxOutput("Box1", width = 2),
valueBoxOutput("Box2", width = 2),
valueBoxOutput("Box3", width = 2),
valueBoxOutput("Box4", width = 2)
)
),
#Third Row: Linearity----
fluidRow(
div(id = "DailyLinearityBox",
box(
title = "Daily Shipment Linearity", status = "primary", solidHeader = FALSE,
highchartOutput("DailyLinearityShip") %>% withSpinner(color="#E4551F")
)
),
div(id = "MonthlyLinearityBox",
box(
title = "Monthly Shipment Linearity", status = "primary", solidHeader = TRUE,
highchartOutput("MonthlyLinearityShip") %>% withSpinner(color="#E4551F")
)
)
),
#Fourth Row: WIP----
div(id = "Ops_FourthRow",
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
title = p("WIP Status",actionLink("WIPOnTimeLink", NULL, icon = icon("plus-square-o"))), width = 4
)
)
)
)
)
)
#Builds Dashboard Page----
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
###########################/server.R/###############################
server <- function(input, output, session) {
output$Box1 <- renderValueBox({
Value <- 50
lapply(c("white", "yellow", "red"), function(i) removeClass("Box1", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box1", Color)
valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
})
output$Box2 <- renderValueBox({
Value <- 85
lapply(c("white", "yellow", "red"), function(i) removeClass("Box2", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box2", Color)
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$Box3 <- renderValueBox({
Value <- 110
lapply(c("white", "yellow", "red"), function(i) removeClass("Box3", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box3", Color)
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$Box4 <- renderValueBox({
Value <- 98
lapply(c("white", "yellow", "red"), function(i) removeClass("Box4", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box4", Color)
CommercialOTDBox <- valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
return(CommercialOTDBox)
})
output$MonthlyLinearityShip <- renderHighchart({
SumIntake <- c(5,10,15,20,20,20,25,30,35,40,45,45,45)
SumShip <- c(6,12,14,20,20,20,22,28,33,42,44,50,55)
GoalShip <- c(7,14,21,25,25,25,30,35,40,45,55,60, 65)
Index <- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
Linearity <- data.frame(SumIntake,SumShip,GoalShip,Index)
highchart() %>%
hc_chart(type = "column") %>%
hc_xAxis(categories = Linearity$Index, labels = list(style = list(fontSize = "1.2vh"))) %>%
hc_yAxis(gridLineWidth = 0, labels = list(style = list(fontSize = "1.2vh"))) %>%
hc_add_series(data = Linearity$SumIntake, name = "Intakes", color = "#E4551F") %>%
hc_add_series(data = Linearity$SumShip, name = "Shipments", color = "#000000") %>%
hc_add_series(data = Linearity$GoalShip, name = "Plan", type = "line", color = "#F2A900") %>%
hc_plotOptions(line = list(marker = list(enabled = FALSE))) %>%
hc_legend(enabled = TRUE, verticalAlign = "top") %>%
hc_tooltip(crosshairs = TRUE, shared = TRUE, headerFormat = "<b>Day {point.x}</b><br>", allowDecimals = FALSE)
})
output$DailyLinearityShip <- renderHighchart({
SumShip <- c(6,12,14,20,20,20,22,28,33,42,44,50,55)
GoalShip <- c(7,14,21,25,25,25,30,35,40,45,55,60, 65)
Index <- c(1,2,3,4,5,6,7,8,9,10,11,12,13)
Linearity <- data.frame(SumShip,GoalShip,Index)
highchart() %>%
hc_chart(type = "line") %>%
hc_xAxis(categories = Linearity$Index, labels = list(style = list(fontSize = "1.2vh"))) %>%
hc_yAxis(gridLineWidth = 0, labels = list(style = list(fontSize = "1.2vh"))) %>%
hc_add_series(data = Linearity$SumShip, name = "Shipments", color = "#000000") %>%
hc_add_series(data = Linearity$GoalShip, name = "Plan", type = "line", color = "#F2A900") %>%
hc_plotOptions(line = list(marker = list(enabled = FALSE))) %>%
hc_legend(enabled = TRUE, verticalAlign = "top") %>%
hc_tooltip(crosshairs = TRUE, shared = TRUE, headerFormat = "<b>Day {point.x}</b><br>", allowDecimals = FALSE)
})
}
#Combines Dasboard and Data together----
shinyApp(ui, server)
/関数を使用shinjysしてcssクラスを追加しました。3つのcssクラス（白、黄、赤）は事前定義されており、の値に基づいて割り当てられます。addClassremoveClassvalueBox
その割り当ての前に、それらの潜在的なクラスをすべて削除する必要があります。そうしないと、css-classesが追加されるだけで、色は変わりません。
この例は、valueBoxesの値を変更するための2valueBoxesと2の動作を示していますsliderInputs。
更新：UIでをshinyjs呼び出す必要がありますuseShinyjs()。
library (shiny)
library (shinydashboard)
library (shinydashboardPlus)
library (shinyjs)
########################### CSS ##########################
css = HTML("
.white .small-box {
background-color: #FFFFFF !important;
}
.yellow .small-box {
background-color: #F6FC00 !important;
}
.red .small-box {
background-color: #D20000 !important;
}
")
###########################/ui.R/##################################
#Header
header <- dashboardHeaderPlus(
title = "Test",
enable_rightsidebar = TRUE,
rightSidebarIcon = "sliders"
)
#Right SideBar
rightsidebar <- rightSidebar()
#SideBar
sidebar <- dashboardSidebar(
#Sidebar Menu
div(id = "sidebarChoices",
#style = "position: fxed; overflow: visible;",
sidebarMenu(id = "menuChoice",
menuItem("Functional Dashboards", tabName = "MetricMenu", icon = icon("dashboard"),
menuSubItem("Operations", tabName = "OpsMetricSubMenu", icon = icon("angle-double-right"))
)
)
)
)
#Body
body <- dashboardBody(
useShinyjs(),
tags$head(tags$style(css)),
#OPERATIONS KPI
tabItem(tabName = "OpsMetricSubMenu",
#First Row: KPI Metrics
div(id = "Ops_FirstRow",
fluidRow(
sliderInput("valBox1", "Change Value for Box1", min = 0, 100, 50),
valueBoxOutput("Box1", width = 2),
sliderInput("valBox2", "Change Value for Box2", min = 0, 100, 85),
valueBoxOutput("Box2", width = 2)
)
)
)
)
#Builds Dashboard Page
ui <- dashboardPagePlus(header, sidebar, body, rightsidebar)
###########################/server.R/###############################
server <- function(input, output, session) {
output$Box1 <- renderValueBox({
Value <- input$valBox1
lapply(c("white", "yellow", "red"), function(i) removeClass("Box1", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box1", Color)
valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
})
output$Box2 <- renderValueBox({
Value <- input$valBox2
lapply(c("white", "yellow", "red"), function(i) removeClass("Box2", i))
if (Value <= 100 & Value >= 90) {Color = "white"
} else if (Value < 90 & Value >= 80) {Color = "yellow"
} else if (Value < 80) {Color = "red"
} else {Color = "white"}
addClass("Box2", Color)
valueBox(value = paste0(Value, "%"), subtitle = "OTD DIH Commercial MTD /Goal: 90%", icon = icon("plane"), href = "#")
})
}
#Combines Dasboard and Data together----
shinyApp(ui, server)
この記事はインターネットから収集されたものであり、転載の際にはソースを示してください。
侵害の場合は、連絡してください[email protected]
コメントを追加