test_that("`authority_score()` works", {
rlang::local_options(lifecycle_verbosity = "quiet")
mscale <- function(x) {
if (sd(x) != 0) {
x <- scale(x)
}
if (x[1] < 0) {
x <- -x
}
x
}
g1 <- sample_pa(100, m = 10)
A <- as_adj(g1, sparse = FALSE)
s1 <- eigen(t(A) %*% A)$vectors[, 1]
s2 <- authority_score(g1)$vector
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
g2 <- sample_gnp(100, 2 / 100)
A <- as_adj(g2, sparse = FALSE)
s1 <- eigen(t(A) %*% A)$vectors[, 1]
s2 <- authority_score(g2)$vector
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
rlang::with_options(lifecycle_verbosity = "warning", {
expect_snapshot(
s3 <- authority_score(g2, options = arpack_defaults)$vector
)
})
expect_equal(s2, s3)
})
test_that("`hub_score()` works", {
rlang::local_options(lifecycle_verbosity = "quiet")
mscale <- function(x) {
if (sd(x) != 0) {
x <- scale(x)
}
if (x[1] < 0) {
x <- -x
}
x
}
g1 <- sample_pa(100, m = 10)
A <- as_adj(g1, sparse = FALSE)
s1 <- eigen(A %*% t(A))$vectors[, 1]
s2 <- hub_score(g1)$vector
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
g2 <- sample_gnp(100, 2 / 100)
A <- as_adj(g2, sparse = FALSE)
s1 <- eigen(A %*% t(A))$vectors[, 1]
s2 <- hub_score(g2)$vector
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
rlang::with_options(lifecycle_verbosity = "warning", {
expect_snapshot(
s3 <- hub_score(g2, options = arpack_defaults)$vector
)
})
expect_equal(s2, s3)
})
# TODO: Hub and authority scores make little sense for undirected graphs
# Replace this test. Until then, do not use even-length cycle graphs
# as their leading eigenvalue for hub/authority scores is degenerate,
# and any vector with alternating values (a, b, a, b, ...) is a valid
# solution, not just all-ones.
test_that("authority scores of a ring are all one", {
rlang::local_options(lifecycle_verbosity = "quiet")
g3 <- make_ring(99)
expect_equal(hits_scores(g3)$authority, rep(1, vcount(g3)))
expect_equal(hits_scores(g3)$hub, rep(1, vcount(g3)))
})
test_that("authority_score survives stress test", {
skip_on_cran()
withr::local_seed(42)
is.principal <- function(M, lambda) {
expect_equal(eigen(M)$values[1], lambda)
}
is.ev <- function(M, v, lambda) {
expect_equal(as.vector(M %*% v), lambda * v)
}
is.good <- function(M, v, lambda) {
is.principal(M, lambda)
is.ev(M, v, lambda)
}
for (i in 1:100) {
G <- sample_gnm(10, sample(1:20, 1))
as <- hits_scores(G)
M <- as_adj(G, sparse = FALSE)
is.good(t(M) %*% M, as$authority, as$value)
}
for (i in 1:100) {
G <- sample_gnm(10, sample(1:20, 1))
hs <- hits_scores(G)
M <- as_adj(G, sparse = FALSE)
is.good(M %*% t(M), hs$hub, hs$value)
}
})
test_that("`hits_score()` works -- authority", {
mscale <- function(x) {
if (sd(x) != 0) {
x <- scale(x)
}
if (x[1] < 0) {
x <- -x
}
x
}
g1 <- sample_pa(100, m = 10)
A <- as_adj(g1, sparse = FALSE)
s1 <- eigen(t(A) %*% A)$vectors[, 1]
s2 <- hits_scores(g1)$authority
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
g2 <- sample_gnp(100, 2 / 100)
A <- as_adj(g2, sparse = FALSE)
s1 <- eigen(t(A) %*% A)$vectors[, 1]
s2 <- hits_scores(g2)$authority
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
})
test_that("`hits_scores()` works -- hub", {
mscale <- function(x) {
if (sd(x) != 0) {
x <- scale(x)
}
if (x[1] < 0) {
x <- -x
}
x
}
g1 <- sample_pa(100, m = 10)
A <- as_adj(g1, sparse = FALSE)
s1 <- eigen(A %*% t(A))$vectors[, 1]
s2 <- hits_scores(g1)$hub
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
g2 <- sample_gnp(100, 2 / 100)
A <- as_adj(g2, sparse = FALSE)
s1 <- eigen(A %*% t(A))$vectors[, 1]
s2 <- hits_scores(g2)$hub
expect_equal(mscale(s1), mscale(s2), ignore_attr = TRUE)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.