Compare current value in a subset to a percentile rank from the full set

154 views Asked by At

I've calculated the 90th percentile values (column wise) for a dataset. After filtering the data to get a subset, I need to pass the percentile values to be evaluated against the current values. I've included my full code below as well as a little explanation of what I am attempting to do in case I'm going about it wrong.

I have created a custom function for a formattable in R that combines the color_tile with icontext to place a star next to values that are above a certain threshold. The color_tiles are based on the subset data, while the star should be evaluated against the 90th percentile values.

library(tidyverse)
library(formattable)
set.seed(123)
df <- tibble( group = sample(letters[1:3],100, replace=TRUE),
               val1 = sample((1:100),100,replace=TRUE),
               val2 = sample((1000:10000),100,replace=TRUE),
               val3 = runif(100))

# calculate 90th percentile for each column from the full dataset
quant <- df %>% 
  summarise(across(where(is.numeric), ~quantile(.x,.90)))
  
# create a function to combine color_tile and icontext star 
# [!] how do you change the x > 8938 to reference the appropriate quant value? [!]

star_formatter <- function(x,c1="white",c2="white"){
  formatter("span",
            style = x ~ style(display = "block", 
                              padding = "0 4px", `border-radius` = "4px",
                              font.weight = "bold",
                              `background-color` = csscolor(gradient(as.numeric(x),c1,c2))),
            x ~ icontext(ifelse(x > 8938, "star", ""), x) # <---- THIS !!!!!
  )
}

# create subgroup and formattable
df %>% filter(group == "a") %>% 
  formattable(list(val1 = star_formatter(c1="white",c2="orange"), # star needs to be scaled for these values 
                   val2 = star_formatter(c1="white",c2="pink"), # star works as an example
                   val3 = star_formatter(c1="white",c2="lightblue") # star needs to be scaled for these values
            )
)
1

There are 1 answers

3
seansteele On BEST ANSWER

Modified the custom function to take a variable, from which I can pass the appropriate quant value such as quant$val1

star_formatter <- function(x,star_thresh="",c1="white",c2="white"){
  formatter("span",
            style = x ~ style(display = "block", 
                              padding = "0 4px", `border-radius` = "4px",
                              font.weight = "bold",
                              `background-color` = csscolor(gradient(as.numeric(x),c1,c2))),
            x ~ icontext(ifelse(x > star_thresh, "star", ""), x)
  )
}

# create subgroup and formattable
df %>% filter(group == "a") %>% 
  formattable(list(val1 = star_formatter(star_thresh = quant$val1,c1="white",c2="orange"), 
                   val2 = star_formatter(star_thresh = quant$val2,c1="white",c2="pink"), 
                   val3 = star_formatter(star_thresh = quant$val3,c1="white",c2="lightblue")
            )
)

star_formatter