我在R中是新手，已经创建了一些分类模型。我需要使用这些模型根据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 no53 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 %>% # 根据行索引创建客户ID mutate(customerid = row.names(.)) %>% # 转换为5个区间以匹配5星 mutate(rating = cut_number(prob, n =5) %>% as.numeric()) %>% mutate(rating = map(rating, rating_stars5)) %>% arrange(customerid) %>% # 限制rmarkdown渲染文档中的行数 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) ) %>% # 调整表格样式以减小文本大小 tab_style( style = cell_text(size = px(12)), locations = cells_body( columns = vars(customerid, prob, Class) ) ) %>% cols_label( customerid = gt::md("__CUSTOMER__") ) 这会生成一个漂亮的HTML表格:
问题:
在上面的HTML表格中，我试图根据class列的yes/no来显示勾选/叉号，而不是星级评级，但没能成功。这是我尝试过的:
# 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", 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. 应用函数df_test %>% mutate(customerid = row.names(.)) %>% mutate(class_rating = map(class_rating, rating_yes_no)) %>% arrange(customerid) %>% # 限制rmarkdown渲染文档中的行数 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) ) %>% # 调整表格样式以减小文本大小 tab_style( style = cell_text(size = px(12)), locations = cells_body( columns = vars(customerid, prob, Class) ) ) %>% cols_label( customerid = gt::md("__CUSTOMER__") ) 回答：
犯了一些愚蠢的错误，以下代码有效:
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) %>% # 限制rmarkdown渲染文档中的行数 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) ) %>% # 调整表格样式以减小文本大小 tab_style( style = cell_text(size = px(12)), locations = cells_body( columns = vars(customerid, prob, Class) ) ) %>% cols_label( customerid = gt::md("__CUSTOMER__") ) 