R/prepare_report.R

In Blockhead-yj/report.iqz: Make Potential Predction Report of IQUIZOO

#' @title Summary all analysis and generate essential parts for final model report
#'
#' @description After former pipeline, there are a lost of results, this function
#' is used to tidy and summary the results for final model report.
#'
#' @param data_wider Data.frame, with each row represent all observation of a person
#' and his/her missing_rate, prediction. ie. the output of function wt_sum_predict
#' @param model A lm object, with additional rw part, generated by select_by_RW.
#' @param abilities Data.frame, including two column, the game_name and the represent
#' ability of it.
#' @param class_NL Data.frame, class name list, has a column indicate the name and
#' a corresponding column indicate it's class. user_name and class
#' @param background Data.frame or NULL, if the background is specified, it will be
#' used in function [plot_pred()] to visualize the judgment standard. It should have
#' x, y and judgment as columns.
#' @param plot_x,plot_y String, the x axis and y axis variables used in function [plot_pred()]
#'
#' @return A list, contains following values:
#'   \item{report_rw}{The tasks in model and its corresponding ability and relative weight}
#'   \item{n_task}{The number of tasks in model}
#'   \item{r2,adj_r2}{Model interpretation rate}
#'   \item{summary_pred}{The judgment and it's description and people proportion}
#'   \item{detail_pred}{The details of prediction and judgment, for every person}
#'   \item{namelist_pred}{The prediction and judgment name list for every class}
#'   \item{namelist_drop}{The name list of people those who are not involved prediction}
#'   \item{background}{The background used in [plot_pred()]}
#'   \item{plot_x,plot_y}{The x axis and y axis variables used in function [plot_pred()]}
#'
#' @export

prepare_report <- function(data_wider, model, abilities, class_NL, background = NULL, plot_x = "Z_acd_score", plot_y = "wt_sum_predict"){
  stopifnot("class_NL should have least two columns: 'class' and 'user_name'!"=
              all(c("user_name", "class") %in% colnames(class_NL)))
  out <- list()
  # model tasks report
  out$report_rw <- RPT_model_tasks(model, abilities)
  out$n_tasks <- nrow(out$report_rw)
  # model interpretation rate
  out$r2 <- summary(model)$r.squared
  out$adj_r2 <- summary(model)$adj.r.squared
  # summary prediction and potential judgment
  out$summary_pred <- data_wider %>%
    filter(missing_prop <= 30) %>%
    group_by(judgment) %>%
    summarise(人数 = n(), .groups = "drop") %>%
    mutate(比例 = scales::percent(人数/sum(人数), 0.1)) %>%
    left_join(judgment_description, by = "judgment") %>%
    rename(潜力评价等级 = judgment, 评价等级描述 = description)
  # prediction and potential judgment details
  model_vars <-  model$terms %>% attr("variables") %>% all.vars()
  out$detail_pred <- data_wider %>%
    filter(missing_prop <= 30) %>%
    select(all_of(c("user_name", model_vars, "mod_predict", "wt_sum_predict", "judgment")))
  # potential judgment class name list
  out$namelist_pred <- make_NL_by_class(class_NL = class_NL, user_NL = out$detail_pred)
  # name list that we didn't make prediction, on which users had too many predictors missing
  out$namelist_drop <- data_wider %>%
    filter(missing_prop > 30) %>%
    pull("user_name") %>%
    make_NL_by_class(class_NL = class_NL, user_NL = .)
  out$background <- background
  out$plot_x <- plot_x
  out$plot_y <- plot_y
  out
}