gt table 红绿灯系统的条件格式

Question

这是我当前的数据集：

 A tibble: 9 x 6
  Analyte                 Units        Category            Value  ADWG      AGWR
  <fct>                   <fct>        <fct>               <dbl> <dbl>     <dbl>
1 1,2,3,4,6,7,8-HpCDD     pg/Kg        Dioxins             0.1      NA  0.016   
2 Bromoacetic Acid        ug/L         DBP                 0.5      NA  0.35    
3 E.coli                  Orgs / 100mL Microbiological  1600         1 NA       
4 Estriol                 ug/L         Pharmaceutical      0.125    NA  0.05    
5 Estrone                 ug/L         Pharmaceutical      0.125    NA  0.03    
6 Mestranol               ug/L         Pharmaceutical      0.125    NA  0.0025  
7 N-Nitrosomorphline      ng/L         organic compound    5        NA  1       
8 Octachlorodibenzodioxin pg/Kg        Dioxins             0.5      NA  0.016   
9 PCB-105                 ug/L         Pesticide           0.005    NA  0.000016

我想创建一个 gt() table，其中根据 close/far 它们与准则值的差距来格式化准则超出部分。

类似于：

<=指南的 10% - 绿色
指导值 >10 且 <50% - 黄色
值 >50 且 <100% 准则 - 橙色
值 >= 准则 - 红色

目前我的代码如下：

gt(final) %>%
  tab_options(
    heading.title.font.size = "medium",
    heading.subtitle.font.size = "small",
    table.font.size = "small",
    table.font.names = "Arial") %>%
  cols_align(align = "left", columns = everything()) %>%
  cols_label(Value = 'Result') %>%
  tab_spanner(label = "Results",columns = c(Analyte, Units, Category, Value)) %>%
  tab_spanner(label = "Guidelines", columns = c(ADWG, AGWR)) %>%
  fmt_missing(columns = everything(), missing_text = "-") %>%
  fmt_number(columns = where(is.numeric), n_sigfig = 2) %>%
  tab_style(style = list(
    cell_fill(color = "#F8766D"),
    cell_text(weight = "bold")),
    locations = cells_body(columns = Value, rows = Value >= AGWR | Value >= ADWG))

和 table 目前看起来像这样，因为我只弄清楚了如何根据一个条件（即 below/above 准则）进行格式化。我目前的数据都超出了指导方针，但我想将其应用于更大的数据集。

如有任何帮助，我们将不胜感激。谢谢

Answer 1

你可以试试这个。

library(tidyverse)
library(gt)

tibble(
  Result = runif(50, min = 0, max = 1.2)
  ) %>%
  gt() %>%
  tab_style(
    style = list(
      cell_fill(color = "green")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result <= 0.1
    )
  ) %>%
    tab_style(
      style = list(
        cell_fill(color = "yellow")
      ),
      locations = cells_body(
        columns = Result,
        rows = Result > 0.1 & Result <= 0.5
      )
    ) %>%
  tab_style(
    style = list(
      cell_fill(color = "orange")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result > 0.5 & Result <= 1
    )
  ) %>%
  tab_style(
    style = list(
      cell_fill(color = "red")
    ),
    locations = cells_body(
      columns = Result,
      rows = Result > 1
    )
  )

您还可以定义一个辅助函数来避免一些代码复制粘贴。

library(tidyverse)
library(gt)

fce_col <- function(gt_obj, filtering_numbers, color){
  gt_obj %>%
    tab_style(
      style = list(
        cell_fill(color = color)
      ),
      locations = cells_body(
        columns = Result,
        rows = Result > filtering_numbers[1] & Result <= filtering_numbers[2]
      )
    ) 
}

tibble(
  Result = runif(50, min = 0, max = 1.2)
) %>%
  gt() %>%
  fce_col(c(0, 0.1), "green") %>%
  fce_col(c(0.1, 0.5), "yellow") %>%
  fce_col(c(0.5, 1), "orange") %>%
  fce_col(c(1, 1.2), "red")

gt table 红绿灯系统的条件格式

conditional formatting of gt table traffic light system

r

gt