tests/testthat/test-streetnet.R

In dodgr: Distances on Directed Graphs

context ("dodgr streetnet")

dodgr_cache_off ()
clear_dodgr_cache ()

test_all <- (identical (Sys.getenv ("MPADGE_LOCAL"), "true") |
    identical (Sys.getenv ("GITHUB_WORKFLOW"), "test-coverage"))
# used below in a skip_if call

test_that ("streetnet bbox", {

    set.seed (1)
    n <- 12
    bbox <- cbind (runif (n), 2 * runif (n))
    bb <- process_bbox (bbox, NULL, 0)
    expect_is (bb, "list")
    expect_length (bb, 2)
    expect_equal (nrow (bb$bbox), 2)
    expect_equal (nrow (bb$bbox_poly), n)

    bbox2 <- apply (bbox, 2, range)
    bb2 <- process_bbox (bbox2, NULL, 0)
    expect_identical (bb$bbox, bb2$bbox)

    rownames (bbox2) <- c ("min", "max")
    colnames (bbox2) <- c ("x", "y")
    expect_silent (bb3 <- process_bbox (bbox2, NULL, 0))
    expect_true (!identical (bb2, bb3))

    colnames (bbox) <- c ("x", "y")
    bb4 <- process_bbox (bbox, expand = 0)
    expect_identical (bb$bbox, bb4$bbox)

    # causes bbox to be tranposed:
    colnames (bbox) <- c ("min", "max")
    bb5 <- process_bbox (bbox, expand = 0)
    expect_identical (bb$bbox, bb5$bbox)

    expect_silent (bb2 <- process_bbox (list (bbox), NULL, 0))
    expect_true (!identical (bb, bb2))

    bbox <- list (matrix (letters [ceiling (runif (n) * 26)],
        ncol = 2
    ))
    expect_error (
        bb <- process_bbox (bbox, NULL, 0),
        "bbox is a list, so items must be numeric"
    )
    bbox <- runif (6)
    expect_error (
        bb <- process_bbox (bbox, NULL, 0),
        "bbox must have four numeric values"
    )

    bbox <- bbox [1:4]
    expect_silent (bb <- process_bbox (bbox, NULL, 0))

    expect_error (
        bb <- process_bbox (pts = NULL),
        "Either bbox or pts must be specified"
    )
})

test_that ("streetnet pts", {

    set.seed (1)
    n <- 12
    pts <- cbind (runif (n), 2 * runif (n))
    expect_error (
        bb <- process_bbox (pts = pts, expand = 0),
        paste0 (
            "Can not unambiguously determine ",
            "coordinates in graph"
        )
    )

    colnames (pts) <- c ("x", "y")
    expect_silent (bb <- process_bbox (pts = pts, expand = 0))
    # This gives wrong result:
    expect_silent (bb2 <- process_bbox (bbox = pts, expand = 0))
    expect_true (!identical (bb$bbox, bb2$bbox))
})


