Cleaning

Author: gvegayon

DESCRIPTION

@@ -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/

NEWS.md

@@ -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).

R/diffnet-class.r

@@ -532,7 +532,7 @@ check_as_diffnet_attrs <- function(
 #'  \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.
@@ -572,7 +572,7 @@ new_diffnet <- function(
   self                = getOption("diffnet.self"),
   multiple            = getOption("diffnet.multiple"),
   name                = "Diffusion Network",
-  behavior            = NA_character_
+  behavior            = NULL
 ) {
 
   # Step 0.0: Check if its diffnet! --------------------------------------------
@@ -583,17 +583,19 @@ new_diffnet <- function(
 
   # 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
 
-  if (is.na(behavior))
+  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)
@@ -603,14 +605,14 @@ new_diffnet <- function(
 
   # Step 1.2: Checking that lengths fit
   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 (length(toa[, 1L])!=meta$n) {
+  } else if ((num_of_behaviors > 1L) && length(toa[, 1L])!=meta$n) {
 
     stop(
       "-graph- and -toa[, 1]- have different lengths (", meta$n, " and ",
@@ -620,7 +622,7 @@ new_diffnet <- function(
 
   }
 
-  # Step 2.1: Checking class of TOA and coercing if necessary 
+  # Step 2.1: Checking class of TOA and coercing if necessary
   if (!inherits(toa, "integer")) {
 
     warning("Coercing -toa- into integer.")
@@ -686,7 +688,7 @@ new_diffnet <- function(
           "Please provide lower and upper boundaries for the values in -toa- ",
           "using -t0- and -t- (see ?toa_mat)."
           )
-    
+
     } else {
 
       graph <- lapply(

R/diffnet-methods.r

@@ -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")
@@ -335,7 +335,7 @@ summary.diffnet <- function(
   } else {
     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")

R/graph_data.r

@@ -41,83 +41,6 @@
 #' @family graph formats
 NULL
 
-
-as_generic_graph <- function(graph) UseMethod("as_generic_graph")
-
-# Method for igraph objects
-as_generic_graph.igraph <- function(graph) {
-
-  # If multiple then warn
-  if (igraph::any_multiple(graph))
-    warning("The -igraph- object has multiple edges. Only one of each will be retrieved.")
-  if ("weight" %in% igraph::graph_attr_names(graph)) {
-    adjmat <- igraph::as_adj(graph, attr="weight")
-  } else {
-    adjmat <- igraph::as_adj(graph)
-  }
-
-  # Converting to dgCMatrix
-  env <- environment()
-  ans <- new_generic_graph()
-  suppressWarnings(add_to_generic_graph("ans", "graph", list(`1`=adjmat), env))
-  meta <- c(classify_graph(adjmat), list(
-    self       = any(igraph::is.loop(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)
-}
-
-new_generic_graph <- function() {
-  list(graph=NULL, meta=NULL)
-}
-
-# This function adds an element checking that the slot exits
-add_to_generic_graph <- function(gg,nam,val,env=environment()) {
-  obj <- get(gg, envir = env)
-  if (!(nam %in% names(obj))) stop(nam," unknown slot.")
-  obj[[nam]] <- val
-  assign(gg,obj,envir = env)
-  invisible(NULL)
-}
-
-# Method for network objects
-as_generic_graph.network <- function(graph) {
-  # If multiple then warn
-  if (network::is.multiplex(graph))
-    warning("The -network- object has multiple edges. These will be added up.")
-
-  # Converting to an adjacency matrix (dgCMatrix)
-  adjmat <- edgelist_to_adjmat(
-    network::as.edgelist(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))
-  adjmat <- adjmat[ord,ord]
-
-  env <- environment()
-  ans <- new_generic_graph()
-  suppressWarnings(add_to_generic_graph("ans", "graph", list(`1`=adjmat), env))
-
-  meta <- c(classify_graph(adjmat), list(
-    self       = network::has.loops(graph),
-    undirected = !network::is.directed(graph),
-    multiple   = network::is.multiplex(graph),
-    class      = "network"
-  ))
-
-  add_to_generic_graph("ans", "meta", meta, env)
-
-  return(ans)
-}
-
 stopifnot_graph <- function(x)
   stop("No method for graph of class -",class(x),"- for ", deparse(sys.call()) #match.call()
        ,". Please refer to the manual 'netdiffuseR-graphs'.")

man/diffnet-class.Rd

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: cd097d00-46b5-4411-bf0c-2d01da946aea
 
 RestoreWorkspace: No
 SaveWorkspace: No

man/figures/netdiffuser-logo.png

@@ -200,7 +200,10 @@ test_that("Disadoption works", {
 
   }
 
-  ans_d_adopt <- rdiffnet(n = n, t = 10, disadopt = d_adopt, seed.p.adopt = list(0.1, 0.1))
+  ans_d_adopt <- rdiffnet(
+    n = n, t = 10, disadopt = d_adopt,
+    seed.p.adopt = list(0.1, 0.1)
+    )
 
   tmat <- toa_mat(ans_d_adopt)
   should_be_ones_or_zeros <- tmat[[1]]$cumadopt[, 10] + tmat[[2]]$cumadopt[, 10]

man/split_behaviors.Rd

@@ -2,7 +2,11 @@
 title: "Simulating Multiple Behaviors on Networks"
 author: "Aníbal Olivera M."
 date: "2024-11-21"
-output: html_document
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Simulating Multiple Behaviors on Networks}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
 ---
 
 \tableofcontents