R Markdown - PDF 表,具有行最大条件粗体格式和百分比格式

发布于 2025-01-14 05:37:27 字数 2501 浏览 3 评论 0原文

这个问题与我过去的问题类似: 有条件地格式化包含数据中行最大值的每个单元格框架 - R Markdown PDF 不同之处在于,在过去的问题中,我的示例是打印一个包含数字的表格,而这次它在技术上是字符(具有百分比格式的数字)

数据例如:

    ---
    title: "Untitled"
    output: pdf_document
    ---
    
    ```{r setup, include=FALSE}
    knitr::opts_chunk$set(echo = TRUE)
    ```

    ```{r, include=FALSE}
        segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3', 'Tot')
        subSegment<- c('subseg1.1', 'subseg1.2', 'subseg2.1', 'subseg2.2', 'subseg3.1', 'subseg3.2', "-")
        co.1<- c(0.1, 0.4, 0.3, 0.2, 0.5, 0.4, 0.4)
        co.2<- c(0.5, 0.3, 0.3, 0.2, 0.1, 0.5, 0.4)
        co.3<- c(0.2, 0.1, 0.4, 0.4, 0.1, 0.1, 0.15)
        co.4<- c(0.2, 0.2, 0.0, 0.2, 0.3, 0.0, 0.05)
        total<- c(1,1,1,1,1,1,1)
        
        df<-data.frame(segment, subSegment, co.1, co.2, co.3, co.4, total) %>% 
          rowwise() %>% 
          mutate(across(co.1:co.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(co.1:co.4)), TRUE,  FALSE))))

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)

    ```

所以在这样做之后,我得到了一个非常好的表格: 表格无%

我的问题是我希望将数字打印为百分比。我尝试在条件格式化之前和之后使用scale::percent,但它们都不起作用。 如果我尝试在粗体后给出百分比格式,则会收到错误:

UseMethod("round_any") 中的错误: 没有适用于“round_any”的方法应用于“character”类的对象。

如果我尝试在条件粗体之前使用它,那么我找不到每行的最大值,因为它们是字符而不是数字。

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

我应该补充一点,这只是一个示例,但实际数字类似于 0.5471927,因此打印“54.7%”而不是完整数字非常重要。

我使用的库:

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

This question is similar to my past question: Conditionally format each cell containing the max value of a row in a data frame - R Markdown PDF
The difference is in the past question my example was printing a table with numbers and this time it's technically characters (numbers with percentage format)

Data for example:

    ---
    title: "Untitled"
    output: pdf_document
    ---
    
    ```{r setup, include=FALSE}
    knitr::opts_chunk$set(echo = TRUE)
    ```

    ```{r, include=FALSE}
        segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3', 'Tot')
        subSegment<- c('subseg1.1', 'subseg1.2', 'subseg2.1', 'subseg2.2', 'subseg3.1', 'subseg3.2', "-")
        co.1<- c(0.1, 0.4, 0.3, 0.2, 0.5, 0.4, 0.4)
        co.2<- c(0.5, 0.3, 0.3, 0.2, 0.1, 0.5, 0.4)
        co.3<- c(0.2, 0.1, 0.4, 0.4, 0.1, 0.1, 0.15)
        co.4<- c(0.2, 0.2, 0.0, 0.2, 0.3, 0.0, 0.05)
        total<- c(1,1,1,1,1,1,1)
        
        df<-data.frame(segment, subSegment, co.1, co.2, co.3, co.4, total) %>% 
          rowwise() %>% 
          mutate(across(co.1:co.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(co.1:co.4)), TRUE,  FALSE))))

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)

    ```

so after doing this I get a very nice table:
table without %

My problem is that I want the numbers to be printed as percentages. I tried using the scales::percent both before and after the conditional formating but none of them work.
If I try to give the percentage format after the bold I get the error:

Error in UseMethod("round_any") :
no applicable method for 'round_any' applied to an object of class "character".

If I try to use it before the conditional bold then I can't find the maximum of each row since they are characters and not numbers.

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