test_that ("streetnet column names", {

    h <- hampi
    h$geometry <- NULL
    expect_error (graph <- weight_streetnet (h))
    # error with no sf is: "Unable to determine geometry column", but with sf, h
    # is de-classes, so error is "Unknown class"

    h <- hampi
    h$osm_id <- NULL
    expect_message (
        graph <- weight_streetnet (h),
        paste0 (
            "x appears to have no ID column; ",
            "sequential edge numbers will be used"
        )
    )
    expect_true ("way_id" %in% names (graph))

    names (h$geometry) <- NULL
    expect_message (
        graph <- weight_streetnet (h),
        paste0 (
            "x appears to have no ID column; ",
            "sequential edge numbers will be used"
        )
    )
    expect_true ("way_id" %in% names (graph))

    h <- hampi
    names (h) [names (h) == "osm_id"] <- "id1"
    h$id2 <- h$id1
    expect_error (
        graph <- weight_streetnet (h),
        "Multiple potential ID columns"
    )

    h <- hampi
    h$geom <- 1
    expect_error (
        graph <- weight_streetnet (h),
        "Unable to determine geometry column"
    )

    skip_if (!test_all)

    h <- hampi
    h$geometry1 <- 1
    expect_silent (graph <- weight_streetnet (h))

    h <- hampi
    osm_id <- h$osm_id
    h$osm_id <- NULL
    h$osm_id <- osm_id
    expect_silent (graph <- weight_streetnet (h))

    graph0 <- weight_streetnet (hampi, wt_profile = "bicycle")
    # add some fake oneway paths:
    h <- hampi
    index <- which (hampi$highway == "path")
    index <- index [sample (length (index) / 2)]
    h$oneway [index] <- "yes"
    graph1 <- weight_streetnet (h, wt_profile = "bicycle")
    expect_true (nrow (graph1) < nrow (graph0))

    h ["oneway.bicycle"] <- h$oneway
    h [["oneway.bicycle"]] [index] <- "yes"
    graph2 <- weight_streetnet (h, wt_profile = "bicycle")
    expect_true (nrow (graph2) == nrow (graph1))

    h ["oneway.bicycle"] <- NULL
    h ["oneway:bicycle"] <- h$oneway
    h [["oneway:bicycle"]] [index] <- "yes"
    graph3 <- weight_streetnet (h, wt_profile = "bicycle")
    expect_identical (nrow (graph2), nrow (graph3))

    # change "oneway", but with wt_profile == "bicycle", only "oneway*bicycle"
    # should affect result:
    index <- which (hampi$highway == "path")
    index <- index [sample (length (index) / 2)]
    h$oneway <- ""
    h$oneway [index] <- "yes"
    graph4 <- weight_streetnet (h, wt_profile = "bicycle")
    expect_identical (nrow (graph2), nrow (graph4))
})

test_that ("wt_profile", {
    expect_silent (graph <- weight_streetnet (hampi, wt_profile = 1))
    expect_identical (graph$d, graph$d_weighted)
})

test_that ("streetnet highway types", {
    # these are based on partial matches, so modifications to highway types
    # sholuld have no effect:
    graph0 <- weight_streetnet (hampi)
    n <- 10
    index <- sample (nrow (hampi), n)
    h <- hampi
    h$highway [index] <- paste0 (h$highway [index], sample (letters, n))
    graph <- weight_streetnet (h)

    expect_identical (table (graph$highway), table (graph0$highway))

    h$highway [sample (nrow (h), 1)] <- "invalid_type"
    expect_message (
        graph <- weight_streetnet (h),
        "The following highway types are present in data yet lack"
    )
})

test_that ("hash generation", {
    skip_on_cran ()
    # The following test fails on GitHub windows machines for some reason?
    is_windows <- Sys.info () [["sysname"]] == "Windows"
    if (!is_windows) {

        graph <- weight_streetnet (hampi)
        graphc <- dodgr_contract_graph (graph)
        attr (graph, "hash") <- NULL
        graphc2 <- dodgr_contract_graph (graph)
        expect_identical (graphc, graphc2)
    }
})

test_that ("streetnet times", {
    expect_error (
        graph <- weight_streetnet (hampi,
            turn_penalty = TRUE
        ),
        paste0 (
            "Turn-penalty calculations only currently ",
            "implemented for street network data ",
            "generated with"
        )
    )
    expect_silent (graph <- weight_streetnet (hampi))
    h <- hampi
    names (h) [names (h) == "osm_id"] <- "id"
    expect_silent (graph2 <- weight_streetnet (h, id_col = "id"))
    attr (graph, "px") <- NULL
    attr (graph2, "px") <- NULL
    expect_identical (graph, graph2)

    h$id <- NULL
    msg <- paste (
        "x appears to have no ID column;",
        "sequential edge numbers will be used."
    )
    expect_message (graph3 <- weight_streetnet (h), msg)

    h <- hampi
    names (h$geometry) <- NULL
    graph4 <- weight_streetnet (h)
    expect_identical (graph$edge_id, seq (nrow (graph)))

    h$oneway_bicycle <- h$oneway
    graph5 <- weight_streetnet (h)
    attr (graph4, "px") <- NULL
    attr (graph5, "px") <- NULL
    expect_identical (graph5, graph4)

    expect_error (
        weight_streetnet (hampi,
            wt_profile = list (1)
        ),
        "Custom named profiles must be vectors"
    )
})