使用 gt 包创建一个函数来显示 R 中已批准和未批准客户的勾选和交叉？

Question

我是 R 的新手，已经创建了一些 Classification models。通过使用那些，我需要根据 Class 列显示已批准和已拒绝客户的勾选和交叉。

我从某处获取了一段代码，有助于为每个代码创建星级，它使用 gt 包

数据帧

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

使用 gt & fontawesome 包创建星级的参考代码（有效）

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

创建函数

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()
}

在数据帧上应用函数

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__")
  )

这创造了一个很好的 html table:

问题：

在上面 html table 而不是星级我试图获得 tick/cross 基于 yes/no 来自 class 列但无法执行.这是我试过的：

# 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

有一些愚蠢的错误，下面的代码有效：

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__")
  )

使用 gt 包创建一个函数来显示 R 中已批准和未批准客户的勾选和交叉？

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

r

machine-learning

r-caret

gt