✅ Add test case for class of road network

DESCRIPTION

@@ -2,13 +2,15 @@ Package: pavement
 Title: Analyzing Spatial Events on Roadways
 Version: 0.0.1
 Authors@R: c( 
-    person("Keisuke", "Ando", , "ando@maslab.aitech.ac.jp",
-           role = c("aut", "cre")),
-    person("Takeshi", "Uchitane", role = "ths"),
-    person("Naoto", "Mukai", role = "ths"),
-    person("Kazunori", "Iwata", role = "ths"),
-    person("Nobuhiro", "Ito", role = "ths"),
-    person("Yong", "Jiang", role = "ths")
+    person("Keisuke", "ANDO",
+           email   = "ando@maslab.aitech.ac.jp",
+           role    = c("aut", "cre"),
+           comment = c(OCRID = "0009-0002-4085-2067")),
+    person("Takeshi", "UCHITANE", role = "ths"),
+    person("Naoto", "MUKAI", role = "ths"),
+    person("Kazunori", "IWATA", role = "ths"),
+    person("Nobuhiro", "ITO", role = "ths"),
+    person("Yong", "JIANG", role = "ths")
   )
 Description: Pavement is a package designed to analyze spatial events
     occurring on roadways. It provides a comprehensive toolkit for

R/create-road-network.R

@@ -15,6 +15,8 @@
 #' @examples
 #' # Create the road network
 #' road_network <- create_road_network(sample_roads)
+#'
+#' # Print the road network summary
 #' road_network
 #'
 #' # Plot the road network
@@ -80,24 +82,6 @@ print.road_network <- function(x, ...) {
   }
 }
 
-#' @export
-plot.road_network <- function(x, y, mode = c("default", "event"), ...) {
-  # Match the mode argument
-  mode <- match.arg(mode)
-
-  # Check if events are assigned to the road network
-  if (mode == "event" && !("events" %in% names(x))) {
-    stop("no events assigned to the road network")
-  }
-
-  plot(x$links$geometry, lwd = 1, ...)
-  if (mode == "event") {
-    plot(x$events$geometry, cex = 1, pch = 4, col = "red", add = TRUE, ...)
-  } else {
-    plot(x$nodes$geometry, cex = 1, pch = 16, add = TRUE, ...)
-  }
-}
-
 #' @export
 summary.road_network <- function(object, ...) {
   cat("Road network summary\n")
@@ -107,3 +91,27 @@ summary.road_network <- function(object, ...) {
     cat("Number of events: ", nrow(object$events), "\n")
   }
 }
+
+#' @export
+plot.road_network <- function(x, y, mode = c("default", "graph", "event"), ...) {
+  # Match the mode argument
+  mode <- match.arg(mode)
+
+  # Base plot of road network links
+  if (mode != "graph") {
+    plot(x$links$geometry, lwd = 1, ...)
+  }
+
+  # Handle different plot modes
+  switch(
+    mode,
+    "event" = {
+      if (!("events" %in% names(x))) {
+        stop("no events assigned to the road network")
+      }
+      plot(x$events$geometry, cex = 1, pch = 4, col = "red", add = TRUE, ...)
+    },
+    "graph" = plot(x$graph, ...),
+    "default" = plot(x$nodes$geometry, cex = 1, pch = 16, add = TRUE, ...)
+  )
+}

tests/testthat/test-create-road-network.R

