Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

test: merged and refactored flow.R tests #1675

Open
wants to merge 8 commits into
base: main
Choose a base branch
from
Open

test: merged and refactored flow.R tests #1675

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
1064771
merged and refactored flow.R tests
schochastics Feb 8, 2025
76dcbdd
fixed failing tests
schochastics Feb 10, 2025
3bf022a
added more error tests
schochastics Feb 10, 2025
ba73938
added better R error handling
schochastics Feb 10, 2025
b11a3c9
fixed cli calls
schochastics Feb 13, 2025
f3ab2c5
fixed test names
schochastics Feb 13, 2025
ce6cb74
converted error tests to snapshot tests
schochastics Feb 13, 2025
3dedcab
fixed dominator_tree tests
schochastics Feb 13, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 37 additions & 56 deletions R/flow.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

#' Vertex connectivity
#'
#' @description
Expand Down Expand Up @@ -287,27 +286,24 @@ dominator.tree <- function(graph, root, mode = c("out", "in", "all", "total")) {
#' @export
min_cut <- function(graph, source = NULL, target = NULL, capacity = NULL, value.only = TRUE) {
ensure_igraph(graph)
if (is.null(capacity)) {
if ("capacity" %in% edge_attr_names(graph)) {
capacity <- E(graph)$capacity
}
}
if (length(source) == 0) {
source <- NULL
if (is.null(capacity) && "capacity" %in% edge_attr_names(graph)) {
capacity <- E(graph)$capacity
}
if (length(target) == 0) {
target <- NULL
}
if (is.null(source) && !is.null(target) ||
is.null(target) && !is.null(source)) {
stop("Please give both source and target or neither")

if (xor(is.null(source), is.null(target))) {
cli::cli_abort(c(
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

OMG I did not know about xor()! 🤯

Could you explain why we should use it instead of the operator directly?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The only reason I had to switch to it was that it is shorter and expresses what we want more clearly.

xor
#> function (x, y) 
#> {
#>     (x | y) & !(x & y)
#> }
#> <bytecode: 0x10697add8>
#> <environment: namespace:base>

But now I am note sure if it is 100% ok to use, given that it uses single | and &? Could this be an issue? I think not

"{.arg source} and {.arg target} must not be specified at the same time.",
i = "Specify either {.arg source} or {.arg target} or neither."
))
}

if (!is.null(capacity)) {
capacity <- as.numeric(capacity)
}

value.only <- as.logical(value.only)
on.exit(.Call(R_igraph_finalizer))

if (is.null(target) && is.null(source)) {
if (value.only) {
res <- .Call(R_igraph_mincut_value, graph, capacity)
Expand Down Expand Up @@ -430,13 +426,6 @@ min_cut <- function(graph, source = NULL, target = NULL, capacity = NULL, value.
vertex_connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) {
ensure_igraph(graph)

if (length(source) == 0) {
source <- NULL
}
if (length(target) == 0) {
target <- NULL
}

if (is.null(source) && is.null(target)) {
on.exit(.Call(R_igraph_finalizer))
.Call(R_igraph_vertex_connectivity, graph, as.logical(checks))
Expand All @@ -447,7 +436,10 @@ vertex_connectivity <- function(graph, source = NULL, target = NULL, checks = TR
as_igraph_vs(graph, target) - 1
)
} else {
stop("either give both source and target or neither")
cli::cli_abort(c(
"{.arg source} and {.arg target} must not be specified at the same time.",
i = "Specify either {.arg source} or {.arg target} or neither."
))
}
}

Expand Down Expand Up @@ -534,13 +526,6 @@ vertex_connectivity <- function(graph, source = NULL, target = NULL, checks = TR
edge_connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE) {
ensure_igraph(graph)

if (length(source) == 0) {
source <- NULL
}
if (length(target) == 0) {
target <- NULL
}

if (is.null(source) && is.null(target)) {
on.exit(.Call(R_igraph_finalizer))
.Call(R_igraph_edge_connectivity, graph, as.logical(checks))
Expand All @@ -551,22 +536,20 @@ edge_connectivity <- function(graph, source = NULL, target = NULL, checks = TRUE
as_igraph_vs(graph, source) - 1, as_igraph_vs(graph, target) - 1
)
} else {
stop("either give both source and target or neither")
cli::cli_abort(c(
"{.arg source} and {.arg target} must not be specified at the same time.",
i = "Specify either {.arg source} or {.arg target} or neither."
))
}
}

#' @rdname edge_connectivity
#' @export
edge_disjoint_paths <- function(graph, source, target) {
edge_disjoint_paths <- function(graph, source = NULL, target = NULL) {
ensure_igraph(graph)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

why change the default value especially if the code won't work with it?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

is it to align it with the function below?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes this was just to align the code with the rest. But I don't mind changing it back if you think it is better to leave it untouched


if (length(source) == 0) {
source <- NULL
}
if (length(target) == 0) {
target <- NULL
if (is.null(source) || is.null(target)) {
cli::cli_abort("Both source and target must be given")
}

on.exit(.Call(R_igraph_finalizer))
.Call(
R_igraph_edge_disjoint_paths, graph,
Expand All @@ -578,12 +561,8 @@ edge_disjoint_paths <- function(graph, source, target) {
#' @export
vertex_disjoint_paths <- function(graph, source = NULL, target = NULL) {
ensure_igraph(graph)

if (length(source) == 0) {
source <- NULL
}
if (length(target) == 0) {
target <- NULL
if (is.null(source) || is.null(target)) {
cli::cli_abort("Both source and target must be given")
}

on.exit(.Call(R_igraph_finalizer))
Expand Down Expand Up @@ -638,13 +617,13 @@ cohesion.igraph <- function(x, checks = TRUE, ...) {
#' @examples
#'
#' # A very simple graph
#' g <- graph_from_literal(a -+ b -+ c -+ d -+ e)
#' g <- graph_from_literal(a - +b - +c - +d - +e)
#' st_cuts(g, source = "a", target = "e")
#'
#' # A somewhat more difficult graph
#' g2 <- graph_from_literal(
#' s --+ a:b, a:b --+ t,
#' a --+ 1:2:3, 1:2:3 --+ b
#' s - -+a:b, a:b - -+t,
#' a - -+1:2:3, 1:2:3 - -+b
#' )
#' st_cuts(g2, source = "s", target = "t")
#' @family flow
Expand Down Expand Up @@ -693,8 +672,8 @@ st_cuts <- all_st_cuts_impl
#'
#' # A difficult graph, from the Provan-Shier paper
#' g <- graph_from_literal(
#' s --+ a:b, a:b --+ t,
#' a --+ 1:2:3:4:5, 1:2:3:4:5 --+ b
#' s - -+a:b, a:b - -+t,
#' a - -+1:2:3:4:5, 1:2:3:4:5 - -+b
#' )
#' st_min_cuts(g, source = "s", target = "t")
#' @family flow
Expand Down Expand Up @@ -746,9 +725,9 @@ st_min_cuts <- all_st_mincuts_impl
#'
#' ## The example from the paper
#' g <- graph_from_literal(
#' R -+ A:B:C, A -+ D, B -+ A:D:E, C -+ F:G, D -+ L,
#' E -+ H, F -+ I, G -+ I:J, H -+ E:K, I -+ K, J -+ I,
#' K -+ I:R, L -+ H
#' R - +A:B:C, A - +D, B - +A:D:E, C - +F:G, D - +L,
#' E - +H, F - +I, G - +I:J, H - +E:K, I - +K, J - +I,
#' K - +I:R, L - +H
#' )
#' dtree <- dominator_tree(g, root = "R")
#' layout <- layout_as_tree(dtree$domtree, root = "R")
Expand All @@ -758,11 +737,13 @@ st_min_cuts <- all_st_mincuts_impl
#' @export
dominator_tree <- function(graph, root, mode = c("out", "in", "all", "total")) {
# Argument checks
ensure_igraph(graph)
root <- as_igraph_vs(graph, root)
if (length(root) == 0) {
stop("No vertex was specified")
ensure_igraph(graph)

if (missing(root) || is.null(root)) {
cli::cli_abort("{.arg root} must be specified.")
}
root <- as_igraph_vs(graph, root)

mode <- switch(igraph.match.arg(mode),
"out" = 1,
"in" = 2,
Expand Down
116 changes: 116 additions & 0 deletions tests/testthat/_snaps/flow.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,116 @@
# st_cuts errors work

Code
st_cuts(g_path, source = "a", target = NULL)
Condition
Error in `st_cuts()`:
! No vertex was specified

---

Code
st_cuts(g_path, source = NULL, target = "a")
Condition
Error in `st_cuts()`:
! No vertex was specified

---

Code
st_min_cuts(g_path, source = "a", target = NULL)
Condition
Error in `st_min_cuts()`:
! No vertex was specified

---

Code
st_min_cuts(g_path, source = NULL, target = "a")
Condition
Error in `st_min_cuts()`:
! No vertex was specified

# vertex_connectivity error works

Code
vertex_connectivity(g_path, source = 1)
Condition
Error in `vertex_connectivity()`:
! `source` and `target` must not be specified at the same time.
i Specify either `source` or `target` or neither.

# edge_connectivity error works

Code
edge_connectivity(g_path, source = 1)
Condition
Error in `edge_connectivity()`:
! `source` and `target` must not be specified at the same time.
i Specify either `source` or `target` or neither.

# edge_disjoint_paths error works

Code
edge_disjoint_paths(g_path, source = 1, target = NULL)
Condition
Error in `edge_disjoint_paths()`:
! Both source and target must be given

---

Code
edge_disjoint_paths(g_path, source = NULL, target = 1)
Condition
Error in `edge_disjoint_paths()`:
! Both source and target must be given

# vertex_disjoint_paths error works

Code
vertex_disjoint_paths(g_path, source = 1)
Condition
Error in `vertex_disjoint_paths()`:
! Both source and target must be given

---

Code
vertex_disjoint_paths(g_path, source = 1)
Condition
Error in `vertex_disjoint_paths()`:
! Both source and target must be given

# dominator_tree errors work

Code
dominator_tree(g_tree)
Condition
Error in `dominator_tree()`:
! `root` must be specified.

---

Code
dominator_tree(g_tree, root = NULL)
Condition
Error in `dominator_tree()`:
! `root` must be specified.

# min_st_separators() works for the note case

Code
min_st_separators(g_note)
Output
[[1]]
+ 1/5 vertex, named, from something
[1] 1

[[2]]
+ 2/5 vertices, named, from something
[1] 2 4

[[3]]
+ 2/5 vertices, named, from something
[1] 1 3


18 changes: 0 additions & 18 deletions tests/testthat/_snaps/minimal.st.separators.md
View file
Open in desktop

This file was deleted.

21 changes: 0 additions & 21 deletions tests/testthat/test-all.st.cuts.R
View file
Open in desktop

This file was deleted.

6 changes: 0 additions & 6 deletions tests/testthat/test-bug-1033045.R
View file
Open in desktop

This file was deleted.

21 changes: 0 additions & 21 deletions tests/testthat/test-dominator.tree.R
View file
Open in desktop

This file was deleted.

Loading
Loading