Merge branch 'v1.0.2' into main

Author: cinziabraglia7

DESCRIPTION

@@ -3,13 +3,14 @@ Type: Package
 Title: Customer Intelligence Tool for Rapid Understandable Segmentation
 Version: 1.0.1
 Authors@R: c(
-    person("Dom","Clarke", email = "dom.clarke@peak.ai", role = c("aut", "cre")),
+    person("Dom","Clarke",email = "dom.clarke@peak.ai", role = c("aut", "cre")),
     person("Cinzia","Braglia",email = "cinzia.braglia@peak.ai",role = "aut"),
     person("Oskar","Nummedal",email = "oskar.nummadel@peak.ai",role = "aut"),
     person("Leo", "McCarthy",email = "leo.mccarthy@peak.ai", role = "aut"),
     person("Rebekah", "Yates",email = "rebekah.yates@peak.ai", role = "aut"),
+    person("Stuart", "Davie",email = "stuart.davie@peak.ai", role = "aut"),
     person("Joash","Alonso",role = "aut"),
-    person("PEAK AI LIMITED", role = "cph")
+    person("PEAK AI LIMITED",role = "cph")
   )
 Maintainer: Dom Clarke <dom.clarke@peak.ai>
 Copyright: See the file COPYRIGHTS
@@ -22,18 +23,18 @@ Suggests: testthat
 Depends:
     R (>= 3.5.0)
 Imports:
-    ggplot2,
-    GGally,
+    ggplot2 (>= 3.3.0),
+    GGally (>= 2.0.0),
     clustMixType (>= 0.1-16),
-    treeClust,
-    rpart,
-    tibble,
-    rpart.plot,
-    rpart.utils,
-    stringr,
-    dplyr,
-    RColorBrewer,
-    rlang
+    treeClust (>= 1.1-7),
+    rpart (>= 4.1-15),
+    tibble (>= 3.0.0),
+    rpart.plot (>= 3.0.7),
+    rpart.utils (>= 0.5),
+    stringr (>= 1.3.0),
+    dplyr (>= 1.0.7),
+    RColorBrewer (>= 1.1-2),
+    rlang (>= 0.4.9)
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.2

R/output_table.R

@@ -29,13 +29,13 @@ output_table <- function(data, model) {
     segmentation_vars <- allcolumnnames[!allcolumnnames %in% c('id', response , 'segment')]  
   }
 
-  df_agg <- df %>% select(c('segment',model$model_hyperparameters$segmentation_variables)) 
+  df_agg <- df %>% select(c('segment',model$model_hyperparameters$segmentation_variables))
 
   df_agg_numeric <- df_agg[, unlist(lapply(df_agg, is.numeric)) | names(df_agg) == 'segment'] %>%
     group_by(.data$segment) %>%
     summarise(across(everything(), ~round(mean(.data$., na.rm = TRUE), 2)))
 
-  df_agg_character <- df_agg[, !unlist(lapply(df_agg, is.numeric)) | names(df_agg) == 'segment'] %>%
+  df_agg_character <- df_agg[, !unlist(lapply(df_agg, is.numeric)) | names(df_agg) == 'segment', drop = FALSE] %>%
     group_by(.data$segment) %>%
     summarise(across(everything(), ~mode(.data$.)))
 
@@ -48,11 +48,11 @@ output_table <- function(data, model) {
 
 
   seg_vars <- model$model_hyperparameters$segmentation_variables
-  df_agg2_numeric <- df[, (unlist(lapply(df, is.numeric)) & names(df) %in% seg_vars) | names(df) == 'segment'] %>%
+  df_agg2_numeric <- df[, (unlist(lapply(df, is.numeric)) & names(df) %in% seg_vars) | names(df) == 'segment', drop = FALSE] %>%
     group_by(.data$segment) %>% 
     summarise(across(everything(), ~range_output(.data$.)))
 
-  df_agg2_character <- df[, (!unlist(lapply(df, is.numeric)) & names(df) %in% seg_vars) | names(df) == 'segment'] %>%
+  df_agg2_character <- df[, (!unlist(lapply(df, is.numeric)) & names(df) %in% seg_vars) | names(df) == 'segment', drop = FALSE] %>%
     group_by(.data$segment) %>% 
     summarise(across(everything(), ~top5categories(.data$.)))
 
@@ -68,16 +68,16 @@ output_table <- function(data, model) {
   if(response %in% names(df)) {
     df <- df %>%
       group_by(.data$segment)%>%
-      summarise(n = n(), mean_value = mean(as.numeric(as.character(.data$response)),na.rm=TRUE)) %>%
+      summarise(n = n(), mean_value = mean(as.numeric(as.character(.data[[response]])),na.rm=TRUE)) %>%
       mutate(percentage = paste0(100*round((.data$n/sum(.data$n)),3),'%')) %>% 
-        left_join(df_agg, by = 'segment')
+      left_join(df_agg, by = 'segment')
 
   } else {
     df <- df %>%
       group_by(.data$segment)%>%
       summarise(n = n()) %>%
       mutate(mean_value = NULL, percentage = paste0(100*round(.data$n/sum(.data$n),3),'%')) %>% 
-        left_join(df_agg, by = 'segment')
+      left_join(df_agg, by = 'segment')
 
   }
 

R/plotting.R

@@ -23,4 +23,4 @@ citrus_pair_plot <- function(model,vars = NULL) {
 }
 
 
-
+    

R/tree_segment.R

@@ -12,6 +12,7 @@
 #' @importFrom rpart.plot rpart.plot
 #' @importFrom rlang .data
 #' @param verbose logical whether information about the segmentation procedure should be given.
+#' @author Stuart Davie, \email{stuart.davie@@peak.ai}
 #' @return List of 4 objects. The rpart object defining the model, a data frame providing high-level segment attributes,
 #' a lookup table (data frame) with the id and predicted segment number, and a list of the hyperparameters used.
 #' @export
@@ -71,6 +72,7 @@ tree_segment <- function(data, hyperparameters, verbose = TRUE){
 #' @importFrom rpart rpart.control rpart prune
 #' @importFrom tibble rownames_to_column 
 #' @importFrom rlang .data
+#' @author Stuart Davie, \email{stuart.davie@@peak.ai}
 decision_tree_user_defined_leafs.make <- function(df,segmentation_variables,dependent_variable='response',min_segmentation_fraction=0.05,number_of_leafs=6){
 
   minbucket = floor(nrow(df)*min_segmentation_fraction)
@@ -119,6 +121,7 @@ decision_tree_user_defined_leafs.make <- function(df,segmentation_variables,depe
 #' @importFrom rpart.utils rpart.rules rpart.subrules.table
 #' @importFrom stringr str_split
 #' @importFrom rlang .data
+#' @author Stuart Davie, \email{stuart.davie@@peak.ai}
 tree_table.make <- function(tree, integer_columns){
 
   df1 <- rownames_to_column(tree$frame) %>% arrange(as.numeric(.data$rowname)) %>%
@@ -215,6 +218,7 @@ tree_table.make <- function(tree, integer_columns){
 #' @importFrom dplyr mutate row_number arrange bind_cols filter transmute %>%
 #' @importFrom rpart.utils rpart.rules
 #' @importFrom rlang .data
+#' @author Stuart Davie, \email{stuart.davie@@peak.ai}
 segment_tree.make <- function(tree){
 
   df1 <- rownames_to_column(tree$frame) %>% mutate(orig_row=row_number()) %>% arrange(as.numeric(.data$rowname)) %>%