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

Preparing for CRAN release #54

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
Draft

Preparing for CRAN release #54

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
213bda0
Mostly refactoring and code cleaning
gvegayon Jan 31, 2025
5c51519
Cleaning
gvegayon Feb 3, 2025
2ab6ba3
Reverting change to graph_data.r
gvegayon Feb 3, 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
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: netdiffuseR
Title: Analysis of Diffusion and Contagion Processes on Networks
Version: 1.22.7
Version: 1.22.9999
Authors@R: c(
person("George", "Vega Yon", email="[email protected]", role=c("aut", "cre"),
comment=c(ORCID = "0000-0002-3171-0844", what="Rewrite functions with Rcpp, plus new features")
Expand Down Expand Up @@ -51,7 +51,7 @@ Suggests:
survival
VignetteBuilder: knitr
LinkingTo: Rcpp, RcppArmadillo
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
Encoding: UTF-8
URL: https://github.com/USCCANA/netdiffuseR,
https://USCCANA.github.io/netdiffuseR/
Expand Down
7 changes: 7 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,10 @@
# Changes in netdiffuseR version 1.23.0 (2025-01-03)

* New methods for simulating multi-diffusion models, including disadoption.

*


# Changes in netdiffuseR version 1.22.7 (2024-09-18)

* Minor changes to testing (skip warnings).
Expand Down
205 changes: 131 additions & 74 deletions R/diffnet-class.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,13 @@ make_col_names <- function(n, is.dynamic, prefix="v.") {
}

# Checks attributes to be added to a diffnet object
check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL,
attr.class="vertex") {
check_as_diffnet_attrs <- function(
attrs,
meta, is.dynamic,
id.and.per.vars=NULL,
attr.class="vertex"
) {

# Getting meta
n <- meta$n
nper <- meta$nper
Expand Down Expand Up @@ -350,7 +355,7 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
#' or static (\code{"static"}).
#' @param as.df Logical scalar. When TRUE returns a data.frame.
#' @param name Character scalar. Name of the diffusion network (descriptive).
#' @param behavior Character scalar. Name of the behavior been analyzed (innovation).
#' @param behavior Character vector. Name of the behavior(s) been analyzed (innovation).
#'
#' @seealso Default options are listed at \code{\link{netdiffuseR-options}}
#' @details
Expand Down Expand Up @@ -527,7 +532,7 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
#' \item \code{undirected}: Logical scalar.
#' \item \code{multiple}: Logical scalar.
#' \item \code{name}: Character scalar.
#' \item \code{behavior}: Character scalar.
#' \item \code{behavior}: A list of character scalars.
#' }
#' }
#' @author George G. Vega Yon & Aníbal Olivera M.
Expand Down Expand Up @@ -555,16 +560,20 @@ as_diffnet.networkDynamic <- function(graph, toavar, ...) {

#' @export
#' @rdname diffnet-class
new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm = TRUE),
vertex.dyn.attrs = NULL, vertex.static.attrs= NULL,
id.and.per.vars = NULL,
graph.attrs = NULL,
undirected = getOption("diffnet.undirected"),
self = getOption("diffnet.self"),
multiple = getOption("diffnet.multiple"),
name = "Diffusion Network",
behavior = "Unspecified"
) {
new_diffnet <- function(
graph, toa,
t0=min(toa, na.rm = TRUE),
t1=max(toa, na.rm = TRUE),
vertex.dyn.attrs = NULL,
vertex.static.attrs = NULL,
id.and.per.vars = NULL,
graph.attrs = NULL,
undirected = getOption("diffnet.undirected"),
self = getOption("diffnet.self"),
multiple = getOption("diffnet.multiple"),
name = "Diffusion Network",
behavior = NULL
) {

# Step 0.0: Check if its diffnet! --------------------------------------------
if (inherits(graph, "diffnet")) {
Expand All @@ -574,9 +583,19 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm

# Step 0.1: Setting num_of_behavior ------------------------------------------

if (inherits(toa, "matrix")) {
if (inherits(toa, "matrix"))
num_of_behaviors <- dim(toa)[2]
} else {num_of_behaviors <- 1}
else
num_of_behaviors <- 1

if (length(behavior) == 0L)
behavior <- rep("Unknown", num_of_behaviors)
else if (length(behavior) != num_of_behaviors)
stop(
"Length of -behavior- must be equal to the number of behaviors in -toa-."
)
else if (!inherits(behavior, "list"))
behavior <- as.list(behavior)

# Step 1.1: Check graph ------------------------------------------------------
meta <- classify_graph(graph)
Expand All @@ -585,27 +604,30 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm


# Step 1.2: Checking that lengths fit
if (num_of_behaviors == 1) {
if (length(toa)!=meta$n){ stop("-graph- and -toa- have different lengths (", meta$n, " and ", length(toa),
" respectively). ", "-toa- should be of length n (number of vertices).") }
} else {
if (length(toa[,1])!=meta$n) {stop("-graph- and -toa[,1]- have different lengths (", meta$n, " and ", length(toa[,1]),
" respectively). ", "-toa- should be of length n (number of vertices).") }
if ((num_of_behaviors == 1L) && (length(toa) != meta$n)) {

stop(
"-graph- and -toa- have different lengths (", meta$n, " and ",
length(toa),
" respectively). -toa- should be of length n (number of vertices)."
)

} else if ((num_of_behaviors > 1L) && length(toa[, 1L])!=meta$n) {

stop(
"-graph- and -toa[, 1]- have different lengths (", meta$n, " and ",
length(toa[, 1L]),
" respectively). ", "-toa- should be of length n (number of vertices)."
)

}

# Step 2.1: Checking class of TOA and coercing if necessary -------------------
if (num_of_behaviors==1) {
if (!inherits(toa, "integer")) {
warning("Coercing -toa- into integer.")
toa <- as.integer(toa)
}
} else {
for (q in 1:num_of_behaviors) {
if (!inherits(toa[,q], "integer")) {
warning("Coercing -toa- into integer.")
toa[,q] <- as.integer(toa[,q])
}
}
# Step 2.1: Checking class of TOA and coercing if necessary
if (!inherits(toa, "integer")) {

warning("Coercing -toa- into integer.")
toa[] <- as.integer(toa)

}

# Step 2.2: Checking names of toa
Expand All @@ -624,42 +646,66 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm

if (num_of_behaviors==1) {
if (meta$type != "static") {

tdiff <- meta$nper - ncol(mat$adopt)
if (tdiff < 0)
stop("Range of -toa- is bigger than the number of slices in -graph- (",
ncol(mat$adopt), " and ", length(graph) ," respectively). ",
"There must be at least as many slices as range of toa.")
stop(
"Range of -toa- is bigger than the number of slices in -graph- (",
ncol(mat$adopt), " and ", length(graph) ," respectively). ",
"There must be at least as many slices as range of toa."
)
else if (tdiff > 0)
stop("Range of -toa- is smaller than the number of slices in -graph- (",
ncol(mat$adopt), " and ", length(graph) ," respectively). ",
"Please provide lower and upper boundaries for the values in -toa- ",
"using -t0- and -t- (see ?toa_mat).")
stop(
"Range of -toa- is smaller than the number of slices in -graph- (",
ncol(mat$adopt), " and ", length(graph) ," respectively). ",
"Please provide lower and upper boundaries for the values in -toa- ",
"using -t0- and -t- (see ?toa_mat)."
)

} else {
graph <- lapply(1:ncol(mat$adopt), function(x) methods::as(graph, "dgCMatrix"))

graph <- lapply(
1:ncol(mat$adopt), function(x) methods::as(graph, "dgCMatrix")
)

meta <- classify_graph(graph)

}
} else {
if (meta$type != "static") {

tdiff <- meta$nper - ncol(mat[[1]]$adopt)
if (tdiff < 0)
stop("Range of -toa- is bigger than the number of slices in -graph- (",
ncol(mat[[1]]$adopt), " and ", length(graph) ," respectively). ",
"There must be at least as many slices as range of toa.")
stop(
"Range of -toa- is bigger than the number of slices in -graph- (",
ncol(mat[[1]]$adopt), " and ", length(graph) ," respectively). ",
"There must be at least as many slices as range of toa."
)
else if (tdiff > 0)
stop("Range of -toa- is smaller than the number of slices in -graph- (",
ncol(mat[[1]]$adopt), " and ", length(graph) ," respectively). ",
"Please provide lower and upper boundaries for the values in -toa- ",
"using -t0- and -t- (see ?toa_mat).")
stop(
"Range of -toa- is smaller than the number of slices in -graph- (",
ncol(mat[[1]]$adopt), " and ", length(graph) ," respectively). ",
"Please provide lower and upper boundaries for the values in -toa- ",
"using -t0- and -t- (see ?toa_mat)."
)

} else {
graph <- lapply(1:ncol(mat[[1]]$adopt), function(x) methods::as(graph, "dgCMatrix"))

graph <- lapply(
1:ncol(mat[[1]]$adopt), function(x) methods::as(graph, "dgCMatrix")
)

meta <- classify_graph(graph)

}
}

# labels of the time periods
if (num_of_behaviors==1) {
if (num_of_behaviors == 1) {
meta$pers <- as.integer(colnames(mat$adopt))
} else {meta$pers <- as.integer(colnames(mat[[1]]$adopt))} # same for all behaviors
} else {
meta$pers <- as.integer(colnames(mat[[1]]$adopt))
} # same for all behaviors

# Step 4.0: Checking the attributes ------------------------------------------

Expand Down Expand Up @@ -688,48 +734,59 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm
meta$self <- self
meta$undirected <- undirected
meta$multiple <- multiple
meta$name <- ifelse(!length(name), "", ifelse(is.na(name), "",
as.character(name)))
meta$version <- utils::packageVersion("netdiffuseR")
meta$name <- ifelse(
!length(name), "", ifelse(is.na(name), "", as.character(name))
)

# Removing dimnames
graph <- Map(function(x) Matrix::unname(x), x=graph)
#dimnames(toa) <- NULL
meta$version <- utils::packageVersion("netdiffuseR")
graph <- Map(function(x) Matrix::unname(x), x=graph)

if (num_of_behaviors == 1) {

meta$behavior <- behavior

if (num_of_behaviors==1) {
meta$behavior <- ifelse(!length(behavior), "", ifelse(is.na(behavior), "",
as.character(behavior)))
dimnames(mat$adopt) <- NULL
dimnames(mat$cumadopt) <- NULL

adopt <- mat$adopt
cumadopt <- mat$cumadopt

} else {
meta$behavior <- paste(unlist(behavior), collapse = ", ")

meta$behavior <- behavior

for (q in 1:num_of_behaviors) {
dimnames(mat[[q]]$adopt) <- NULL
dimnames(mat[[q]]$cumadopt) <- NULL
}

adopt <- list()
cumadopt <- list()

for (q in 1:num_of_behaviors) {
adopt[[q]] <- mat[[q]]$adopt
cumadopt[[q]] <- mat[[q]]$cumadopt
}

}

return(structure(list(
graph = graph,
toa = toa,
adopt = adopt,
cumadopt = cumadopt,
# Attributes
vertex.static.attrs = vertex.static.attrs,
vertex.dyn.attrs = vertex.dyn.attrs,
graph.attrs = graph.attrs,
meta = meta
), class="diffnet"))
return(
structure(
list(
graph = graph,
toa = toa,
adopt = adopt,
cumadopt = cumadopt,
# Attributes
vertex.static.attrs = vertex.static.attrs,
vertex.dyn.attrs = vertex.dyn.attrs,
graph.attrs = graph.attrs,
meta = meta
),
class="diffnet"
)
)

}

#' @export
Expand Down
8 changes: 4 additions & 4 deletions R/diffnet-methods.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -113,7 +113,7 @@ print.diffnet <- function(x, ...) {
cat(
"Dynamic network of class -diffnet-",
paste(" Name :", meta$name),
paste(" Behavior :", meta$behavior),
paste(" Behavior :", paste(meta$behavior, collapse=", ")),
paste(" # of nodes :", nodesl ),
paste(" # of time periods :", meta$nper, sprintf("(%d - %d)", meta$pers[1], meta$pers[meta$nper])),
paste(" Type :", ifelse(meta$undirected, "undirected", "directed")),
Expand Down Expand Up @@ -324,7 +324,7 @@ summary.diffnet <- function(
"Name : ", meta$name, "\n")

if (single) {
cat(" Behavior : ", meta$behavior, "\n",
cat(" Behavior : ", meta$behavior[[1L]], "\n",
rule,"\n",sep="")
cat(header,"\n")
cat(hline, "\n")
Expand All @@ -333,9 +333,9 @@ summary.diffnet <- function(
paste("Left censoring :", sprintf("%3.2f (%d)", lc/meta$n, lc)), "\n",
paste("Right centoring :", sprintf("%3.2f (%d)", rc/meta$n, rc)), "\n")
} else {
beh_names <- strsplit(meta$behavior, ", ")[[1]]
beh_names <- meta$behavior
for (q in 1:length(object$cumadopt)) {
cat("\n Behavior : ", beh_names[q], "\n",
cat("\n Behavior : ", beh_names[[q]], "\n",
rule,"\n",sep="")
cat(header,"\n")
cat(hline, "\n")
Expand Down
6 changes: 3 additions & 3 deletions R/graph_data.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ as_generic_graph.igraph <- function(graph) {
undirected = FALSE, # For now we will assume it is undirected
multiple = FALSE, # And !multiple
class = "igraph"
))
))
add_to_generic_graph("ans", "meta", meta, env)

return(ans)
Expand Down Expand Up @@ -96,7 +96,7 @@ as_generic_graph.network <- function(graph) {
undirected = !network::is.directed(graph),
multiple = network::is.multiplex(graph),
self = network::has.loops(graph)
)
)

ord <- network::network.vertex.names(graph)
ord <- match(ord, rownames(adjmat))
Expand Down Expand Up @@ -221,7 +221,7 @@ classify_graph <- function(graph) {

# Step 4.2.1: Must keep uniqueness
if (length(unique(pers)) != t) stop("When coercing names(graph) into integer,",
"some slices acquired the same name.")
"some slices acquired the same name.")
}

return(invisible(list(
Expand Down
Loading
Loading