@@ -0,0 +1,81 @@
+test_that("`create_road_network.sf` works with valid input", {
+  road_network <- create_road_network(sample_roads)
+
+  # Check the structure of the road network
+  expect_s3_class(road_network, "road_network")
+  expect_contains(names(road_network), c("graph", "nodes", "links", "roads"))
+  expect_equal(nrow(road_network$nodes), 10)
+  expect_equal(nrow(road_network$links), 10)
+
+  # Check the directed property
+  expect_false(is_directed(road_network$graph))
+
+  # Check the plot function
+  expect_silent(plot(road_network))
+})
+
+test_that("`create_road_network.sf` works with directed input", {
+  road_network <- create_road_network(sample_roads, directed = TRUE)
+
+  # Check the structure of the road network
+  expect_s3_class(road_network, "road_network")
+  expect_contains(names(road_network), c("graph", "nodes", "links", "roads"))
+  expect_equal(nrow(road_network$nodes), 10)
+  expect_equal(nrow(road_network$links), 10)
+
+  # Check the directed property
+  expect_true(is_directed(road_network$graph))
+
+  # Check the plot function
+  expect_silent(plot(road_network, mode = "graph"))
+})
+
+test_that("`create_road_network.sf` works with events", {
+  road_network <- create_road_network(sample_roads, events = sample_accidents)
+
+  # Check the structure of the road network
+  expect_s3_class(road_network, "road_network")
+  expect_contains(names(road_network),
+                  c("graph", "nodes", "links", "roads", "events"))
+  expect_equal(nrow(road_network$nodes), 10)
+  expect_equal(nrow(road_network$links), 10)
+  expect_equal(nrow(road_network$events), 10)
+
+  # Check the plot function
+  expect_silent(plot(road_network, mode = "event"))
+})
+
+test_that("`print.road_network` works", {
+  road_network <- create_road_network(sample_roads)
+
+  # Check the print function
+  expect_output(print(road_network), "Road network")
+  expect_output(print(road_network), "Nodes:")
+  expect_output(print(road_network), "Links:")
+})
+
+test_that("`summary.road_network` works", {
+  road_network <- create_road_network(sample_roads)
+
+  # Check the summary function
+  expect_output(summary(road_network), "Road network summary")
+  expect_output(summary(road_network), "Number of nodes")
+  expect_output(summary(road_network), "Number of links")
+})
+
+test_that("`summary.road_network` works", {
+  road_network <- create_road_network(sample_roads)
+
+  # Check the summary function
+  expect_output(summary(road_network), "Road network summary")
+  expect_output(summary(road_network), "Number of nodes")
+  expect_output(summary(road_network), "Number of links")
+})
+
+test_that("`plot.road_network` throw error with event mode and no events", {
+  road_network <- create_road_network(sample_roads)
+
+  # Check the plot function
+  expect_error(plot(road_network, mode = "event"),
+               "no events assigned to the road network")
+})

tests/testthat/test-create-spatiotemporal-event.R

@@ -1,22 +1,21 @@
 test_that("`create_spatiotemporal_event` works with valid input", {
   spatiotemporal_events <- create_spatiotemporal_event(sample_accidents)
 
+  # Check the structure of the spatiotemporal events
   expect_s3_class(spatiotemporal_events, "spatiotemporal_event")
   expect_equal(attr(spatiotemporal_events, "time_column"), "time")
   expect_equal(attr(spatiotemporal_events, "time_format"), "%H")
 })
 
 test_that("`print.spatiotemporal_event` prints the correct information", {
   spatiotemporal_events <- create_spatiotemporal_event(sample_accidents)
-  output <- capture.output(print(spatiotemporal_events))
 
-  expect_equal(output[1],
-               "Spatiotemporal event collection with 10 events and 3 fields")
-  expect_equal(output[2], "Geometry type: POINT")
-  expect_equal(output[3], "Time column:   time")
-  expect_equal(output[4], "Time format:   %H")
-  expect_equal(output[5], "Data:")
-  expect_equal(output[7], "1 ac_0001   18   Sunny    Minor     POINT (1 1)")
-  expect_equal(output[11], "5 ac_0005    7   Rainy    Minor POINT (5.9 1.1)")
-  expect_equal(output[12], "... 5 more events")
+  # Check the print function
+  expect_output(print(spatiotemporal_events),
+                "Spatiotemporal event collection with 10 events and 3 fields")
+  expect_output(print(spatiotemporal_events), "Geometry type: POINT")
+  expect_output(print(spatiotemporal_events), "Time column:   time")
+  expect_output(print(spatiotemporal_events), "Time format:   %H")
+  expect_output(print(spatiotemporal_events), "Data:")
+  expect_output(print(spatiotemporal_events), "\\.\\.\\. 5 more events")
 })