allowed changing correlation method in triplot and group_variables

Author: kasiapekala

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: triplot
 Title: Explaining Correlated Features in Machine Learning Models 
-Version: 1.2.0
+Version: 1.3.0
 Authors@R:
     c(person("Katarzyna", "Pekala", email = "katarzyna.pekala@gmail.com", 
     role = c("aut", "cre")), 
@@ -18,10 +18,10 @@ Depends: R (>= 3.6)
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Imports: 
   ggplot2,
-  DALEX (>= 1.2),
+  DALEX (>= 1.3),
   glmnet,
   ggdendro,
   patchwork

NEWS.md

@@ -1,3 +1,13 @@
+# triplot 1.3
+
+* changed the way plot(model_triplot) is build, so it works correctly with 
+patchwork 1.0.1
+* changed parameter in DALEX::feature_importance call from n_sample to N (due 
+to change in DALEX 1.2.1)
+* added parameter to change correlation method in group_variables, 
+cluster_variables, triplot
+
+
 # triplot 1.2
 
 * last vertical line in hierarchical_importance() plot of model_triplot() shows 

R/group_variables.R

@@ -5,6 +5,8 @@
 #' @param x dataframe with only numeric columns
 #' @param clust_method the agglomeration method to be used
 #' see \code{\link[stats]{hclust}} methods
+#' @param cor_method the correlation method to be used
+#' see \code{\link[stats]{cor}} methods
 #'
 #' @return an hclust object
 #'
@@ -26,13 +28,14 @@ cluster_variables <- function(x, ...)
 #' @export
 #' @rdname cluster_variables
 
-cluster_variables.default <- function(x, clust_method = "complete", ...) {
+cluster_variables.default <- function(x, clust_method = "complete", 
+                                      cor_method = "spearman", ...) {
 
   stopifnot(all(sapply(x, is.numeric)))
 
 # build clustering tree ---------------------------------------------------
 
-  x_hc <- hclust(as.dist(1 - abs(cor(x, method = "spearman"))),
+  x_hc <- hclust(as.dist(1 - abs(cor(x, method = cor_method))),
                  method = clust_method)
 
   class(x_hc) <- c("cluster_variables", "hclust")
@@ -186,6 +189,8 @@ list_variables <- function(x, h) {
 #' @param h correlation value for tree cutting
 #' @param clust_method the agglomeration method to be used
 #' see \code{\link[stats]{hclust}} methods
+#' @param cor_method the correlation method to be used
+#' see \code{\link[stats]{cor}} methods
 #'
 #' @examples
 #' library("DALEX")
@@ -196,11 +201,13 @@ list_variables <- function(x, h) {
 #' @export
 
 
-group_variables <- function(x, h, clust_method = "complete") {
+group_variables <- function(x, h, clust_method = "complete", 
+                            cor_method = "spearman") {
 
 # make a tree and prepare a list with aspects grouping --------------------
 
-  cv <- cluster_variables(x, clust_method = clust_method)
+  cv <- cluster_variables(x, clust_method = clust_method, 
+                          cor_method = cor_method)
   res <- list_variables(cv, h)
 
   return(res)

R/hierarchical_importance.R

@@ -23,6 +23,8 @@
 #'   "ratio" returns \code{drop_loss/drop_loss_full_model}.
 #' @param clust_method the agglomeration method to be used, see
 #'   \code{\link[stats]{hclust}} methods
+#' @param cor_method the correlation method to be used see 
+#'   \code{\link[stats]{cor}} methods
 #' @param absolute_value if TRUE, aspects importance values will be drawn as
 #'   absolute values
 #' @param show_labels if TRUE, plot will have annotated axis Y
@@ -66,6 +68,7 @@ hierarchical_importance <- function(x, data, y = NULL,
                                     B = 10,
                                     fi_type = c("raw", "ratio", "difference"),
                                     clust_method = "complete",
+                                    cor_method = "spearman",
                                     ...) {
 
   if (all(type != "predict", is.null(y))) {
@@ -77,7 +80,7 @@ hierarchical_importance <- function(x, data, y = NULL,
 
   # Building helper objects ---------------------------------------------
 
-  x_hc <- hclust(as.dist(1 - abs(cor(data, method = "spearman"))),
+  x_hc <- hclust(as.dist(1 - abs(cor(data, method = cor_method))),
                  method = clust_method)
   cutting_heights <- x_hc$height
   aspects_list_previous <-  list_variables(x_hc, 1)

R/triplot.R

@@ -30,6 +30,8 @@
 #'   "ratio" returns \code{drop_loss/drop_loss_full_model}.
 #' @param clust_method the agglomeration method to be used, see
 #'   \code{\link[stats]{hclust}} methods
+#' @param cor_method the correlation method to be used see 
+#'   \code{\link[stats]{cor}} methods
 #' @param ... other parameters
 #'
 #' @import stats
@@ -73,6 +75,7 @@ calculate_triplot.explainer <- function(x,
                                         fi_type =
                                           c("raw", "ratio", "difference"),
                                         clust_method = "complete",
+                                        cor_method = "spearman",
                                         ...) {
 
   type <- match.arg(type)
@@ -109,6 +112,7 @@ calculate_triplot.explainer <- function(x,
                             B = B,
                             fi_type = fi_type,
                             clust_method = clust_method,
+                            cor_method = cor_method,
                             label = label)
 }
 
@@ -126,6 +130,7 @@ calculate_triplot.default <- function(x, data, y = NULL,
                                       B = 10,
                                       fi_type = c("raw", "ratio", "difference"),
                                       clust_method = "complete",
+                                      cor_method = "spearman",
                                       ...) {
 
   type <- match.arg(type)
@@ -142,11 +147,13 @@ calculate_triplot.default <- function(x, data, y = NULL,
                                 loss_function = loss_function,
                                 B = B,
                                 fi_type = fi_type,
-                                clust_method = clust_method)
+                                clust_method = clust_method,
+                                cor_method = cor_method)
 
   # Calculations for third plot -----------------------------------------------
 
-  cv <- cluster_variables(data, clust_method)
+  cv <- cluster_variables(data, clust_method = clust_method, 
+                          cor_method = cor_method)
 
   # Calculations for first plot -----------------------------------------------