fix test-dot.product.game

[maelle]

this is weird

  g2 <- sample_dot_product(vecs, directed = TRUE)
  g20 <- graph_from_literal(1:2:3:4, 1 - +3, 1 - +4, 3 - +4, 4 + -1, 4 + -3)
  expect_equal(g[], g20[], ignore_attr = TRUE)

• why define g2 and not use it directly afterwards
• why does expect_equivalent() pass but not expect_equal(ignore_attrs=TRUE)`

[maelle]

@schochastics for tomorrow

[schochastics]

aaah missed that in #1682 (Could do a catch all PR at the end with things I missed)

[schochastics]

just checked: These tests are actually wrong. g and g20 are not the same matrix!

Sparse Matrix entries from the Matrix package are interpreted by base::all.equal as attributes. So when we ignore attributes, it does not detect any issues. Matrix::all.equal does find the issues. To be consistent with how we do Matrix tests, we should use as_unnamed_dense_matrix() together with expect_equal(). Here is a minimal reprex

A <- Matrix::sparseMatrix(
  i = 1:5,
  j = 1:5,
  x = 1:5
)
A
#> 5 x 5 sparse Matrix of class "dgCMatrix"
#>               
#> [1,] 1 . . . .
#> [2,] . 2 . . .
#> [3,] . . 3 . .
#> [4,] . . . 4 .
#> [5,] . . . . 5

B <- Matrix::sparseMatrix(
  i = 1:5,
  j = 1:5,
  x = 5:1
)
B
#> 5 x 5 sparse Matrix of class "dgCMatrix"
#>               
#> [1,] 5 . . . .
#> [2,] . 4 . . .
#> [3,] . . 3 . .
#> [4,] . . . 2 .
#> [5,] . . . . 1
all.equal(A,B,check.attributes=TRUE)
#> [1] "Attributes: < Component \"x\": Mean relative difference: 1 >"
all.equal(A,B,check.attributes=FALSE)
#> [1] TRUE
Matrix::all.equal(A,B)
#> [1] "Mean relative difference: 1"

as_unnamed_dense_matrix <- function(x) {
  x <- as.matrix(x)
  dimnames(x) <- NULL
  x
}

testthat::expect_equal(as_unnamed_dense_matrix(A),as_unnamed_dense_matrix(B))
#> Error: as_unnamed_dense_matrix(A) not equal to as_unnamed_dense_matrix(B).
#> 4/25 mismatches (average diff: 3)
#> [1]  1 - 5 == -4
#> [7]  2 - 4 == -2
#> [19] 4 - 2 ==  2
#> [25] 5 - 1 ==  4

^{Created on 2025-02-19 with reprex v2.1.1}

[schochastics]

suggestion for a potentially more robust test

withr::local_seed(42)
latent_features <- cbind(
  c(0, 1, 1, 1, 0) / 3, c(0, 1, 1, 0, 1) / 3, c(1, 1, 1, 1, 0) / 4,
  c(0, 1, 1, 1, 0)
)
expected_probs <- t(latent_features)%*%latent_features
diag(expected_probs) <- 0
num_graphs <- 1000
edge_counts <- matrix(0, nrow = 4, ncol = 4)

for (i in seq_len(num_graphs)) {
    g <- sample_dot_product(latent_features)
    adj_matrix <- as_adjacency_matrix(g, sparse = FALSE)
    edge_counts <- edge_counts + adj_matrix
}
empirical_probs <- edge_counts / num_graphs
diag(empirical_probs) <- 0
tolerance <- 0.05
expect_true(all(abs(empirical_probs - expected_probs) < tolerance))

[github-actions]

This old thread has been automatically locked. If you think you have found something related to this, please open a new issue and link to this old issue if necessary.