Merge pull request #3 from OskNum/unit-tests

Unit tests

Author: leomccarthy

.github/CODE_OF_CONDUCT.md

@@ -60,8 +60,13 @@ preprocess <- function(df,
     function_vector <- strings_to_functions(numeric_operation_list)
     names(function_vector) <- numeric_operation_list
 
-    numeric_df <- df %>% 
-      select(-target) %>%
+    if (!is.na(target)) {
+      numeric_df <- select(df, -target)
+    } else {
+      numeric_df <- df
+    }
+    
+    numeric_df <- numeric_df %>% 
       group_by(.data$customerid) %>% 
       summarise_if(is.numeric, function_vector) %>% 
       ungroup()
@@ -71,18 +76,19 @@ preprocess <- function(df,
     } else {
       evaluated_columns <- names(df)[sapply(df, is.numeric) & names(df) != 'customerid' & names(df) != target]
     }
+    
 
     if (length(evaluated_columns) == 1) {
       adjusted_name <- paste0(evaluated_columns, '_', names(numeric_df)[!(names(numeric_df) %in% c('customerid', target))])
       names(numeric_df) <- c('customerid', adjusted_name)
     }
-    
+
     # Filters categorical columns and grabs the top n category for each
     # categorical column
     final_df <- inner_join(final_df, numeric_df, by = 'customerid')
   }
 
