代码之家  ›  专栏  ›  技术社区  ›  Kevin

Shinydashboard中的CSS无功值框

shinydashboard shiny r css html
  •  1
  • Kevin  · 技术社区  · 6 年前

    我正在尝试自定义 valueboxes 在里面 shinydashboard 使用 css . 我发现的问题是:

    1. 我不能标记特定的 valuebox 这使得 CSS 更改适用于所有
    2. 我不知道怎么做 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)
    1 回复  |  直到 6 年前
        1
  •  1
  •   SeGa    6 年前

    我用过 shinjys 以及 addClass / removeClass 用于添加CSS类的函数。3个CSS类(白色、黄色、红色)是根据 valueBox .

    在分配之前,您必须删除所有这些潜在的类,否则它只会附加CSS类,然后颜色就不会改变。

    此示例显示了具有2的行为 valueBoxes 和2 sliderInputs 更改值框的值。

    更新 : shinyjs 需要呼叫 useShinyjs() 在UI中。 

    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)
    推荐文章
    Yunusović  ·  我无法用css更改html段落颜色
    1 年前
    Blake  ·  无法使用CSS旋转Angular 15中的字体图标
    1 年前
    Maarten -Monica for president  ·  将图像放在锚点标记内时调整网格中的图像大小
    1 年前
    Phil Lucks  ·  如何制作边界的外半径?
    1 年前
    roy_meir  ·  创建自定义下拉式元素
    1 年前
    Community wiki  ·  如何为触摸设备优化网站
    1 年前
    Paras Chandravanshi  ·  为什么<ul>没有从其父<p>元素继承?
    1 年前
    tpetzoldt  ·  如何在有光泽的情况下抑制图像的抗锯齿?
    1 年前
    boyenec  ·  反应如何将css样式应用于我从api respose获得的页面的spcifc部分
    1 年前
    manofconstsorrow  ·  点击导航项目关闭汉堡菜单
    1 年前
    关于  
    代码之家 - 一站式码农服务社区
    沪ICP备11025650号