0

我是 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)
  1. 创建函数
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()
}
  1. 在数据框上应用函数
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 表：

在此处输入图像描述

问题：

在上面的html 表中，而不是Star Ratings，我试图根据类列中的是/否来获取勾选/交叉，但无法做到这一点。这是我尝试过的：

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

1 回答 1

0

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

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__")
  )
于 2020-11-27T09:14:45.617 回答