如何在 R 中创建动态 HTML 表格
Sop*_*son 5 css r html-table dataframe kableextra
我在 R 中使用以下结构化数据框。
数据框<-
seq count percentage Marking count Percentage batch_no count Percentage
FRD 1 12.50% S1 2 25.00% 6 1 12.50%
FHL 1 12.50% S2 1 12.50% 7 2 25.00%
ABC 2 25.00% S3 1 12.50% 8 2 25.00%
DEF 1 12.50% Hold 2 25.00% 9 1 12.50%
XYZ 1 12.50% NA 1 12.50% NA 1 12.50%
ZZZ 1 12.50% (Blank) 1 12.50% (Blank) 1 12.50%
FRD 1 12.50% - - - - - -
NA 1 12.50% - - - - - -
(Blank) 0 0.00% - - - - - -
Total 8 112.50% - 8 100.00% - 8 100.00%
数据框的列数是静态的，但行数可以有所不同。例如，在某些条件下，行数可能为 15 或更少，可能为 4 或 5。
我需要将表格标题颜色添加为带有粗体的浅绿色，并将表格的最后一行添加为带有粗体的黄色。另外，需要添加条件，如果Percentage标记中的Hold和Percentagebatch_no中的8大于25％，则将其标记为深红色加粗白色字体。
如果可能，我们可以在S3asS3 (In Progress)和9as `9 (In Progress) 中添加后缀，其中 (In Progress) 的字体将比变量名称少 2 字体。
添加的文本(In Progress)应为粗体黄色字体。
我正在使用下面提到的代码：
library(tableHTML)
library(dplyr)
add_font <- function(x) {
x <- gsub('\\(', '\\(<font size="-1">', x)
x <- gsub('\\)', '</font>\\)', x)
return(prettyNum(x, big.mark = ','))
}
Html_Table<-Dataframe %>%
mutate(`Marking` = add_font(`Marking`),
`batch_no` = add_font(`batch_no`)) %>%
tableHTML(rownames = FALSE,
escape = FALSE,
widths = rep(100, 12),
caption = "Dataframe: Test",
theme='scientific') %>%
add_css_caption(css = list(c("font-weight", "border","font-size"),
c("bold", "1px solid black","16px"))) %>%
add_css_row(css = list(c("background-color"), c("lightblue")), rows = 0:1)%>%
add_css_caption(css = list(c("background-color"), c("lightblue"))) %>%
add_css_row(css = list('background-color', '#f2f2f2'),
rows = odd(1:10)) %>%
add_css_row(css = list('background-color', '#e6f0ff'),
rows = even(1:10)) %>%
add_css_row(css = list(c("background-color","font-weight"), c("yellow", "bold")),
rows = even(2:3)) %>%
add_css_row(css = list(c("font-style","font-size"), c("italic","12px")),
rows = 4:8)
实际上，您可以准确地使用您所做的事情add_font来获得 tableHTML 所需的内容
library(tableHTML)
library(dplyr)
Dataframe <- read.table(text='seq count percentage Marking count percentage batch_no count percentage
FRD 1 12.50% S1 2 25.00% 6 1 12.50%
FHL 1 12.50% S2 1 12.50% 7 2 25.00%
ABC 2 25.00% S3 1 12.50% 8 2 25.00%
DEF 1 12.50% Hold 2 25.00% 9 1 12.50%
XYZ 1 12.50% NA 1 12.50% NA 1 12.50%
ZZZ 1 12.50% (Blank) 1 12.50% (Blank) 1 12.50%
FRD 1 12.50% - - - - - -
NA 1 12.50% - - - - - -
(Blank) 0 0.00% - - - - - -
Total 8 112.50% - 8 100.00% - 8 100.00%',
header = TRUE, stringsAsFactors = FALSE) %>% as_tibble()
names_orig <- Dataframe %>% names()
# add numeric columns to get the conditions
Dataframe$percentage.1_num <- gsub("%", "", Dataframe$percentage) %>% as.numeric()
Dataframe$percentage.2_num <- gsub("%", "", Dataframe$percentage.1) %>% as.numeric()
add_font <- function(x) {
x <- gsub('\\(', '\\(<font size="-1">', x)
x <- gsub('\\)', '</font>\\)', x)
return(x)
}
add_style <- function(x, style){
x <- paste0('<div ', style, '>', x, '</div>')
return(x)
}
add_in_progress <- function(x){
x <- paste0(x, '<font size="1" color="red">', '(In Progress)', '</font>')
return(x)
}
# define the style you want to apply where the condition hold
style <- 'style="background-color:darkred;font-weight:bold;color:white;"'
condition_1 <- Dataframe$Marking=='Hold' & Dataframe$percentage.1_num > 10
condition_2 <- Dataframe$batch_no==8 & Dataframe$percentage.2_num > 10
Html_Table<-
Dataframe %>%
mutate(`Marking` = add_font(`Marking`),
`batch_no` = add_font(`batch_no`)) %>%
# add the style where the condition holds
mutate(percentage = ifelse(condition_1,
add_style(percentage, style),
percentage),
# Marking = ifelse(condition_1,
# add_style(Marking, style),
# Marking),
percentage.1 = ifelse(condition_2,
add_style(percentage.1, style),
percentage.1),
# batch_no = ifelse(condition_2,
# add_style(batch_no, style),
# batch_no)
) %>%
# add in progress where the condition holds
mutate(Marking = ifelse(Marking=='S3',
add_in_progress(Marking),
Marking)) %>%
mutate(batch_no = ifelse(batch_no=='9',
add_in_progress(batch_no),
batch_no)) %>%
# select the columns you want to show
select(names_orig) %>%
# give it to tableHTML, you could also set the headers you want to show
# and replace character NA with the empty string
tableHTML(rownames = FALSE,
escape = FALSE,
widths = rep(100, 9),
replace_NA = '',
headers = names_orig %>% gsub('.[1-9]', '', .),
caption = "Dataframe: Test",
border = 0) %>%
# header style
add_css_header(css = list(c('background-color', 'border-top', 'border-bottom'),
c('lightgreen', '3px solid black', '3px solid black')),
headers = 1:ncol(Dataframe)) %>%
# last row style
add_css_row(css = list(c('background-color', 'font-weight'),
c('yellow', 'bold')),
rows = nrow(Dataframe)+1)
Html_Table
