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

refactor: adapt to cut.prob's new handling of NULL in the C core #1602

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

refactor: adapt to cut.prob's new handling of NULL in the C core #1602

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
43 changes: 26 additions & 17 deletions R/motifs.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ triad.census <- function(graph) { # nocov start
#' @inheritParams count_motifs
#' @keywords internal
#' @export
graph.motifs.no <- function(graph, size = 3, cut.prob = rep(0, size)) { # nocov start
graph.motifs.no <- function(graph, size = 3, cut.prob = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "graph.motifs.no()", "count_motifs()")
count_motifs(graph = graph, size = size, cut.prob = cut.prob)
} # nocov end
Expand All @@ -39,7 +39,7 @@ graph.motifs.no <- function(graph, size = 3, cut.prob = rep(0, size)) { # nocov
#' @inheritParams sample_motifs
#' @keywords internal
#' @export
graph.motifs.est <- function(graph, size = 3, cut.prob = rep(0, size), sample.size = vcount(graph) / 10, sample = NULL) { # nocov start
graph.motifs.est <- function(graph, size = 3, cut.prob = NULL, sample.size = vcount(graph) / 10, sample = NULL) { # nocov start
Copy link
Member

Choose a reason for hiding this comment

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

I think sample.size should default to NULL in this deprecated function as well, to match sample_motifs.

Do what you think is best, just drawing attention to this.

lifecycle::deprecate_soft("2.0.0", "graph.motifs.est()", "sample_motifs()")
sample_motifs(graph = graph, size = size, cut.prob = cut.prob, sample.size = sample.size, sample = sample)
} # nocov end
Expand All @@ -54,7 +54,7 @@ graph.motifs.est <- function(graph, size = 3, cut.prob = rep(0, size), sample.si
#' @inheritParams motifs
#' @keywords internal
#' @export
graph.motifs <- function(graph, size = 3, cut.prob = rep(0, size)) { # nocov start
graph.motifs <- function(graph, size = 3, cut.prob = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "graph.motifs()", "motifs()")
motifs(graph = graph, size = size, cut.prob = cut.prob)
} # nocov end
Expand Down Expand Up @@ -110,7 +110,8 @@ dyad.census <- function(graph) { # nocov start
#' directed graphs and sizes 3-6 in undirected graphs.
#' @param cut.prob Numeric vector giving the probabilities that the search
#' graph is cut at a certain level. Its length should be the same as the size
#' of the motif (the `size` argument). By default no cuts are made.
#' of the motif (the `size` argument).
#' If `NULL`, the default, no cuts are made.
#' @return `motifs()` returns a numeric vector, the number of occurrences of
#' each motif in the graph. The motifs are ordered by their isomorphism
#' classes. Note that for unconnected subgraphs, which are not considered to be
Expand All @@ -125,10 +126,12 @@ dyad.census <- function(graph) { # nocov start
#' motifs(g, 3)
#' count_motifs(g, 3)
#' sample_motifs(g, 3)
motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
motifs <- function(graph, size = 3, cut.prob = NULL) {
ensure_igraph(graph)
cut.prob <- as.numeric(cut.prob)
if (length(cut.prob) != size) {

if (!is.null(cut.prob)) cut.prob <- as.numeric(cut.prob)

if (!is.null(cut.prob) && length(cut.prob) != size) {
Copy link
Member

Choose a reason for hiding this comment

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

Please help me understand the code below. Is it repeating the last entry to fill up the vector until it reaches size?

What if it is longer than size? That should be an error (and I think the C core will take care of that, but I'd need to check).

Copy link
Member

Choose a reason for hiding this comment

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

This just errors:

motifs(make_ring(10), cut.prob=0.1)
Error in motifs(make_ring(10), cut.prob = 0.1) : 
  At vendor/cigraph/src/misc/motifs.c:156 : Cut probability vector size (0) must agree with motif size (3). Invalid value

Why does it not trigger the length(cut.prob) != size code path?

I think I'm just too tired for this right now :(

Copy link
Member

Choose a reason for hiding this comment

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

This code path is triggered, but it produces an incorrect vector.

I know this is not your code, but can you fix it @maelle ?

My recommendation is:

  1. Either go with what this code seems to intend, i.e. repeat the last element as many times as necessary to reach size.
  2. Or keep things simple and not repeat anything except a scalar. A scalar should be treated as a vector of identical elements of length size.

No preference as to which from my size (maybe 1 is a tiny bit nicer, but also overly complicated?)

Whatever you choose, can you document it? Also, can you make sure it's implemented in all motif functions, not just this one?

Copy link
Contributor Author

Choose a reason for hiding this comment

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

So do you mean

  • error if cut.prob is not of length either 1 or the same as size?
  • if it is of length 1, repeat it size times?

Copy link
Member

Choose a reason for hiding this comment

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

That is option 2.

Let me give examples for option 1 and option 2, assuming size == 4.

Option 1:

Input: 0.3, interpreted as 0.3 0.3 0.3 0.3

Input: 0.3 0.4, interpreted as 0.3 0.4 0.4 0.4

Input: 0.1 0.2 0.3 0.4 0.5 (longer than size 4), should trigger an error, which can be achieved by passing to the C core as-is

So, repeat the last entry to fill to size.

Option 2:

Input: 0.3, interpreted as 0.3 0.3 0.3 0.3

Input: 0.3 0.4, passed to the C core as-is, which will trigger an error.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

@krlmlr any opinion here?

cut.prob <- c(
cut.prob[-length(cut.prob)],
rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1)
Expand All @@ -138,7 +141,7 @@ motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_motifs_randesu, graph, as.numeric(size),
as.numeric(cut.prob)
cut.prob
)
res[is.nan(res)] <- NA
res
Expand All @@ -156,7 +159,8 @@ motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
#' @param size The size of the motif.
#' @param cut.prob Numeric vector giving the probabilities that the search
#' graph is cut at a certain level. Its length should be the same as the size
#' of the motif (the `size` argument). By default no cuts are made.
#' of the motif (the `size` argument).
#' If `NULL`, the default, no cuts are made.
#' @return `count_motifs()` returns a numeric scalar.
#' @seealso [isomorphism_class()]
#'
Expand All @@ -168,10 +172,12 @@ motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
#' motifs(g, 3)
#' count_motifs(g, 3)
#' sample_motifs(g, 3)
count_motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
count_motifs <- function(graph, size = 3, cut.prob = NULL) {
ensure_igraph(graph)
cut.prob <- as.numeric(cut.prob)
if (length(cut.prob) != size) {

if (!is.null(cut.prob)) cut.prob <- as.numeric(cut.prob)

if (!is.null(cut.prob) && length(cut.prob) != size) {
cut.prob <- c(
cut.prob[-length(cut.prob)],
rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1)
Expand All @@ -181,7 +187,7 @@ count_motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
on.exit(.Call(R_igraph_finalizer))
.Call(
R_igraph_motifs_randesu_no, graph, as.numeric(size),
as.numeric(cut.prob)
cut.prob
)
}

Expand All @@ -198,7 +204,8 @@ count_motifs <- function(graph, size = 3, cut.prob = rep(0, size)) {
#' in directed graphs and sizes 3-6 in undirected graphs.
#' @param cut.prob Numeric vector giving the probabilities that the search
#' graph is cut at a certain level. Its length should be the same as the size
#' of the motif (the `size` argument). By default no cuts are made.
#' of the motif (the `size` argument).
#' If `NULL`, the default, no cuts are made.
#' @param sample.size The number of vertices to use as a starting point for
#' finding motifs. Only used if the `sample` argument is `NULL`.
#' The default is `ceiling(vcount(graph) / 10)` .
Expand All @@ -224,8 +231,10 @@ sample_motifs <- function(
sample = NULL
) {
ensure_igraph(graph)
cut.prob <- as.numeric(cut.prob)
if (length(cut.prob) != size) {

if (!is.null(cut.prob)) cut.prob <- as.numeric(cut.prob)

if (!is.null(cut.prob) && length(cut.prob) != size) {
cut.prob <- c(
cut.prob[-length(cut.prob)],
rep(cut.prob[-length(cut.prob)], length(cut.prob) - 1)
Expand All @@ -244,7 +253,7 @@ sample_motifs <- function(
on.exit(.Call(R_igraph_finalizer))
.Call(
R_igraph_motifs_randesu_estimate, graph, as.numeric(size),
as.numeric(cut.prob), as.numeric(sample.size), sample
cut.prob, as.numeric(sample.size), sample
)
}

Expand Down
5 changes: 3 additions & 2 deletions man/count_motifs.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 3 additions & 2 deletions man/graph.motifs.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 3 additions & 2 deletions man/graph.motifs.est.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 3 additions & 2 deletions man/graph.motifs.no.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 2 additions & 1 deletion man/sample_motifs.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

16 changes: 8 additions & 8 deletions tests/testthat/test-motifs.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,15 +10,15 @@ test_that("motif finding works", {
mno2 <- count_motifs(b, cut.prob = c(0, 1 / 3, 0))
expect_equal(
c(mno0 / mno, mno1 / mno, mno2 / mno),
c(0.654821903845065, 0.666289144345659, 0.668393831285275)
c(0.674541153079009, 0.666138135417257, 0.665968250372803)
)

mno3 <- count_motifs(b, cut.prob = c(0, 1 / 3, 1 / 3))
mno4 <- count_motifs(b, cut.prob = c(1 / 3, 0, 1 / 3))
mno5 <- count_motifs(b, cut.prob = c(1 / 3, 1 / 3, 0))
expect_equal(
c(mno3 / mno, mno4 / mno, mno5 / mno),
c(0.443959957465819, 0.441952797125797, 0.446004870037941)
c(0.441707407617142, 0.445633639755617, 0.440527650363994)
)

######################
Expand All @@ -31,18 +31,18 @@ test_that("motif finding works", {
m0 <- motifs(b, cut.prob = c(1 / 3, 0, 0))
m1 <- motifs(b, cut.prob = c(0, 1 / 3, 0))
m2 <- motifs(b, cut.prob = c(0, 0, 1 / 3))
expect_equal(m0 / m, c(NA, NA, 0.653972107372707, NA, 0.653993015279859, 0.612244897959184, 0.657514670174019, 0.63013698630137, NaN, 0.538461538461538, NaN, 0.565217391304348, NaN, NaN, NaN, NaN))
expect_equal(m1 / m, c(NA, NA, 0.669562138856225, NA, 0.66808158454082, 0.73469387755102, 0.670819000404694, 0.657534246575342, NaN, 0.769230769230769, NaN, 0.739130434782609, NaN, NaN, NaN, NaN))
expect_equal(m2 / m, c(NA, NA, 0.666451718949538, NA, 0.665291458452201, 0.591836734693878, 0.666683528935654, 0.671232876712329, NaN, 0.753846153846154, NaN, 0.565217391304348, NaN, NaN, NaN, NaN))
expect_equal(m0 / m, c(NA, NA, 0.672381747145621, NA, 0.674984795380304, 0.63265306122449, 0.675738567381627, 0.698630136986301, NaN, 0.784615384615385, NaN, 0.608695652173913, NaN, NaN, NaN, NaN))
expect_equal(m1 / m, c(NA, NA, 0.66650229488298, NA, 0.666263300123518, 0.63265306122449, 0.66845406717928, 0.671232876712329, NaN, 0.6, NaN, 0.695652173913043, NaN, NaN, NaN, NaN))
expect_equal(m2 / m, c(NA, NA, 0.663265435142687, NA, 0.667442050021631, 0.653061224489796, 0.666278834479968, 0.657534246575342, NaN, 0.661538461538462, NaN, 0.652173913043478, NaN, NaN, NaN, NaN))

m3 <- motifs(b, cut.prob = c(0, 1 / 3, 1 / 3))
m4 <- motifs(b, cut.prob = c(1 / 3, 1 / 3, 0))
m5 <- motifs(b, cut.prob = c(1 / 3, 1 / 3, 0))
expect_equal(m3 / m, c(NA, NA, 0.445611905574732, NA, 0.442789875290769, 0.448979591836735, 0.444695973290166, 0.424657534246575, NaN, 0.369230769230769, NaN, 0.608695652173913, NaN, NaN, NaN, NaN))
expect_equal(m3 / m, c(NA, NA, 0.439062322193984, NA, 0.441742794264253, 0.408163265306122, 0.44431657223796, 0.438356164383562, NaN, 0.415384615384615, NaN, 0.478260869565217, NaN, NaN, NaN, NaN))

expect_equal(m4 / m, c(NA, NA, 0.439251981944392, NA, 0.439284975327761, 0.73469387755102, 0.445088021044112, 0.465753424657534, NaN, 0.630769230769231, NaN, 0.565217391304348, NaN, NaN, NaN, NaN))
expect_equal(m4 / m, c(NA, NA, 0.439770385262173, NA, 0.441040560282398, 0.224489795918367, 0.438752023472278, 0.534246575342466, NaN, 0.430769230769231, NaN, 0.391304347826087, NaN, NaN, NaN, NaN))

expect_equal(m5 / m, c(NA, NA, 0.439985332979302, NA, 0.440288166730411, 0.346938775510204, 0.44159753136382, 0.452054794520548, NaN, 0.323076923076923, NaN, 0.347826086956522, NaN, NaN, NaN, NaN))
expect_equal(m5 / m, c(NA, NA, 0.444436015122204, NA, 0.445736750036052, 0.489795918367347, 0.445353601780656, 0.575342465753425, NaN, 0.415384615384615, NaN, 0.347826086956522, NaN, NaN, NaN, NaN))
})

test_that("sample_motifs works", {
Expand Down
Loading