问题
I have the shiny app below in which I want to apply css formating only on specific tabItem of the shiny dashboard but it is applied on both. How can I specify it to be applied only on 1st?
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)
回答1:
Try to make your question code minimal. There is also a missing sidebarMenu around your menuItem. Here using a simplified version of your code to highlite what to do.
First move your style tag to the dashboard body. It will always go to the head of your page even if you put it in a tabItem!
To limit the style to a specific tabItem, prepend the selector in your stylesheet with #shiny-tab-TABNAME (replace TABNAME with your 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)
回答2:
Wrap the contents of tab1 in a div() with an id, and CSS should be defined only for that id. I define mytab as the id in the code below.
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)
来源：https://stackoverflow.com/questions/65510715/apply-css-formating-only-on-specific-tabitem-of-a-shiny-dashboard