Search code examples
rgt

gt data_color some columns based on anothers


I am trying to colorfill some columns based on the comparison of the value and threshold columns.

The desired result is:

desired

There's my try: But do not get the desired result (colors are not the same by row).

library(gt)
library(tidyverse)

df <- data.frame(
  name = c("Joe", "Martin", "Bobby", "Fischer"),  
  performance = c(3, 2000, 5, 1500),
  value = c(0.5, 0.5, 1, 1),
  threshold = c(0.25, 0.75, 0.1, 4)
)

pal <- function(...) {
  args <- list(...)
  x <- args[[1]]
  thresholds <- args[[2]]
  zeros <- numeric(length(x))
  
  #sigma for normalizacion. 
  # maybe uniform sigma <- (pmax - pmin)/sqrt(12)
  sigma <- 0.2
  
  y <- 1/(1+exp(-(x - thresholds)/sigma))
  
  f <- scales::col_numeric(
    palette = c(
      '#e02514', '#e02514', '#ffffff', '#ffffff', '#4fd435', '#4fd435'
    ),
    domain = c(0, 0.1, 0.48, 0.52, 0.9, 1),
    na.color = NA
  )
  f(y)
}

gt(df) %>% 
  data_color(
    columns = c(name, performance),
    colors = pal(value, threshold),
    apply_to = "fill"
  )  

The color are not the same by row.

plot


Solution

  • There's a partial solution

    library(gt)
    library(tidyverse)
    
    logistic_pattern <- function(...) {
      args <- list(...)
      x <- args[[1]]
      thresholds <- args[[2]]
      zeros <- numeric(length(x))
      
      #sigma for normalizacion. 
      # maybe uniform sigma <- (pmax - pmin)/sqrt(12)
      sigma <- 0.2
      
      y <- 1/(1+exp(-(x - thresholds)/sigma))
      
      y
      
    }
    gt(df) %>% 
      tab_style(
        style = cell_fill(color = "gray85"),
        locations = cells_body(
          columns = c(name, performance),
          rows = between(logistic_pattern(value, threshold), 0.45, 0.55)
        )
      ) %>% 
      tab_style(
        style = cell_fill(
          # color = scales::col_bin(.$threshold, domain = colfunc(10))
          color = "red"
        ),
        locations = cells_body(
          columns = c(name, performance),
          rows = logistic_pattern(value, threshold) < 0.45
        )
      ) %>% 
      tab_style(
        style = cell_fill(
          color = "green"
        ),
        locations = cells_body(
          columns = c(name, performance),
          rows = logistic_pattern(value, threshold) > 0.55
        )
      ) 
    

    plot

    I cannot apply a color ranging.