css - 如何在 R 中创建动态 HTML 表格

Question

我在 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保持标记和 Percentage batch_no 中的 8 个大于 25% 将其标记为深红色并带有粗体白色字体。

如果可能的话，我们可以在 S3中添加后缀吗？如 S3 (In Progress)和 9 as `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)

Answer 1

我不确定我是否正确理解了您的所有需求，但这里是使用包 flextable 做出的答案.

library(officer)
library(flextable)
library(magrittr)
dat <- tibble::tribble(
    ~seq, ~count1, ~percentage1,  ~Marking, ~count2, ~percentage2, ~batch_no, ~count3, ~percentage3,
    "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", "45.00%",
    "DEF", 1, "12.50%", "Hold", "2", "45.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_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
    "NA",  1, "12.50%", NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
    "(Blank)", 0, "0.00%", NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, NA_character_,
    "Total", 8, "112.50%", NA_character_, "8", "100.00%", NA_character_, "8", "100.00%"
  )
dat$percentage1 <- gsub("%", "", dat$percentage1) %>% as.double()
dat$percentage2 <- gsub("%", "", dat$percentage2) %>% as.double()
dat$percentage3 <- gsub("%", "", dat$percentage3) %>% as.double()


# I need to add table header color as light green 
# with bold font and last row of the table as orange 
# with bold font.
flextable(dat) %>% 
  fontsize(size = 11, part = "all") %>% 
  bold(part = "header") %>% 
  color(color = "#90EE90", part = "header") %>% 
  color(color = "orange", i = ~ seq %in% "Total") %>% 
  bold(i = ~ seq %in% "Total") %>% 
#' Also, Need to add the condition that if Percentage of Hold 
#' in marking and Percentage of 8 in batch_no is >25% mark it 
#' as a dark red with bold white font.
  color(i = ~ percentage1 > 10 & Marking %in% "Hold", 
        j = c("count1", "percentage1", "Marking"),
        color = "red", part = "body") %>% 
  color(i = ~ percentage2 > 10 & batch_no %in% "8", 
        j = c("count2", "percentage2", "batch_no"),
        color = "red", part = "body") %>% 
  bold(i = ~ percentage1 > 10 & Marking %in% "Hold", 
       j = c("count1", "percentage1", "Marking"),) %>% 
  bold(i = ~ percentage2 > 10 & batch_no %in% "8",
       j = c("count2", "percentage2", "batch_no")) %>% 

#' If possible, can we add the suffix in S3 as S3 (In Progress) 
#' and 9 as `9 (In Progress) where the font of (In Progress) will 
#' be 2 font less than variable name.
#' The added text (In Progress) should be in orange font with bold.
  compose(i = ~ Marking %in% "S3", j = "Marking", 
          value = as_paragraph(
            "S3 ", 
            as_chunk("(In Progress)", 
                     props = fp_text(color = "orange", bold = TRUE, font.size = 5.5))
            )
  ) %>% 
  autofit()