CRAN v0.4.0 submission, removed basis_type

Author: nspyrison

CRAN-SUBMISSION

@@ -1,3 +1,4 @@
-Version: 0.3.0
-Date: 2023-05-07 19:09:58 UTC
-SHA: 05fe2cc809e6039689541ac5c49bc0d9e164cb1e
+Version: 0.4.0.0
+Date: 2023-11-08 19:12:12 UTC
+SHA:
+   ed16fe0592acf196ce64bd22eb8b35b47ec3db1f

NEWS.md

@@ -6,6 +6,7 @@
 - Shiny app text, plot dimensions, and text cleaned up.
 - Classification tour now uses a horizontal layout.
 - Cleaned up the text on the facet panels for `global_tour()` and `radial_cheem_tour()`.
+- Removed support for the `basis_type` argument. support for alternative bases types is really an extension of the analysis.
 - Recreate the saved classification model, they fit too well to work as illustrations.
 - Set seed more consistently. All model and attribution shifted a bit, but will be more replicable going forward.
 - Minor documentation and code clean up and clarifications.

R/1_cheem_lists.r

@@ -63,9 +63,6 @@ model_performance <- function(
 #' Produces the plot data.frame of 1 layer. consumed downstream in cheem_ls.
 #' 
 #' @param x The explanatory variables of the model.
-#' @param basis_type The type of basis used to approximate the data and 
-#' attribution space from. Defaults to "pca". 
-#' Expects "pca" or "olda" (requires `class`).
 #' @param class Optional, (n, 1) vector, a variable to group points by. 
 #' This can be the same as or different from `y`, the target variable.
 #' @param label Optionally provide a character label to store reminder 
@@ -83,27 +80,21 @@ model_performance <- function(
 # #' cheem:::global_view_df_1layer(X)
 global_view_df_1layer <- function(
   x,
-  class      = NULL, ## required for olda
-  basis_type = c("pca", "olda"),
-  label      = "label"
+  class = NULL,
+  label = "label"
 ){
   d <- 2 ## Fixed display dimensionality
-  basis_type <- match.arg(basis_type)
   if(is.null(class)) class <- as.factor(FALSE)
 
   ## Projection
   x_std <- spinifex::scale_01(x)
-  if(basis_type == "olda" & is.null(class))
-    stop("global_view_df_1layer: Basis type was olda without a class, a class must be provided for olda.")
-  basis <- switch(basis_type,
-                  pca  = stats::prcomp(x_std)$rotation[, 1:d],
-                  olda = spinifex::basis_olda(x_std, class, d))
+  basis <- stats::prcomp(x_std)$rotation[, 1:d]
   proj  <- spinifex::scale_01(x_std %*% basis)
 
   ## Column bind wider
-  ret <- data.frame(basis_type, label, 1:nrow(x), class, proj)
-  colnames(ret) <- c("basis_type", "label", "rownum", "class", paste0("V", 1:d))
-  attr(ret, paste0(basis_type, ":", label)) <- basis
+  ret <- data.frame(label, 1:nrow(x), class, proj)
+  colnames(ret) <- c("label", "rownum", "class", paste0("V", 1:d))
+  attr(ret, label) <- basis
 
   ## Return
   ret
@@ -126,9 +117,6 @@ global_view_df_1layer <- function(
 #' @param label Optionally provide a character label to store reminder 
 #' text for the type of model and local explanation used. 
 #' Defaults to "label".
-#' @param basis_type The type of basis used to approximate the data and 
-#' attribution space from. Defaults to "pca". 
-#' Expects "pca" or "olda" (requires `class`).
 #' @param verbose Logical, if start time and run duration should be printed. 
 #' Defaults to getOption("verbose").
 #' @return A list of data.frames needed for the `shiny` application.
@@ -212,15 +200,13 @@ cheem_ls <- function(
   attr_df,
   pred = NULL,
   class = NULL,
-  basis_type = c("pca", "olda"), ## class req for olda
   label = "label",
   verbose = getOption("verbose")
 ){
   rownum <- V2 <- projection_nm <- NULL
   ## Checks
   if(verbose) tictoc::tic("cheem_ls")
   d <- 2 ## Hard coded display dimensionality
-  basis_type <- match.arg(basis_type)
   is_classification <- is_discrete(y)
   x       <- data.frame(x)
   y       <- as.numeric(y)
@@ -240,12 +226,12 @@ cheem_ls <- function(
   .pca_var <- stats::prcomp(spinifex::scale_01(x))$sdev^2
   .var_exp <- round(100*.pca_var/sum(.pca_var), 0)
   .glob_dat  <- global_view_df_1layer(
-    x, class, basis_type, 
+    x, class,
     paste0("data, PC1 (", .var_exp[1], "%) by PC2 (", .var_exp[2], "%)"))
   .pca_var <- stats::prcomp(spinifex::scale_01(attr_df))$sdev^2
   .var_exp <- round(100*.pca_var/sum(.pca_var), 0)
   .glob_attr <- global_view_df_1layer(
-    attr_df, class, basis_type, 
+    attr_df, class, 
     paste0("attribution, PC1 (", .var_exp[1], "%) by PC2 (", .var_exp[2], "%)"))
   .glob_view <- rbind(.glob_dat, .glob_attr)
   ## List of the bases
@@ -306,7 +292,7 @@ cheem_ls <- function(
     data.frame(V1 = .decode_df$prediction + .xjitter, 
                V2 = as.numeric(.decode_df$y) + .yjitter) %>%
     spinifex::scale_01()
-  .yhaty_df <- data.frame(basis_type = NA, label = .y_axis_label,
+  .yhaty_df <- data.frame(label = .y_axis_label,
                           rownum = 1:nrow(x), class = .decode_df$class, .yhaty_df)
   .glob_view <- rbind(.glob_view, .yhaty_df)
 
@@ -337,7 +323,6 @@ cheem_ls <- function(
   .glob_view$tooltip           <- rep_len(tooltip,             .N)
   .decode_df$tooltip           <- tooltip
   ## Ensure facet order is kept.
-  .glob_view$basis_type <- factor(.glob_view$basis_type, unique(.glob_view$basis_type))
   .glob_view$label      <- factor(.glob_view$label, unique(.glob_view$label))
 
   ## Cleanup and return

man/cheem_ls.Rd

@@ -1,68 +1,68 @@
-## Setup -----
-{
-  library("spinifex")
-  library("cheem")
-  library("testthat")
-  
-  ## Classification:
-  c_X <- penguins_na.rm[, 1:4]
-  c_Y <- c_clas <- penguins_na.rm$species
-  ## Regression:
-  r_X    <- amesHousing2018_NorthAmes[, 1:9]
-  r_clas <- amesHousing2018_NorthAmes$SubclassMS
-  r_Y    <- amesHousing2018_NorthAmes$SalePrice
-  
-  r_pred <- ames_rf_pred
-  c_pred <- penguin_xgb_pred
-  r_attr <- ames_rf_shap
-  c_attr <- penguin_xgb_shap
-  c_chee <- cheem_ls(c_X, c_Y, c_attr, c_pred, c_clas, "pca", "label", FALSE)
-  r_chee <- cheem_ls(r_X, r_Y, r_attr, r_pred, r_clas, "pca", "label", FALSE)
-}
-
-## basis_attr -----
-c_bas_attr <- sug_basis(c_attr, 1)
-r_bas_attr <- sug_basis(r_attr, 2)
-
-test_that("basis_attr", {
-  expect_equal(class(c_bas_attr), c("matrix", "array"))
-  expect_equal(class(r_bas_attr), c("matrix", "array"))
-})
-
-## proto_basis1d_distribution -----
-c_ggt <- ggtour(c_bas_attr, scale_sd(c_X), angle = .3) +
-  proto_basis1d_distribution(
-    attr_df = c_attr, group_by = c_clas, primary_obs = 1, comparison_obs = 2)
-r_ggt <- ggtour(r_bas_attr, scale_sd(r_X), angle = .3) +
-  proto_basis1d_distribution(
-    attr_df = r_attr, group_by = r_clas, primary_obs = 1, comparison_obs = 2)
-
-test_that("proto_basis1d_distribution", {
-  expect_equal(class(c_ggt), c("gg", "ggplot"))
-  expect_equal(class(r_ggt), c("gg", "ggplot"))
-})
-
-## global_view -----
-c_gv <- global_view(c_chee)
-r_gv <- global_view(r_chee) |> suppressWarnings()
-test_that("global_view", {
-  expect_equal(class(c_gv), c("plotly", "htmlwidget"))
-  expect_equal(class(r_gv), c("plotly", "htmlwidget"))
-})
-
-## global_view as ggplot ----
-c_gv <- global_view(c_chee, as_ggplot = TRUE)
-r_gv <- global_view(r_chee, as_ggplot = TRUE)
-test_that("global_view as_ggplot", {
-  expect_equal(class(c_gv), c("gg", "ggplot"))
-  expect_equal(class(r_gv), c("gg", "ggplot"))
-})
-
-## radial_cheem_tour -----
-c_ggt <- radial_cheem_tour(c_chee, c_bas_attr, 1, 1, 2)
-r_ggt <- radial_cheem_tour(r_chee, r_bas_attr, 1, 1, 2)
-test_that("radial_cheem_tour", {
-  expect_equal(class(c_ggt), c("gg", "ggplot"))
-  expect_equal(class(r_ggt), c("gg", "ggplot"))
-})
-
+## Setup -----
+{
+  library("spinifex")
+  library("cheem")
+  library("testthat")
+  
+  ## Classification:
+  c_X <- penguins_na.rm[, 1:4]
+  c_Y <- c_clas <- penguins_na.rm$species
+  ## Regression:
+  r_X    <- amesHousing2018_NorthAmes[, 1:9]
+  r_clas <- amesHousing2018_NorthAmes$SubclassMS
+  r_Y    <- amesHousing2018_NorthAmes$SalePrice
+  
+  r_pred <- ames_rf_pred
+  c_pred <- penguin_xgb_pred
+  r_attr <- ames_rf_shap
+  c_attr <- penguin_xgb_shap
+  c_chee <- cheem_ls(c_X, c_Y, c_attr, c_pred, c_clas, "label", FALSE)
+  r_chee <- cheem_ls(r_X, r_Y, r_attr, r_pred, r_clas, "label", FALSE)
+}
+
+## basis_attr -----
+c_bas_attr <- sug_basis(c_attr, 1)
+r_bas_attr <- sug_basis(r_attr, 2)
+
+test_that("basis_attr", {
+  expect_equal(class(c_bas_attr), c("matrix", "array"))
+  expect_equal(class(r_bas_attr), c("matrix", "array"))
+})
+
+## proto_basis1d_distribution -----
+c_ggt <- ggtour(c_bas_attr, scale_sd(c_X), angle = .3) +
+  proto_basis1d_distribution(
+    attr_df = c_attr, group_by = c_clas, primary_obs = 1, comparison_obs = 2)
+r_ggt <- ggtour(r_bas_attr, scale_sd(r_X), angle = .3) +
+  proto_basis1d_distribution(
+    attr_df = r_attr, group_by = r_clas, primary_obs = 1, comparison_obs = 2)
+
+test_that("proto_basis1d_distribution", {
+  expect_equal(class(c_ggt), c("gg", "ggplot"))
+  expect_equal(class(r_ggt), c("gg", "ggplot"))
+})
+
+## global_view -----
+c_gv <- global_view(c_chee)
+r_gv <- global_view(r_chee) |> suppressWarnings()
+test_that("global_view", {
+  expect_equal(class(c_gv), c("plotly", "htmlwidget"))
+  expect_equal(class(r_gv), c("plotly", "htmlwidget"))
+})
+
+## global_view as ggplot ----
+c_gv <- global_view(c_chee, as_ggplot = TRUE)
+r_gv <- global_view(r_chee, as_ggplot = TRUE)
+test_that("global_view as_ggplot", {
+  expect_equal(class(c_gv), c("gg", "ggplot"))
+  expect_equal(class(r_gv), c("gg", "ggplot"))
+})
+
+## radial_cheem_tour -----
+c_ggt <- radial_cheem_tour(c_chee, c_bas_attr, 1, 1, 2)
+r_ggt <- radial_cheem_tour(r_chee, r_bas_attr, 1, 1, 2)
+test_that("radial_cheem_tour", {
+  expect_equal(class(c_ggt), c("gg", "ggplot"))
+  expect_equal(class(r_ggt), c("gg", "ggplot"))
+})
+

man/global_view_df_1layer.Rd

@@ -90,7 +90,6 @@ ames_chm <- cheem_ls(X, Y,
                      class      = clas,
                      attr_df    = ames_xgb_shap,
                      pred       = ames_xgb_pred,
-                     basis_type = c("pca"),
                      label      = "Ames, xgb, shap")
 names(ames_chm)
 ```
@@ -320,7 +319,6 @@ drag_lm_shap <- as.data.frame(drag_lm_shap)
 <!-- peng_umap_chm <- cheem_ls(X, y = NULL, class = NULL, -->
 <!--                           attr_df    = peng_umap2, -->
 <!--                           pred       = NULL, -->
-<!--                           basis_type = c("pca"), -->
 <!--                           label      = "Penguin, umap2") -->
 
 <!-- global_view(peng_umap_chm, primary_obs = 115, comparison_obs = 296, -->