有条件地格式化包含数据框中一行最大值的每个单元格 - R Markdown PDF

Conditionally format each cell containing the max value of a row in a data frame - R Markdown PDF

我正在使用 R Markdown 创建一个包含几个表格的 PDF 文档。

这里是示例必要的数据

output:
  pdf_document:
  toc: yes

require("pacman")
p_load(tidyverse, reshape, reshape2, knitr, kableExtra, tinytex, scales, pander, janitor, gridExtra)

segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3')
subSegment<- c('subseg1', 'subseg2', 'subseg1', 'subseg2', 'subseg1', 'subseg2')
var.1<- c(100, 20, 30, 50, 40, 40)
var.2<- c(200, 30, 30, 70, 30, 140)
var.3<- c(50, 50, 40, 20, 30, 40)
var.4<- c(60, 50, 35, 53, 42, 20)
df<- data.frame(segment, subSegment, var.1, var.2, var.3, var.4)
df%>%adorn_totals('row')

df.2<-df
df.2[c(3:ncol(df.2))] = sapply(df.2[c(3:ncol(df.2))], function(x) scales::percent(x, accuracy = 0.1))

df.2 %>%
  kable(format = "latex", booktabs = TRUE, caption = "Title" ,align = "c") %>%
  kable_styling(latex_options = c("HOLD_position", "repeat_header", "scale_down"), font_size = 6) %>%
  group_rows(index = table(fct_inorder(df$`segment`)), italic = F, bold = F, underline = T, latex_gap_space = "1em", background = "#f2f2f2")%>%
  column_spec(1, monospace = T, color = "white") %>%
  row_spec(nrow(df), bold = T)

我知道如何使用 column_spec 有条件地更改列的格式,例如:

column_spec(ncol(df), color = ifelse(df$var.4 > 50, "green","red"))

我想将格式 'bold = T' 赋予每行中具有最大值的单元格...

有简单的方法吗?这只是一个例子,但我的真实 df 有数百行和超过 20 列,所以手动操作真的不是一个选项......我发现了一些类似的问题,但主要解决这个问题 HTML 编织。

我试过类似的东西:

 df[3:ncol(df)] <- lapply(df[3:ncol(df)], function(x) {
     cell_spec(x,  font_size = spec_font_size(x))
    })

但这并没有奏效,即使它奏效了,结果也不是我真正想要的,因为它们改变了大小而不是最大粗体。

简短描述:突出显示数据框中每行的最大值 编辑:编辑添加数字具有特殊格式

使用 dplyr::mutate(跨...和 ​​max(c_across... 是一种方法:

---
output:
  pdf_document:
  toc: yes
---

```{r, include=FALSE}

require("pacman")
p_load(dplyr, forcats, knitr, kableExtra, tinytex, janitor)

segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3')
subSegment<- c('subseg1', 'subseg2', 'subseg1', 'subseg2', 'subseg1', 'subseg2')
var.1<- c(100, 20, 30, 50, 40, 40)
var.2<- c(200, 30, 30, 70, 30, 140)
var.3<- c(50, 50, 40, 20, 30, 40)
var.4<- c(60, 50, 35, 53, 42, 20)

df <- 
  data.frame(segment, subSegment, var.1, var.2, var.3, var.4) %>% 
  adorn_totals('row') %>% 
  rowwise() %>% 
  mutate(across(var.1:var.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(var.1:var.4)), TRUE,  FALSE))))
  
```

```{r, results='asis'}


df %>%
  kable(booktabs = TRUE,
        caption = "Title",
        align = "c",
        escape = FALSE) %>%
  kable_styling(latex_options = c("HOLD_position", "repeat_header", "scale_down"),
                font_size = 6) %>%
  pack_rows(index = table(fct_inorder(df$segment)),
             italic = FALSE,
             bold = FALSE,
             underline = TRUE,
             latex_gap_space = "1em",
             background = "#f2f2f2")%>%
  column_spec(1, monospace = TRUE, color = "white") %>%
  row_spec(nrow(df), bold = TRUE)

```

导致此 pdf 输出: