From fff827bee246a2d904a412982d75a8df6ab8d618 Mon Sep 17 00:00:00 2001
From: Mirka Henninger <mail@mirka-henninger.de>
Date: Tue, 2 Feb 2021 21:38:47 +0100
Subject: [PATCH] add test for weight functions

---
 tests/testthat/test-LocalModel.R | 41 ++++++++++++++++++++++++++------
 1 file changed, 34 insertions(+), 7 deletions(-)

diff --git a/tests/testthat/test-LocalModel.R b/tests/testthat/test-LocalModel.R
index b83230bee..c4b8eab97 100644
--- a/tests/testthat/test-LocalModel.R
+++ b/tests/testthat/test-LocalModel.R
@@ -16,26 +16,26 @@ test_that("LocalModel works for single output and single feature", {
   p <- plot(LocalModel1)
   expect_s3_class(p, c("gg", "ggplot"))
   p
-
+  
   x.interest2 <- X[4, ]
   LocalModel1$explain(x.interest2)
   dat <- LocalModel1$results
   expect_equal(colnames(dat), expected.colnames)
   expect_lte(nrow(dat), k)
-
+  
   pred <- predict(LocalModel1, newdata = X[3:4, ])
   expect_data_frame(pred, nrows = 2)
   expect_equal(colnames(pred), "prediction")
-
+  
   LocalModel1 <- LocalModel$new(predictor1,
-    x.interest = x.interest, k = k,
-    dist.fun = "euclidean", kernel.width = 1
+                                x.interest = x.interest, k = k,
+                                dist.fun = "euclidean", kernel.width = 1
   )
   LocalModel1$explain(x.interest2)
   dat <- LocalModel1$results
   expect_equal(colnames(dat), expected.colnames)
   expect_lte(nrow(dat), k)
-
+  
   pred <- predict(LocalModel1, newdata = X[3:4, ])
   expect_data_frame(pred, nrows = 2)
   expect_equal(colnames(pred), "prediction")
@@ -57,7 +57,7 @@ test_that("LocalModel works for multiple output", {
   expect_class(dat, "data.frame")
   expect_data_frame(pred2, nrows = 2)
   expect_equal(colnames(pred2), c("setosa", "versicolor", "virginica"))
-
+  
   p <- plot(LocalModel1)
   expect_s3_class(p, c("gg", "ggplot"))
   p
@@ -74,3 +74,30 @@ test_that("LocalModel prediction expects same cols as training dat", {
   expect_warning(LocalModel1$predict(cbind(x.interest, data.frame(blabla = 1))))
   expect_error(LocalModel1$predict(x.interest[-2]), "Missing")
 })
+
+
+
+
+test_that("LocalModel distance functions work as expected", {
+  kernel.width <- 1
+  distance.functions <- c(
+    "gower", "euclidean", "maximum",
+    "manhattan", "canberra", "binary", "minkowski")
+  x.interest <- X[2, ]
+  k <- 1
+  set.seed(42)
+  LocalModel1 <- LocalModel$new(predictor1, x.interest = x.interest, k = k, 
+                                dist = "euclidean", kernel.width = kernel.width)
+  # recode to avoid warning for categorical variables (NAs introduced by coercion)
+  X.recode <- recode(LocalModel1$.__enclos_env__$private$dataDesign, x.interest)
+  x.recoded <- recode(x.interest, x.interest)
+  # first test the function that was used for fitting
+  weights <- LocalModel1$.__enclos_env__$private$weight.fun(X.recode, x.recoded)
+  expect_equal(object = weights[2], expected = 1)
+  # test all distance functions by explicitly constructing them via get.weight.fun()
+  for(fun in distance.functions){
+    weight_fun <- LocalModel1$.__enclos_env__$private$get.weight.fun(
+      dist.fun = fun, kernel.width = kernel.width)
+    expect_equal(object = weight_fun(X.recode, x.recoded)[2], expected = 1)
+  }
+})