Create a function using gt package to display tick & cross against approved & non approved customers in R?

Question

I am new in R & have created some Classification models. By using those I need to display tick & cross against approved and rejected customers based Class column.

I picked up a piece of code from somewhere that helps in creating star Ratings against each and it uses gt package

dataframe

df_test <- cbind(prob = predict(model_ranger_py, newdata = test, type = "prob")[,"yes"], 
                        Class = y_test) %>% 
            rename(Class = y)


df_test 

############ output #############

       prob    Class
      <dbl>    <fctr>

3   0.4906592   no      
6   0.6123333   no      
12  0.3746750   no      
14  0.4906592   no      
22  0.7820000   yes     
24  0.5333956   no      
29  0.5281762   no      
45  0.7413333   no      
46  0.7413333   no      
50  0.5333956   no
53  0.5333956   no      
54  0.7560000   yes     
57  0.4906592   no      
59  0.5281762   no      
62  0.7413333   no      
64  0.6626619   no      
68  0.4906592   no      
74  0.7413333   no      
75  0.5333956   yes     
76  0.5333956   no

Reference code to create star ratings by using gt & fontawesome packages (this works)

library(tidyverse)
library(gt)
library(htmltools)
library(fontawesome)

1. Creating function

rating_stars5 <- function(rating, max_rating = 5){
  rounded_rating <- floor(rating + 0.5)
  stars <- lapply(seq_len(max_rating), function(i){
    if(i <= rounded_rating){
      fontawesome::fa("star", fill = "orange")
    } else{
      fontawesome::fa("star", fill = "grey")
    }
  })
  label <- sprintf("%s out of %s", rating, max_rating)
  # label <- glue("{rating} out of {max_rating}")
  div_out <- div(title = label, "aria-label" = label, role = "img", stars)
  
  as.character(div_out) %>% 
    gt::html()
}

2. Applying function on dataframe

df_test %>% 

  # creating customerid based on row index
  mutate(customerid = row.names(.)) %>% 
  
  # converting to 5 bins to match 5 stars
  mutate(rating = cut_number(prob, n =5) %>% as.numeric()) %>%
  mutate(rating = map(rating, rating_stars5)) %>% 
  arrange(customerid) %>% 
    
  # to limit the number of rows in rmarkdown rendered doc
  head(n = 15) %>% 
  
  gt() %>% 
  tab_header(title = gt::md("__BankMarketing Term Plan Customer Response Likelyhood__")) %>% 
  tab_spanner(
    label = gt::html("<small>High Stars = higher chances</small>"),
    columns = vars(customerid, prob, Class)
  ) %>% 
  
  # table styling to reduce text size
  tab_style(
    style = cell_text(size = px(12)),
    locations = cells_body(
      columns = vars(customerid, prob, Class)
    )
  ) %>% 
  cols_label(
    customerid = gt::md("__CUSTOMER__")
  ) 
  

This creates a nice html table:

Issue:

In above html table instead of Star Ratings I am trying to get tick/cross based on yes/no from class column but unable to do it. This is what I have tried:

# 1. creating function

rating_yes_no <- function(Class){
  
  check_cross <- lapply(Class, function(i){
    if(i == "yes"){
      fontawesome::fa("check", fill = "green")
    } else{
      fontawesome::fa("times", fill = "red")
    }
  })
  label <- sprintf("%s", check_cross)
  # label <- glue("{check_cross} ")
  div_out <- div(title = label, "aria-label" = label, role = "img", check_cross)
  
  as.character(div_out) %>% 
    gt::html()
}

# 2. Applying function

df_test %>% 
  mutate(customerid = row.names(.)) %>% 
  
  mutate(class_rating = map(class_rating, rating_yes_no)) %>% 
  arrange(customerid) %>% 
    
  # to limit the number of rows in rmarkdown rendered doc
  head(n = 15) %>% 
  
  gt() %>% 
  tab_header(title = gt::md("__BankMarketing Term Plan Customer Response Likelyhood__")) %>% 
  tab_spanner(
    label = gt::html("<small>High Stars = higher chances</small>"),
    columns = vars(customerid, prob, Class)
  ) %>% 
  
  # table styling to reduce text size
  tab_style(
    style = cell_text(size = px(12)),
    locations = cells_body(
      columns = vars(customerid, prob, Class)
    )
  ) %>% 
  cols_label(
    customerid = gt::md("__CUSTOMER__")
  ) 

Answer 1

Had some silly mistakes, below code worked:

rating_yes_no <- function(Class){
  
  check_cross <- lapply(Class, function(i){
    if(i == "yes"){
      fontawesome::fa("check", fill = "green")
    } else{
      fontawesome::fa("times", fill = "red")
    }
  })
  label <- sprintf("%s", Class)
  # label <- glue("{rating} out of {max_rating}")
  div_out <- div(title = label, "aria-label" = label, role = "img", check_cross)
  
  as.character(div_out) %>% 
    gt::html()
}

df_test %>% 
  mutate(customerid = row.names(.)) %>% 
  
  mutate(class_rating = map(Class, rating_yes_no)) %>% 
  arrange(customerid) %>% 
    
  # to limit the number of rows in rmarkdown rendered doc
  head(n = 15) %>% 
  
  gt() %>% 
  tab_header(title = gt::md("__BankMarketing Term Plan Customer Response Likelyhood__")) %>% 
  tab_spanner(
    label = gt::html("<small>High Stars = higher chances</small>"),
    columns = vars(customerid, prob, Class)
  ) %>% 
  
  # table styling to reduce text size
  tab_style(
    style = cell_text(size = px(12)),
    locations = cells_body(
      columns = vars(customerid, prob, Class)
    )
  ) %>% 
  cols_label(
    customerid = gt::md("__CUSTOMER__")
  )