mv wt-profile tests from test-graph-fns.R to test-wt-profiles.R

UrbanAnalyst · Aug 11, 2022 · 03942e2 · 03942e2
1 parent 60a9dcf
commit 03942e2
Show file tree

Hide file tree

Showing 4 changed files with 109 additions and 110 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: dodgr
 Title: Distances on Directed Graphs
-Version: 0.2.14.091
+Version: 0.2.14.092
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre")),
     person("Andreas", "Petutschnig", role = "aut"),

diff --git a/codemeta.json b/codemeta.json
@@ -7,7 +7,7 @@
   "codeRepository": "https://github.com/ATFutures/dodgr",
   "issueTracker": "https://github.com/ATFutures/dodgr/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.2.14.091",
+  "version": "0.2.14.092",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

diff --git a/tests/testthat/test-graph-fns.R b/tests/testthat/test-graph-fns.R
@@ -1,7 +1,5 @@
 context ("dodgr graph functions")
 
-skip_on_cran ()
-
 test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") |
     identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage"))
 
@@ -222,112 +220,6 @@ test_that ("keep cols", {
     )
 })
 
-test_that ("weight_profiles", {
-    graph0 <- weight_streetnet (hampi, wt_profile = "foot")
-    graph1 <- weight_streetnet (hampi, wt_profile = 1)
-    expect_equal (nrow (graph0), nrow (graph1))
-    expect_identical (graph0$d, graph1$d)
-    expect_true (!identical (graph0$d_weighted, graph1$d_weighted))
-
-    wp <- dodgr::weighting_profiles$weighting_profiles
-    wpf <- wp [wp$name == "foot", ]
-    graph3 <- weight_streetnet (hampi, wt_profile = wpf)
-    expect_identical (graph0$d_weighted, graph3$d_weighted)
-
-    wpf$value [wpf$way == "path"] <- 0.9
-    graph4 <- weight_streetnet (hampi, wt_profile = wpf)
-    expect_true (!identical (graph0$d_weighted, graph4$d_weighted))
-
-    names (wpf) [3] <- "Value"
-    expect_error (
-        graph4 <- weight_streetnet (hampi, wt_profile = wpf),
-        "Weighting profiles must have"
-    )
-
-    g0 <- weight_streetnet (hampi)
-    if ("px" %in% names (attributes (g0))) {
-        while (attr (g0, "px")$is_alive ()) {
-            attr (g0, "px")$wait ()
-        }
-    }
-    hampi2 <- hampi
-    names (hampi2) [grep ("highway", names (hampi2))] <- "waytype"
-    expect_error (
-        net <- weight_streetnet (hampi2),
-        "Please specify type_col to be used for weighting streetnet"
-    )
-
-    g1 <- weight_streetnet (hampi2, type_col = "waytype")
-    if ("px" %in% names (attributes (g1))) {
-        while (attr (g1, "px")$is_alive ()) {
-            attr (g1, "px")$wait ()
-        }
-    }
-    attr (g0, "px") <- NULL
-    attr (g1, "px") <- NULL
-
-    expect_identical (g0, g1)
-    names (hampi2) [grep ("osm_id", names (hampi2))] <- "key"
-    expect_message (
-        net <- weight_streetnet (hampi2, type_col = "waytype"),
-        "x appears to have no ID column"
-    )
-    if ("px" %in% names (attributes (net))) {
-        while (attr (net, "px")$is_alive ()) {
-            attr (net, "px")$wait ()
-        }
-    }
-
-    names (hampi2) [grep ("key", names (hampi2))] <- "id"
-    expect_message (
-        net <- weight_streetnet (hampi2, type_col = "waytype"),
-        "Using column id as ID column for edges"
-    )
-    if ("px" %in% names (attributes (net))) {
-        while (attr (net, "px")$is_alive ()) {
-            attr (net, "px")$wait ()
-        }
-    }
-
-    names (hampi2) [grep ("width", names (hampi2))] <- "w"
-    expect_message (
-        g1 <- weight_streetnet (hampi2, type_col = "waytype"),
-        "Using column id as ID column for edges"
-    )
-    if ("px" %in% names (attributes (g1))) {
-        while (attr (g1, "px")$is_alive ()) {
-            attr (g1, "px")$wait ()
-        }
-    }
-    attr (g0, "px") <- NULL
-    attr (g1, "px") <- NULL
-
-    expect_identical (g0, g1)
-})
-
-
-test_that ("railway", {
-    expect_error (
-        g0 <- weight_streetnet (hampi, wt_profile = "rail"),
-        "Please use the weight_railway function for railway routing"
-    )
-    expect_error (
-        g0 <- weight_railway (hampi),
-        "Please specify type_col to be used for weighting railway"
-    )
-
-    expect_message (
-        g0 <- weight_railway (hampi, type_col = "highway"),
-        "Data has no columns named maxspeed"
-    )
-    expect_silent (g0 <- weight_railway (hampi,
-        type_col = "highway",
-        keep_cols = NULL
-    ))
-
-    expect_identical (g0$d, g0$d_weighted)
-})
-
 test_that ("graph columns", {
     graph <- data.frame (weight_streetnet (hampi)) # rm dodgr_streetnet class
     nf <- 100

diff --git a/tests/testthat/test-wt-profiles.R b/tests/testthat/test-wt-profiles.R
@@ -59,3 +59,110 @@ test_that ("weight_streetnet wt_profile_file", {
     expect_silent (graph <- weight_streetnet (hampi, wt_profile = 1))
     expect_identical (graph$d, graph$d_weighted)
 })
+
+test_that ("weight_profile structure", {
+
+    graph0 <- weight_streetnet (hampi, wt_profile = "foot")
+    graph1 <- weight_streetnet (hampi, wt_profile = 1)
+    expect_equal (nrow (graph0), nrow (graph1))
+    expect_identical (graph0$d, graph1$d)
+    expect_true (!identical (graph0$d_weighted, graph1$d_weighted))
+
+    wp <- dodgr::weighting_profiles$weighting_profiles
+    wpf <- wp [wp$name == "foot", ]
+    graph3 <- weight_streetnet (hampi, wt_profile = wpf)
+    expect_identical (graph0$d_weighted, graph3$d_weighted)
+
+    wpf$value [wpf$way == "path"] <- 0.9
+    graph4 <- weight_streetnet (hampi, wt_profile = wpf)
+    expect_true (!identical (graph0$d_weighted, graph4$d_weighted))
+
+    names (wpf) [3] <- "Value"
+    expect_error (
+        graph4 <- weight_streetnet (hampi, wt_profile = wpf),
+        "Weighting profiles must have"
+    )
+
+    g0 <- weight_streetnet (hampi)
+    if ("px" %in% names (attributes (g0))) {
+        while (attr (g0, "px")$is_alive ()) {
+            attr (g0, "px")$wait ()
+        }
+    }
+    hampi2 <- hampi
+    names (hampi2) [grep ("highway", names (hampi2))] <- "waytype"
+    expect_error (
+        net <- weight_streetnet (hampi2),
+        "Please specify type_col to be used for weighting streetnet"
+    )
+
+    g1 <- weight_streetnet (hampi2, type_col = "waytype")
+    if ("px" %in% names (attributes (g1))) {
+        while (attr (g1, "px")$is_alive ()) {
+            attr (g1, "px")$wait ()
+        }
+    }
+    attr (g0, "px") <- NULL
+    attr (g1, "px") <- NULL
+
+    expect_identical (g0, g1)
+    names (hampi2) [grep ("osm_id", names (hampi2))] <- "key"
+    expect_message (
+        net <- weight_streetnet (hampi2, type_col = "waytype"),
+        "x appears to have no ID column"
+    )
+    if ("px" %in% names (attributes (net))) {
+        while (attr (net, "px")$is_alive ()) {
+            attr (net, "px")$wait ()
+        }
+    }
+
+    names (hampi2) [grep ("key", names (hampi2))] <- "id"
+    expect_message (
+        net <- weight_streetnet (hampi2, type_col = "waytype"),
+        "Using column id as ID column for edges"
+    )
+    if ("px" %in% names (attributes (net))) {
+        while (attr (net, "px")$is_alive ()) {
+            attr (net, "px")$wait ()
+        }
+    }
+
+    names (hampi2) [grep ("width", names (hampi2))] <- "w"
+    expect_message (
+        g1 <- weight_streetnet (hampi2, type_col = "waytype"),
+        "Using column id as ID column for edges"
+    )
+    if ("px" %in% names (attributes (g1))) {
+        while (attr (g1, "px")$is_alive ()) {
+            attr (g1, "px")$wait ()
+        }
+    }
+    attr (g0, "px") <- NULL
+    attr (g1, "px") <- NULL
+
+    expect_identical (g0, g1)
+})
+
+
+test_that ("railway", {
+    expect_error (
+        g0 <- weight_streetnet (hampi, wt_profile = "rail"),
+        "Please use the weight_railway function for railway routing"
+    )
+    expect_error (
+        g0 <- weight_railway (hampi),
+        "Please specify type_col to be used for weighting railway"
+    )
+
+    expect_message (
+        g0 <- weight_railway (hampi, type_col = "highway"),
+        "Data has no columns named maxspeed"
+    )
+    expect_silent (g0 <- weight_railway (hampi,
+        type_col = "highway",
+        keep_cols = NULL
+    ))
+
+    expect_identical (g0$d, g0$d_weighted)
+})