rescaleNetwork now supports networks with depots

R/rescaleNetwork.R

@@ -1,4 +1,6 @@
-#' Normalize coordinates to unit cube maintaining its geography.
+#' @title Rescale network
+#'
+#' @description Normalize network coordinates to the unit cube maintaining its geography.
 #'
 #' @template arg_network
 #' @param method [\code{character(1)}]\cr
@@ -16,6 +18,7 @@
 #' \dontrun{
 #' library(gridExtra)
 #' x = generateClusteredNetwork(n.points = 100L, n.cluster = 4L, name = "Rescaling Demo")
+#'
 #' # here we "stretch" the instance x direction
 #' x$coordinates[, 1] = x$coordinates[, 1] * 10L
 #' x$upper = x$upper * 10L
@@ -32,19 +35,32 @@
 #' @export
 rescaleNetwork = function(x, method = "global2") {
   assertClass(x, "Network")
+  if (!isEuclidean(x)) {
+    stopf("Rescaling for non-euclidean networks unsupported.")
+  }
+
+  coordinates = x$coordinates
   if (hasDepots(x)) {
-    stopf("Rescaling of networks with depots currently not supported.")
+    coordinates = rbind(x$depot.coordinates, coordinates)
   }
+
   method.mapping = list(
     "by.dimension" = rescaleNetworkByDimension,
     "global" = rescaleNetworkGlobal,
     "global2" = rescaleNetworkGlobal2
-    )
+  )
   assertChoice(method, choices = names(method.mapping))
   rescaleMethod = method.mapping[[method]]
-  x$coordinates = rescaleMethod(x$coordinates)
+  rescaled.coordinates = rescaleMethod(coordinates)
+  if (hasDepots(x)) {
+    n.depots = getNumberOfDepots(x)
+    x$depot.coordinates = rescaled.coordinates[1:n.depots, , drop = FALSE]
+    x$coordinates = rescaled.coordinates[-(1:n.depots), , drop = FALSE]
+  } else {
+    x$coordinates = rescaled.coordinates
+  }
 
-    # rescaling is a normalization to [0,1]^dim
+  # rescaling is a normalization to [0,1]^dim
   x$lower = 0
   x$upper = 1
   return(x)

tests/testthat/test_rescaleNetwork.R

@@ -1,17 +1,20 @@
 context("rescaling")
 
 test_that("rescaling actually rescales network", {
-  expect_in_bounds = function(coords) {
-    expect_true(all(coords >= 0) && all(coords <= 1))
-    expect_true(any(coords == 0) && any(coords == 1))
+  expect_in_bounds = function(x) {
+    expect_true(all(x$coordinates >= 0) && all(x$coordinates <= 1))
+    expect_true(any(x$coordinates == 0) && any(x$coordinates == 1))
+    if (hasDepots(x)) {
+      expect_true(all(x$depot.coordinates >= 0) && all(x$depot.coordinates <= 1))
+    }
   }
   x = generateRandomNetwork(n.points = 10L)
   x.rg = range(x$coordinates)
   # GLOBAL RESCALING
   xr = rescaleNetwork(x, method = "global")
 
   # check for conditions that must be valid
-  expect_in_bounds(xr$coordinates)
+  expect_in_bounds(xr)
   expect_true(any(xr$coordinates == 0) && any(xr$coordinates == 1))
 
   # scale back
@@ -20,16 +23,23 @@ test_that("rescaling actually rescales network", {
 
   # GLOBAL RESCALING (2nd)
   xr = rescaleNetwork(x, method = "global2")
-  expect_in_bounds(xr$coordinates)
+  expect_in_bounds(xr)
 
   # check for conditions that must be valid
-  expect_in_bounds(xr$coordinates)
   expect_true(any(xr$coordinates == 0) && any(xr$coordinates == 1))
 
   xr = rescaleNetwork(x, method = "by.dimension")
-  expect_in_bounds(xr$coordinates)
+  expect_in_bounds(xr)
   expect_true(any(xr$coordinates[, 1] == 0))
   expect_true(any(xr$coordinates[, 1] == 1))
   expect_true(any(xr$coordinates[, 2] == 0))
   expect_true(any(xr$coordinates[, 2] == 1))
+
+  # check rescaling of instances with depots
+  x = generateClusteredNetwork(n.points = 50L, n.cluster = 3L, n.depots = 2L)
+  xr = rescaleNetwork(x)
+  expect_in_bounds(xr)
+  expect_equal(getNumberOfNodes(x), getNumberOfNodes(xr))
+  expect_equal(getNumberOfDepots(x), getNumberOfDepots(xr))
+  expect_equal(getNumberOfClusters(x), getNumberOfClusters(xr))
 })