Skip to content

Commit

Permalink
all comments were addressed, except -behavior- as a vector.
Browse files Browse the repository at this point in the history
  • Loading branch information
aoliveram committed Nov 19, 2024
1 parent 516cf33 commit 90f4af5
Show file tree
Hide file tree
Showing 6 changed files with 63 additions and 59 deletions.
1 change: 0 additions & 1 deletion R/adjmat.r
Original file line number Diff line number Diff line change
Expand Up @@ -491,7 +491,6 @@ toa_mat <- function(obj, labels=NULL, t0=NULL, t1=NULL) {
}
} else {
for (q in 1:num_of_behaviors) {
#cls <- class(obj[,q])
ans[[q]] <- if ("matrix" %in% class(obj)) {
if ("integer" %in% class(obj[,q])){
toa_mat.integer(obj[,q], labels, t0, t1)
Expand Down
2 changes: 2 additions & 0 deletions R/diffnet-class.r
Original file line number Diff line number Diff line change
Expand Up @@ -638,6 +638,8 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm

# This should be reviewed !! (here the graph becomes 'dynamic')

warning("here the graph becomes 'dynamic' for multiple")

graph <- lapply(1:ncol(mat[[1]]$adopt), function(x) methods::as(graph, "dgCMatrix"))
meta <- classify_graph(graph)
}
Expand Down
4 changes: 2 additions & 2 deletions R/diffnet-methods.r
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ print.diffnet <- function(x, ...) {
ifelse(meta$n>8, ", ...", "") ,")")

# Computing prevalence for multi-diff
single <- class(cumadopt)[1]!='list'
single <- !inherits(cumadopt, "list")
if (!single) {
prevalence_all <- character(length(cumadopt))
for (q in 1:length(cumadopt)) {
Expand Down Expand Up @@ -214,7 +214,7 @@ summary.diffnet <- function(
}))

# identify single-diff from multi-diff
single <- class(object$cumadopt)[1]!='list'
single <- !inherits(object$cumadopt, "list")

# Computing moran's I
if (single) {
Expand Down
22 changes: 11 additions & 11 deletions R/rdiffnet.r
Original file line number Diff line number Diff line change
Expand Up @@ -332,12 +332,12 @@ rdiffnet <- function(
if (!length(exposure.args[["valued"]])) exposure.args[["valued"]] <- getOption("diffnet.valued", FALSE)
if (!length(exposure.args[["normalized"]])) exposure.args[["normalized"]] <- TRUE

if (class(exposure.args[["attrs"]])[1] == "matrix") {
if (inherits(exposure.args[["attrs"]], "matrix")) {
# Checking if the attrs matrix is has dims n x t
if (any(dim(exposure.args[["attrs"]]) != dim(matrix(NA, nrow = n, ncol = t)))) {
stop("Incorrect size for -attrs- in rdiffnet. Does not match n dim or t dim.")}
attrs_arr <- exposure.args[["attrs"]]
if (class(seed.p.adopt) == 'list'){
if (inherits(seed.p.adopt, "list")){
attrs_arr <- array(attrs_arr, dim = c(n, t, length(seed.p.adopt)))
} else {attrs_arr <- array(attrs_arr, dim = c(n, t, 1))}
}
Expand Down Expand Up @@ -511,14 +511,14 @@ rdiffnet_validate_args <- function(seed.p.adopt, seed.nodes, behavior) {

# The class of seed.p.adopt determines if is a single or multiple diff pross.

if (class(seed.p.adopt) == "list") {
if (inherits(seed.p.adopt, "list")) {

message(paste("Message: Multi-diffusion behavior simulation selected.",
"Number of behaviors: ", length(seed.p.adopt)))

multi <- TRUE

} else if (class(seed.p.adopt) == "numeric") {
} else if (inherits(seed.p.adopt, "numeric")) {

if (length(seed.p.adopt)>1) {
stop(paste("length(seed.p.adopt) =", length(seed.p.adopt),
Expand All @@ -539,7 +539,7 @@ rdiffnet_validate_args <- function(seed.p.adopt, seed.nodes, behavior) {

# For multi-diff.

if (class(seed.nodes) == "list") {
if (inherits(seed.nodes, "list")) {
if (length(seed.nodes) != length(seed.p.adopt)) {
stop("Length of lists -seed.nodes- and -seed.p.adopt- must be the same for multi diffusion.")
}
Expand All @@ -563,12 +563,12 @@ rdiffnet_validate_args <- function(seed.p.adopt, seed.nodes, behavior) {
} else {
stop("All elements of the list seed.nodes must be either -character- or -numeric-.")
}
} else if (class(seed.nodes) == "numeric") {
} else if (inherits(seed.nodes, "numeric")) {
message("Message: Object -seed.nodes- converted to a -list-.",
"All behaviors will have the same -", seed.nodes, "- seed nodes.")

seed.nodes <- replicate(length(seed.p.adopt), seed.nodes, simplify = FALSE)
} else if (class(seed.nodes) == "character") {
} else if (inherits(seed.nodes, "character")) {
if (length(seed.nodes)==length(seed.p.adopt)) {
seed.nodes <- as.list(seed.nodes)
message("Message: Object -seed.nodes- converted to a -list-.",
Expand All @@ -583,17 +583,17 @@ rdiffnet_validate_args <- function(seed.p.adopt, seed.nodes, behavior) {
stop("Unsupported -seed.nodes- value. See the manual for references.")
}

if (class(behavior) == "list") {
if (inherits(behavior, "list")) {
if (length(seed.p.adopt)!=length(behavior)) {
stop("If -behavior- is a list, it must be of the same length as -seed.p.adopt-.")
}
} else if (class(behavior) == "character" && length(behavior) > 1) {
} else if (inherits(behavior, "character") && length(behavior) > 1) {
if (length(behavior) != length(seed.p.adopt)) {
stop("Mismatch between length(behavior) and length(seed.p.adopt)")
} else {
behavior <- as.list(behavior)
}
} else if (class(behavior) == "character" && length(behavior) == 1) {
} else if (inherits(behavior, "character") && length(behavior) == 1) {
message(paste("Message: Name of 1 behavior provided, but", length(seed.p.adopt), "are needed. "),
"Names generalized to 'behavior'_1, 'behavior'_2, etc.")
behaviors <- list()
Expand All @@ -609,7 +609,7 @@ rdiffnet_validate_args <- function(seed.p.adopt, seed.nodes, behavior) {

# For Single-diff.

if (length(seed.nodes) == 1 && class(seed.nodes)=="character") {
if (length(seed.nodes) == 1 && inherits(seed.nodes, "character")) {

if (!seed.nodes %in% c("marginal", "central", "random")) {
stop("Object -seed.nodes- is a -character- different from 'marginal', 'central', or 'random'.")
Expand Down
38 changes: 20 additions & 18 deletions tests/testthat/test-rdiffnet-parameters.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,18 +11,18 @@ test_that(
behavior <- c("random behavior")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)

class(rdiffnet_args$seed.p.adopt) == "list"
class(rdiffnet_args$seed.nodes) == "list"
class(rdiffnet_args$behavior) == "list"
expect_type(rdiffnet_args$seed.p.adopt, "list")
expect_type(rdiffnet_args$seed.nodes, "list")
expect_type(rdiffnet_args$behavior, "list")

seed.p.adopt <- 0.14
seed.nodes <- 'random'
behavior <- "random behavior"
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)

class(rdiffnet_args$seed.p.adopt) == "list"
class(rdiffnet_args$seed.nodes) == "list"
class(rdiffnet_args$behavior) == "list"
expect_type(rdiffnet_args$seed.p.adopt, "list")
expect_type(rdiffnet_args$seed.nodes, "list")
expect_type(rdiffnet_args$behavior, "list")

# Must show ERROR

Expand Down Expand Up @@ -104,40 +104,42 @@ test_that("Multi diff models rdiff args work", {
seed.nodes <- "random"
behavior <- "random behavior"
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
expect_type(rdiffnet_args$seed.p.adopt, "list")
expect_type(rdiffnet_args$seed.nodes, "list")
expect_type(rdiffnet_args$behavior, "list")

seed.nodes <- c(1,3,5)
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
expect_type(rdiffnet_args$seed.nodes, "list")

seed.nodes <- c('marginal',"central")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
expect_type(rdiffnet_args$seed.nodes, "list")

seed.p.adopt <- list(0.14,0.05)
seed.nodes <- list('random', "central")
behavior <- list("random behavior_1", "random behavior_2")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
class(rdiffnet_args$seed.p.adopt) == "list"
class(rdiffnet_args$seed.nodes) == "list"
class(rdiffnet_args$behavior) == "list"
expect_type(rdiffnet_args$behavior, "list")

behavior <- c("random behavior_1", "random behavior_2")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
class(rdiffnet_args$behavior) == "list"
expect_type(rdiffnet_args$behavior, "list")

behavior <- "random behavior" #Default
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
class(rdiffnet_args$behavior) == "list"
expect_type(rdiffnet_args$behavior, "list")

behavior <- c("random behavior_1")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
expect_type(rdiffnet_args$behavior, "list")

seed.nodes <- c(1,3,5)
behavior <- list("random behavior_1", "random behavior_2")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
class(rdiffnet_args$seed.nodes) == 'list'
expect_type(rdiffnet_args$seed.nodes, "list")

seed.nodes <- list('marginal',"central")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
class(rdiffnet_args$seed.nodes) == 'list'

behavior <- c("random behavior_1")
rdiffnet_args <- rdiffnet_validate_args(seed.p.adopt, seed.nodes, behavior)
expect_type(rdiffnet_args$seed.nodes, "list")

# Must show ERROR

Expand Down
55 changes: 28 additions & 27 deletions tests/testthat/test-rdiffnet.R
Original file line number Diff line number Diff line change
Expand Up @@ -107,9 +107,35 @@ test_that("Simulation study", {

})

# Test for multi diffusion ---
# Testing diffnet class across several inputs (single)
test_that("rdiffnet must run across several inputs (single)", {
expect_s3_class(rdiffnet(100, 5), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = 0.1), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = 0.1, seed.nodes = 'random'), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.nodes = c(1, 3, 5)), "diffnet")

# summary
net_1 <- rdiffnet(100, 5, seed.nodes = c(1,3,5))
expect_s3_class(summary(net_1), "data.frame")
})

# Testing diffnet class across several inputs (multiple)
test_that("rdiffnet must run across several inputs (multiple)", {
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08)), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), behavior = c('tabacco', 'alcohol')), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), seed.nodes = 'random'), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), seed.nodes = c('random', 'central')), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = 0.3), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(0.1, 0.2)), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = rexp(100)), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(rexp(100), runif(100))), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = function(x) 0.3), "diffnet")
expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(function(x) 0.3, function(x) 0.2)), "diffnet")

net_2 <- rdiffnet(100, 5, seed.p.adopt = list(0.05,0.05), seed.nodes = c(1,3,5))
expect_s3_class(summary(net_2), "data.frame")
})

# Seed of first adopters
test_that("All should be equal! (multiple)", {
set.seed(12131)
n <- 50
Expand All @@ -131,31 +157,6 @@ test_that("All should be equal! (multiple)", {
})


#single
rdiffnet(100, 5)
rdiffnet(100, 5, seed.p.adopt = 0.1)
rdiffnet(100, 5, seed.p.adopt = 0.1, seed.nodes = 'random')
rdiffnet(100, 5, seed.nodes = c(1,3,5))
net_1 <- rdiffnet(100, 5, seed.nodes = c(1,3,5))
summary(net_1)

#multi
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), behavior = c('tabacco', 'alcohol'))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), seed.nodes = 'random')
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), seed.nodes = c('random', 'central'))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = 0.3)
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = list(0.1,0.2))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = rexp(100))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = list(rexp(100),runif(100)))
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = function(x) 0.3)
rdiffnet(100, 5, seed.p.adopt = list(0.1,0.08), threshold.dist = list(function(x) 0.3, function(x) 0.2))

net_1 <- rdiffnet(100, 5, seed.nodes = c(1,3,5))
summary(net_1)
net_2 <- rdiffnet(100, 5, seed.p.adopt = list(0.05,0.05), seed.nodes = c(1,3,5))
summary(net_2)

#rdiffnet(100, 5, seed.p.adopt = 0.9, threshold.dist = 2, exposure.args = list(normalized=FALSE))

# set.seed(1234)
Expand Down

0 comments on commit 90f4af5

Please sign in to comment.