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 4 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
78 changes: 24 additions & 54 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,21 @@ 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("Please give both source and target or neither")
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

}
schochastics marked this conversation as resolved.
Show resolved Hide resolved

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 +423,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 +433,7 @@ 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("Either give both source and target or neither")
}
schochastics marked this conversation as resolved.
Show resolved Hide resolved
}

Expand Down Expand Up @@ -534,13 +520,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 +530,17 @@ 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("Either give both source and target or neither")
}
schochastics marked this conversation as resolved.
Show resolved Hide resolved
}

#' @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 +552,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 +608,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 +663,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 +716,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,10 +728,10 @@ st_min_cuts <- all_st_mincuts_impl
#' @export
dominator_tree <- function(graph, root, mode = c("out", "in", "all", "total")) {
# Argument checks
ensure_igraph(graph)
ensure_igraph(graph)
root <- as_igraph_vs(graph, root)
if (length(root) == 0) {
stop("No vertex was specified")
cli::cli_abort("No vertex was specified")
}
schochastics marked this conversation as resolved.
Show resolved Hide resolved
mode <- switch(igraph.match.arg(mode),
"out" = 1,
Expand Down
2 changes: 1 addition & 1 deletion .../testthat/_snaps/minimal.st.separators.md → tests/testthat/_snaps/flow.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
# min_st_separators() works for the note case

Code
min_st_separators(g)
min_st_separators(g_note)
Output
[[1]]
+ 1/5 vertex, named, from something
Expand Down
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.

39 changes: 0 additions & 39 deletions tests/testthat/test-edge.connectivity.R
View file
Open in desktop

This file was deleted.

Loading
Loading