-  
+
   if (!is.null(categories)) {
     for (col_name in categories) {
 
@@ -118,7 +124,6 @@ preprocess <- function(df,
 
   return(final_df)
 }
-
 strings_to_functions <- function(string_vector) {
   function_vector <- c()
   for (obj_name in string_vector) {

.github/CONTRIBUTING.md

@@ -5,11 +5,17 @@
 #' @param supervised logical, TRUE for supervised learning, FALSE for unsupervised
 #' @importFrom dplyr n_distinct
 #' @export
-validate <- function(df, supervised = TRUE) {
+validate <- function(df, supervised = TRUE, hyperparameters = NULL) {
   missing_columns <- c()
   other_errors <- c()
   toomanylevels_columns <- c()
-  categorical_columns <- df %>% select(-customerid) %>% select_if(is.character) %>% summarise_all(n_distinct)
+  categorical_columns <- df[,names(df) != 'customerid'] %>% select_if(is.character) %>% summarise_all(n_distinct)
+  
+  
+  
+  if (!is.null(hyperparameters$segmentation_variables)) {
+    df <- df[,names(df) %in% hyperparameters$segmentation_variables]
+  }
 
   if (!('response' %in% names(df)) & (supervised == TRUE)) {
     missing_columns <- c(missing_columns, 'response')

.github/ISSUE_TEMPLATE/BUG_REPORT.md

@@ -19,11 +19,13 @@ test_that("Number of Columns", {
   expect_equal(ncol(output), 16)
 })
 
-
 test_that("Number of Rows", {
   expect_equal(nrow(output), 6)
 })
 
 test_that("No nulls", {
   expect_equal(ncol(output[complete.cases(output), ]), 16)
-})
+})
+
+
+

.github/ISSUE_TEMPLATE/FEATURE_REQUEST.md

@@ -5,13 +5,13 @@ library(dplyr)
 transactional_data <- citrus::transactional_data
 data <- transactional_data %>% select(c('transactionid', 'transactionvalue', 'customerid', 'orderdate'))
 output_preprocess <- citrus::preprocess(data, numeric_operation_list = 'mean')
+output_with_response <- citrus::preprocess(data, numeric_operation_list = 'mean', target = 'transactionvalue')
 output_preprocess_na <- citrus::preprocess(data, numeric_operation_list = NULL)
 
 test_that("Number of Columns", {
   expect_equal(ncol(output_preprocess), 5)
 })
 
-
 test_that("String Customerid Check", {
   expect_true(is.character(typeof(output_preprocess$customerid)))
 })
@@ -21,7 +21,10 @@ test_that("Passing NA to numeric_operations_list defaults to RFM", {
   expect_equal(sort(colnames(output_preprocess_na)), sort(c('customerid', 'recency', 'frequency', 'monetary')))
 })
 
-
 test_that("Correct Labelling", {
   expect_equal(colnames(output_preprocess), c('customerid', 'recency', 'frequency', 'monetary', 'transactionvalue_mean'))
 })
+
+test_that("Custom target included", {
+  expect_true('response' %in% colnames(output_with_response))
+})

.github/PULL_REQUEST_TEMPLATE.md

@@ -0,0 +1,83 @@
+library(citrus)
+library(testthat)
+library(dplyr)
+
+transactional_data <- citrus::transactional_data
+data <- transactional_data %>% select(c('transactionid', 'transactionvalue', 'customerid', 'orderdate'))
+
+test_that("Supervised default output object check", {
+  output_supervised <- segment(data, modeltype = 'tree')
+  
+  # Should contain all the right variables
+  expect_true(all(names(output_supervised) %in% c('OutputTable', 'segments', 'CitrusModel')))
+  # Output table should be 6 rows
+  expect_equal(nrow(output_supervised$OutputTable), 6)
+  # No nulls allowed in the output table
+  expect_equal(ncol(output_supervised$OutputTable[complete.cases(output_supervised$OutputTable), ]), 10)
+  # The segment lookup should not contain any NAs
+  expect_true(all(!is.na(output_supervised$segments$persona)))
+  expect_true(all(!is.na(output_supervised$segments$customerid)))
+})
+
+test_that("Supervised custom output object check", {
+  
+  output_supervised <- segment(data, modeltype = 'tree', hyperparameters = list(dependent_variable = 'response',
+                                                                                min_segmentation_fraction = 0.1,
+                                                                                print_safety_check = 20,
+                                                                                number_of_personas = 4,
+                                                                                print_plot = FALSE))
+  
+  # Should contain all the right variables
+  expect_true(all(names(output_supervised) %in% c('OutputTable', 'segments', 'CitrusModel')))
+  # Output table should be 4 rows
+  expect_equal(nrow(output_supervised$OutputTable), 4)
+  # No nulls allowed in the output table
+  expect_equal(ncol(output_supervised$OutputTable[complete.cases(output_supervised$OutputTable), ]), 10)
+  # There shouldn't be segments smaller than 10% of the total population
+  expect_true(all(output_supervised$OutputTable$percentage >= 0.1))
+  # The segment lookup should not contain any NAs
+  expect_true(all(!is.na(output_supervised$segments$persona)))
+  expect_true(all(!is.na(output_supervised$segments$customerid)))
+  # The model hyperparameters should agree with the custom ones
+  expect_true(output_supervised$CitrusModel$model_hyperparameters$dependent_variable == 'response')
+  expect_true(output_supervised$CitrusModel$model_hyperparameters$min_segmentation_fraction == 0.1)
+  expect_true(output_supervised$CitrusModel$model_hyperparameters$number_of_personas == 4)
+})
+
+test_that("Unsupervised default output object check", {
+  output_unsupervised <- segment(data, modeltype = 'unsupervised')
+  
+  # Should contain all the right variables
+  expect_true(all(names(output_unsupervised) %in% c('OutputTable', 'segments', 'CitrusModel')))
+  # Output table should be 3 rows
+  expect_equal(nrow(output_unsupervised$OutputTable), 3)
+  # No nulls allowed in the output table
+  expect_equal(ncol(output_unsupervised$OutputTable[complete.cases(output_unsupervised$OutputTable), ]), 3)
+  # The segment lookup should not contain any NAs
+  expect_true(all(!is.na(output_unsupervised$segments$persona)))
+  expect_true(all(!is.na(output_unsupervised$segments$customerid)))
+})
+
+test_that("Supervised custom output object check", {
+  
+  output_unsupervised <- segment(data, modeltype = 'unsupervised', hyperparameters = list(centers = 'auto',
+                                                                                          iter_max = 35,
+                                                                                          nstart = 2,
+                                                                                          max_centers = 3, 
+                                                                                          segmentation_variables = NULL,
+                                                                                          standardize = TRUE))
+  
+  # Should contain all the right variables
+  expect_true(all(names(output_unsupervised) %in% c('OutputTable', 'segments', 'CitrusModel')))
+  # Output table should be 2 rows
+  expect_equal(nrow(output_unsupervised$OutputTable), 2)
+  # No nulls allowed in the output table
+  expect_equal(ncol(output_unsupervised$OutputTable[complete.cases(output_unsupervised$OutputTable), ]), 3)
+  # The segment lookup should not contain any NAs
+  expect_true(all(!is.na(output_unsupervised$segments$persona)))
+  expect_true(all(!is.na(output_unsupervised$segments$customerid)))
+  # The model hyperparameters should agree with the custom ones
+  expect_true(output_unsupervised$CitrusModel$model_hyperparameters$centers == 'auto')
+  expect_true(output_unsupervised$CitrusModel$model_hyperparameters$iter_max == 35)
+  expect_true(output_unsupervised$CitrusModel$model_hyperparameters$nstart == 2)
+})

.github/workflows/r_new.yml

@@ -5,12 +5,23 @@ library(dplyr)
 transactional_data <- citrus::transactional_data
 data <- transactional_data %>% select(c('transactionid', 'transactionvalue', 'customerid', 'orderdate'))
 output_preprocess <- citrus::preprocess(data, numeric_operation_list = 'mean')
+preprocess_too_many_categories <- citrus::preprocessed_data %>%
+  mutate(faulty_feature = as.character(customerid))
+preprocess_no_customerid <- citrus::preprocessed_data %>%
+  select(-customerid)
 
 test_that("Supervised without response variable", {
-  expect_error(validate(output_preprocess))
+  expect_error(citrus::validate(output_preprocess), regexp = "Columns missing: response")
 })
 
+test_that("Correct error when customerid is missing.", {
+  expect_error(citrus::validate(preprocess_no_customerid), regexp = "Columns missing: customerid")
+})
+
+test_that("Throw error when too many categorical levels", {
+  expect_error(citrus::validate(preprocess_too_many_categories), regexp = "Categorical Columns have too many levels: faulty_feature")
+})
 
 test_that("Unique customer count", {
   expect_equal(nrow(output_preprocess), length(unique(output_preprocess[["customerid"]])))
-})
+})