如何更改 shiny 中的 table 主题
How to change the table theme in shiny
这是我的示例代码:
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(shinythemes)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
theme = shinytheme("superhero"),
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
bsTooltip(id = "plot1", title = "Please be patient as this calculation process takes some time.", placement = "right", trigger = "hover"),
actionButton(inputId = "dataTable", label = "dataTable",width=100,class = "btn btn-primary"),
),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot"),
#uiOutput("all")
tags$style(HTML("
.dataTables_wrapper .dataTables_length, .dataTables_wrapper .dataTables_filter, .dataTables_wrapper .dataTables_info, .dataTables_wrapper .dataTables_processing, .dataTables_wrapper .dataTables_paginate, .dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ffffff;
}
### ADD THIS HERE ###
.dataTables_wrapper .dataTables_paginate .paginate_button{box-sizing:border-box;display:inline-block;min-width:1.5em;padding:0.5em 1em;margin-left:2px;text-align:center;text-decoration:none !important;cursor:pointer;*cursor:hand;color:#ffffff !important;border:1px solid transparent;border-radius:2px}
###To change text and background color of the `Select` box ###
.dataTables_length select {
color: #0E334A;
background-color: #0E334A
}
###To change text and background color of the `Search` box ###
.dataTables_filter input {
color: #0E334A;
background-color: #0E334A
}
thead {
color: #ffffff;
}
tbody {
color: #000000;
}
"
)),
dataTableOutput('dataTable')
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
output$dataTable <- DT::renderDataTable({mean_data})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
我用的是 superhero shiny 主题。但这导致我的 table 输出看起来不那么适合 table 闪亮的主题。
输出结果是这样的:
只需调整table主题即可。不要关注其他细节。
请给我一些adivce.Vary感激不尽
我也在我的table主题中添加了code.But我不知道如何更改它。
这个问题我自己解决了
虽然修改后的代码让我很困惑。但是我知道如何改变我想改变的地方的颜色。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(shinythemes)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
theme = shinytheme("superhero"),
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
bsTooltip(id = "plot1", title = "Please be patient as this calculation process takes some time.", placement = "right", trigger = "hover"),
actionButton(inputId = "dataTable", label = "dataTable",width=100,class = "btn btn-primary"),
),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot"),
#uiOutput("all")
tags$style(HTML("
.dataTables_filter input {
color: #000000;
background-color: #ffffff
}
thead {
color: #ff7500;
}
.dataTables_wrapper .dataTables_length,
.dataTables_wrapper .dataTables_filter,
.dataTables_wrapper .dataTables_info,
.dataTables_wrapper .dataTables_processing,
.dataTables_wrapper .dataTables_paginate {
color: #ff7500;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
color: #ff7500 !important;
}
.dataTables_wrapper .dataTables_paginate .paginate_button.current,
.dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ff7500 !important;"
)),
dataTableOutput('dataTable')
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
output$dataTable <- DT::renderDataTable({mean_data})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
如上:
我的代码的重要部分在这里:
tags$style(HTML("
.dataTables_filter input {
color: #000000;
background-color: #ffffff
}
thead {
color: #ff7500;
}
.dataTables_wrapper .dataTables_length,
.dataTables_wrapper .dataTables_filter,
.dataTables_wrapper .dataTables_info,
.dataTables_wrapper .dataTables_processing,
.dataTables_wrapper .dataTables_paginate {
color: #ff7500;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
color: #ff7500 !important;
}
.dataTables_wrapper .dataTables_paginate .paginate_button.current,
.dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ff7500 !important;"
)),
谢谢
这是我的示例代码:
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(shinythemes)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
theme = shinytheme("superhero"),
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
bsTooltip(id = "plot1", title = "Please be patient as this calculation process takes some time.", placement = "right", trigger = "hover"),
actionButton(inputId = "dataTable", label = "dataTable",width=100,class = "btn btn-primary"),
),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot"),
#uiOutput("all")
tags$style(HTML("
.dataTables_wrapper .dataTables_length, .dataTables_wrapper .dataTables_filter, .dataTables_wrapper .dataTables_info, .dataTables_wrapper .dataTables_processing, .dataTables_wrapper .dataTables_paginate, .dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ffffff;
}
### ADD THIS HERE ###
.dataTables_wrapper .dataTables_paginate .paginate_button{box-sizing:border-box;display:inline-block;min-width:1.5em;padding:0.5em 1em;margin-left:2px;text-align:center;text-decoration:none !important;cursor:pointer;*cursor:hand;color:#ffffff !important;border:1px solid transparent;border-radius:2px}
###To change text and background color of the `Select` box ###
.dataTables_length select {
color: #0E334A;
background-color: #0E334A
}
###To change text and background color of the `Search` box ###
.dataTables_filter input {
color: #0E334A;
background-color: #0E334A
}
thead {
color: #ffffff;
}
tbody {
color: #000000;
}
"
)),
dataTableOutput('dataTable')
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
output$dataTable <- DT::renderDataTable({mean_data})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
我用的是 superhero shiny 主题。但这导致我的 table 输出看起来不那么适合 table 闪亮的主题。
输出结果是这样的:
只需调整table主题即可。不要关注其他细节。
请给我一些adivce.Vary感激不尽
我也在我的table主题中添加了code.But我不知道如何更改它。
这个问题我自己解决了
虽然修改后的代码让我很困惑。但是我知道如何改变我想改变的地方的颜色。
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
library(shinythemes)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
theme = shinytheme("superhero"),
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
bsTooltip(id = "plot1", title = "Please be patient as this calculation process takes some time.", placement = "right", trigger = "hover"),
actionButton(inputId = "dataTable", label = "dataTable",width=100,class = "btn btn-primary"),
),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot"),
#uiOutput("all")
tags$style(HTML("
.dataTables_filter input {
color: #000000;
background-color: #ffffff
}
thead {
color: #ff7500;
}
.dataTables_wrapper .dataTables_length,
.dataTables_wrapper .dataTables_filter,
.dataTables_wrapper .dataTables_info,
.dataTables_wrapper .dataTables_processing,
.dataTables_wrapper .dataTables_paginate {
color: #ff7500;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
color: #ff7500 !important;
}
.dataTables_wrapper .dataTables_paginate .paginate_button.current,
.dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ff7500 !important;"
)),
dataTableOutput('dataTable')
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
output$dataTable <- DT::renderDataTable({mean_data})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
如上:
我的代码的重要部分在这里:
tags$style(HTML("
.dataTables_filter input {
color: #000000;
background-color: #ffffff
}
thead {
color: #ff7500;
}
.dataTables_wrapper .dataTables_length,
.dataTables_wrapper .dataTables_filter,
.dataTables_wrapper .dataTables_info,
.dataTables_wrapper .dataTables_processing,
.dataTables_wrapper .dataTables_paginate {
color: #ff7500;
}
.dataTables_wrapper .dataTables_paginate .paginate_button {
color: #ff7500 !important;
}
.dataTables_wrapper .dataTables_paginate .paginate_button.current,
.dataTables_wrapper .dataTables_paginate .paginate_button.current:hover {
color: #ff7500 !important;"
)),