仅在闪亮仪表板的特定 tabItem 上应用 css 格式

Question

我有下面的闪亮应用程序，我想在其中应用 css 格式化仅在闪亮仪表板的特定 tabItem 上，但它同时应用于两者。如何指定它仅在 1 日应用？

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(menuItem("Welcome", tabName = "tab1", icon = icon("house")),
                   menuItem("Information", tabName = "tab2", icon = icon("table"))),
  dashboardBody(
    tabItems(
      tabItem("tab1",
              tags$head(tags$style(HTML('
      
  body{
  font-size: 12pt;
  font-family: "Montserrat Light", sans-serif;
  text-align: justify;
  background-color: linen;
}
  H1.title{
  font-size: 44pt;
  font-family: "Chronicle Display Light", Times, serif;
  text-align: right;
  background-color: linen;
}
  H1{
  font-size: 44pt;
  font-family: "Chronicle Display Light", Times, serif;
  text-align: right;
  background-color: linen;
}
  H2{
  font-size: 16pt;
  font-weight: bold;
  font-family: "Chronicle Display Light", Times, serif;
  text-align: left;
  background-color: linen;
}

    '))),
              fluidRow(column(3,h3("Concent"))),
              tags$hr(),
              fluidRow(column(3,h5(strong("Investigators")))),
              fluidRow(column(9,"The investigators of this project are:")),
              fluidRow(column(9,"Dr Adam Hodgkins","(",tags$a (href="adam@hodgkins.com.au","adam@hodgkins.com.au"),")")),
              fluidRow(column(9,"Dr Hodgkins can be contacted by telephone on 0414 296 699. ")),
              tags$hr(),
              fluidRow(column(3,h5(strong("Consent")))),
              fluidRow(column(12,"The practice owners have been given information about the research project titled “Life, death and statins: Survival analysis of elderly general practice patients in relation to statin prescriptions.”")),
              fluidRow(column(12,"The practice owners have been provided the opportunity to discuss the research with the investigators who are conducting this research as part of the University of Wollongong. ")),
              fluidRow(column(12,"The practice owners have been advised of any possible risks or burdens associated with this research and have had the opportunity to ask the investigators any questions they may have about the research and my participation.


")),
              tags$hr(),
              fluidRow(column(12,"I understand our practice’s participation is voluntary, our practice is free to choose not to participate and is free to withdraw from the research at any time. Our practice’s choice to not participate or to withdraw consent will not affect its relationship with the researchers or the University of Wollongong. 


"))
              ),
      tabItem("tab2",
              fluidRow(column(3,h3("Concent"))),
              tags$hr(),
              fluidRow(column(3,h5(strong("Investigators")))),
              fluidRow(column(9,"The investigators of this project are:")),
              fluidRow(column(9,"Dr Adam Hodgkins","(",tags$a (href="adam@hodgkins.com.au","adam@hodgkins.com.au"),")")),
              fluidRow(column(9,"Dr Hodgkins can be contacted by telephone on 0414 296 699. ")),
              tags$hr(),
              fluidRow(column(3,h5(strong("Consent")))),
              fluidRow(column(12,"The practice owners have been given information about the research project titled “Life, death and statins: Survival analysis of elderly general practice patients in relation to statin prescriptions.”")),
              fluidRow(column(12,"The practice owners have been provided the opportunity to discuss the research with the investigators who are conducting this research as part of the University of Wollongong. ")),
              fluidRow(column(12,"The practice owners have been advised of any possible risks or burdens associated with this research and have had the opportunity to ask the investigators any questions they may have about the research and my participation.


")))
    )
    
  )
)

server <- function(input, output) { }

shinyApp(ui, server)

Answer 1

用 id 将 tab1 的内容包装在 div() 中，并且 CSS 应该只为那个 id 定义。我在下面的代码中将 mytab 定义为 id。

css <- "
  #mytab body{
  font-size: 12pt;
  text-align: justify;
  background-color: linen;
}
  #mytab H1.title{
  font-size: 44pt;
  text-align: right;
  background-color: linen;
}
  #mytab H1{
  font-size: 44pt;
  text-align: right;
  background-color: linen;
}
  #mytab H2{
  font-size: 16pt;
  font-weight: bold;
  text-align: left;
  background-color: linen;
}
"
  
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sidebarMenu(menuItem("Welcome", tabName = "tab1", icon = icon("home")),
                   menuItem("Information", tabName = "tab2", icon = icon("table")))),
  dashboardBody(
    tags$style(css),
    tabItems(
      tabItem(tabName="tab1", div( id="mytab",
              fluidRow(column(3,h1("Consent"))),
              tags$hr(),
              fluidRow(column(3,h2(strong("Investigators")))),
              fluidRow(column(9,"The investigators of this project are:")),
              fluidRow(column(9,"Dr Adam Hodgkins","(",tags$a (href="adam@hodgkins.com.au","adam@hodgkins.com.au"),")")),
              fluidRow(column(9,"Dr Hodgkins can be contacted by telephone on 0414 296 699. ")),
              tags$hr(),
              fluidRow(column(3,h1(strong("Consent")))),
              fluidRow(column(12,"The practice owners have been given information about the research project titled “Life, death and statins: Survival analysis of elderly general practice patients in relation to statin prescriptions.”")),
              fluidRow(column(12,"The practice owners have been provided the opportunity to discuss the research with the investigators who are conducting this research as part of the University of Wollongong. ")),
              fluidRow(column(12,"The practice owners have been advised of any possible risks or burdens associated with this research and have had the opportunity to ask the investigators any questions they may have about the research and my participation.


")),
              tags$hr(),
              fluidRow(column(12,"I understand our practice’s participation is voluntary, our practice is free to choose not to participate and is free to withdraw from the research at any time. Our practice’s choice to not participate or to withdraw consent will not affect its relationship with the researchers or the University of Wollongong. 


"))
      )),
      tabItem(tabName = "tab2",
              fluidRow(column(3,h3("Concent"))),
              tags$hr(),
              fluidRow(column(3,h5(strong("Investigators")))),
              fluidRow(column(9,"The investigators of this project are:")),
              fluidRow(column(9,"Dr Adam Hodgkins","(",tags$a (href="adam@hodgkins.com.au","adam@hodgkins.com.au"),")")),
              fluidRow(column(9,"Dr Hodgkins can be contacted by telephone on 0414 296 699. ")),
              tags$hr(),
              fluidRow(column(3,h5(strong("Consent")))),
              fluidRow(column(12,"The practice owners have been given information about the research project titled “Life, death and statins: Survival analysis of elderly general practice patients in relation to statin prescriptions.”")),
              fluidRow(column(12,"The practice owners have been provided the opportunity to discuss the research with the investigators who are conducting this research as part of the University of Wollongong. ")),
              fluidRow(column(12,"The practice owners have been advised of any possible risks or burdens associated with this research and have had the opportunity to ask the investigators any questions they may have about the research and my participation.


")))
    )
    
  )
)

server <- function(input, output) {NULL}

shinyApp(ui, server)

Answer 2

尽量使您的问题代码最少。你的 menuItem 周围也少了一个 sidebarMenu。这里使用您的代码的简化版本来强调要做什么。

首先将您的样式标签移至仪表板正文。即使您将它放在 tabItem 中，它也会始终位于页面的头部！

要将样式限制为特定 tabItem，请在样式表中的选择器前添加#shiny-tab-TABNAME（将 TABNAME 替换为您的标签名称）

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Welcome", tabName = "tab1", icon = icon("house")),
      menuItem("Information", tabName = "tab2", icon = icon("table"))
    )
  ),
  dashboardBody(
    tags$head(
      tags$style(
        HTML('
          #shiny-tab-tab2 h1 {
            color: red;
          }
        ')
      )
    ),
    tabItems(
      tabItem(
        "tab1", tags$h1('TAB1')
      ),
      tabItem(
        "tab2", tags$h1('TAB2')
      )
    )
    
  )
)

server <- function(input, output) {
  
}

shinyApp(ui, server)

仅在闪亮仪表板的特定 tabItem 上应用 css 格式

Apply css formating only on specific tabItem of a shiny dashboard

css

r

shiny

shinydashboard