diff --git a/DESCRIPTION b/DESCRIPTION index 319a20c..d170067 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/create-road-network.R b/R/create-road-network.R index 34ab7b4..432f2ff 100644 --- a/R/create-road-network.R +++ b/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, ...) + ) +} diff --git a/man/pavement-package.Rd b/man/pavement-package.Rd index 35fbb5a..ecc0c63 100644 --- a/man/pavement-package.Rd +++ b/man/pavement-package.Rd @@ -20,15 +20,15 @@ Useful links: } \author{ -\strong{Maintainer}: Keisuke Ando \email{ando@maslab.aitech.ac.jp} +\strong{Maintainer}: Keisuke ANDO \email{ando@maslab.aitech.ac.jp} (0009-0002-4085-2067) Other contributors: \itemize{ - \item Takeshi Uchitane [thesis advisor] - \item Naoto Mukai [thesis advisor] - \item Kazunori Iwata [thesis advisor] - \item Nobuhiro Ito [thesis advisor] - \item Yong Jiang [thesis advisor] + \item Takeshi UCHITANE [thesis advisor] + \item Naoto MUKAI [thesis advisor] + \item Kazunori IWATA [thesis advisor] + \item Nobuhiro ITO [thesis advisor] + \item Yong JIANG [thesis advisor] } } diff --git a/man/road_network.Rd b/man/road_network.Rd index fb09f2c..fe16f52 100644 --- a/man/road_network.Rd +++ b/man/road_network.Rd @@ -27,6 +27,8 @@ as intersections between roads and endpoints of road segments. \examples{ # Create the road network road_network <- create_road_network(sample_roads) + +# Print the road network summary road_network # Plot the road network diff --git a/tests/testthat/test-create-road-network.R b/tests/testthat/test-create-road-network.R new file mode 100644 index 0000000..19b744d --- /dev/null +++ b/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") +}) diff --git a/tests/testthat/test-create-spatiotemporal-event.R b/tests/testthat/test-create-spatiotemporal-event.R index 53b8eb9..aab08bf 100644 --- a/tests/testthat/test-create-spatiotemporal-event.R +++ b/tests/testthat/test-create-spatiotemporal-event.R @@ -1,6 +1,7 @@ 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") @@ -8,15 +9,13 @@ test_that("`create_spatiotemporal_event` works with valid input", { 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") })