I should add that this is just an example but actual numbers are stuff like 0.5471927 so it's really important to print "54.7%" instead of the full number.

libraries I used:

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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

唔猫 2025-01-21 05:37:27

使用 cell_spec 参数将百分比值转换为字符。通过一些 stringr 和正则表达式,可以将十进制值转换为百分比。注意 % 是 LaTeX 中的保留符号,因此需要转义。

---
output:
  pdf_document
---

```{r setup, include=FALSE}

knitr::opts_chunk$set(echo = FALSE)

require("pacman")
p_load(dplyr, tidyr, stringr, kableExtra, forcats, tinytex, scales, janitor)


```{r df, include=FALSE}


        segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3', 'Tot')
        subSegment<- c('subseg1.1', 'subseg1.2', 'subseg2.1', 'subseg2.2', 'subseg3.1', 'subseg3.2', "-")
        co.1<- c(0.1, 0.4, 0.3, 0.2, 0.5, 0.4, 0.4)
        co.2<- c(0.5, 0.3, 0.3, 0.2, 0.1, 0.5, 0.4)
        co.3<- c(0.2, 0.1, 0.4, 0.4, 0.1, 0.1, 0.15)
        co.4<- c(0.2, 0.2, 0.0, 0.2, 0.3, 0.0, 0.05)
        total<- c(1,1,1,1,1,1,1)
        
        df <-
          data.frame(segment, subSegment, co.1, co.2, co.3, co.4, total) %>% 
          rowwise() %>% 
          mutate(across(co.1:co.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(co.1:co.4)), TRUE,  FALSE)))) %>% 
          ungroup() %>% 
          pivot_longer(starts_with("co."))%>% 
          mutate(pc = percent(as.numeric(str_extract(value, "0.\\d+|0")), accuracy = 0.1),
                 value = str_replace(value, "0.\\d+|0", pc),
                 value = str_replace(value, "%", "\\\\%")) %>%
          select(-pc) %>% 
          pivot_wider() %>% 
          select(-total, everything(), total)
        
```    


```{r kable, 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)

```

输入图片此处描述

The percentage values are converted into character with the cell_spec argument. with a bit of stringr and regex the decimal values can be converted to percentages. Note % is a reserved symbol in LaTeX so needs escaping.

---
output:
  pdf_document
---

```{r setup, include=FALSE}

knitr::opts_chunk$set(echo = FALSE)

require("pacman")
p_load(dplyr, tidyr, stringr, kableExtra, forcats, tinytex, scales, janitor)


```{r df, include=FALSE}


        segment<- c('seg1', 'seg1', 'seg2', 'seg2', 'seg3', 'seg3', 'Tot')
        subSegment<- c('subseg1.1', 'subseg1.2', 'subseg2.1', 'subseg2.2', 'subseg3.1', 'subseg3.2', "-")
        co.1<- c(0.1, 0.4, 0.3, 0.2, 0.5, 0.4, 0.4)
        co.2<- c(0.5, 0.3, 0.3, 0.2, 0.1, 0.5, 0.4)
        co.3<- c(0.2, 0.1, 0.4, 0.4, 0.1, 0.1, 0.15)
        co.4<- c(0.2, 0.2, 0.0, 0.2, 0.3, 0.0, 0.05)
        total<- c(1,1,1,1,1,1,1)
        
        df <-
          data.frame(segment, subSegment, co.1, co.2, co.3, co.4, total) %>% 
          rowwise() %>% 
          mutate(across(co.1:co.4,  ~cell_spec(.x, 'latex', bold = ifelse(.x == max(c_across(co.1:co.4)), TRUE,  FALSE)))) %>% 
          ungroup() %>% 
          pivot_longer(starts_with("co."))%>% 
          mutate(pc = percent(as.numeric(str_extract(value, "0.\\d+|0")), accuracy = 0.1),
                 value = str_replace(value, "0.\\d+|0", pc),
                 value = str_replace(value, "%", "\\\\%")) %>%
          select(-pc) %>% 
          pivot_wider() %>% 
          select(-total, everything(), total)
        
```    


```{r kable, 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)

```

enter image description here

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文