Updating toa_diff documentation

R/adjmat.r

@@ -589,25 +589,51 @@ toa_mat.integer <- function(times, labels=NULL,
 
 #' Difference in Time of Adoption (TOA) between individuals
 #'
-#' Creates \eqn{n \times n}{n * n} matrix indicating the difference in times of adoption between
-#' each pair of nodes
+#' Creates an \eqn{n \times n}{n * n} matrix, or for \eqn{Q}{Q} behaviors, a list
+#' of length \eqn{Q}{Q} containing \eqn{n \times n}{n * n} matrices, that indicates
+#' the difference in adoption times between each pair of nodes.
 #' @inheritParams toa_mat
-#' @details Each cell ij of the resulting matrix is calculated as \eqn{toa_j - toa_i}{%
+#' @details Each cell \eqn{ij}{ij} of the resulting matrix is calculated as \eqn{toa_j - toa_i}{%
 #' toa(j) - toa(i)}, so that whenever its positive it means that the j-th individual (alter)
 #' adopted the innovation sooner.
-#' @return An \eqn{n \times n}{n * n} symmetric matrix indicating the difference in times of
+#' @return An \eqn{n \times n}{n * n} anti-symmetric matrix (or a list of them,
+#' for \eqn{Q}{Q} behaviors) indicating the difference in times of
 #' adoption between each pair of nodes.
 #' @export
 #' @examples
+#' # For a single behavior -----------------------------------------------------
+#'
 #' # Generating a random vector of time
 #' set.seed(123)
 #' times <- sample(2000:2005, 10, TRUE)
 #'
 #' # Computing the TOA differences
 #' toa_diff(times)
+#'
+#' # For Q=2 behaviors ---------------------------------------------------------
+#'
+#' # Generating a matrix time
+#'
+#' times_1 <- c(2001L, 2004L, 2003L, 2008L)
+#' times_2 <- c(2001L, 2005L, 2006L, 2008L)
+#' times <- matrix(c(times_1, times_2), nrow = 4, ncol = 2)
+#'
+#' # Computing the TOA differences
+#' toa_diff(times)
+#'
+#' # Or, from a diffnet object
+#'
+#' graph <- lapply(2001:2008, function(x) rgraph_er(4))
+#' diffnet <- new_diffnet(graph, times)
+#'
+#' # Computing the TOA differences
+#' toa_diff(diffnet)
+#'
+
+#'
 #' @keywords manip
 #' @include graph_data.r
-#' @author George G. Vega Yon & Thomas W. Valente
+#' @author George G. Vega Yon, Thomas W. Valente, and Aníbal Olivera M.
 toa_diff <- function(obj, t0=NULL, labels=NULL) {
 
   # Calculating t0 (if it was not provided)

tests/testthat/test-adjmat.R

@@ -99,7 +99,7 @@ for (g in names(EL_digraph)) {
 ################################################################################
 # Time of adoption
 ################################################################################
-context("Time of Adoption (toa_mat, toa_dif)")
+context("Time of Adoption (toa_mat, toa_diff)")
 
 times <- c(2001L, 2004L, 2003L, 2008L)
 

vignettes/simulating-multiple-behaviors-on-networks.Rmd

@@ -209,6 +209,37 @@ should_be_ones_or_zeros <- tmat[[1]]$cumadopt[, 10] + tmat[[2]]$cumadopt[, 10]
 
 expect_true(all(should_be_ones_or_zeros %in% c(0,1)))
 
+```
+
+```{r}
+
+set.seed(1231)
+
+n <- 100; t <- 5;
+graph <- rgraph_ws(n, t, p=.3)
+
+random_dis <- function(expo, cumadopt, time) {
+  num_of_behaviors <- dim(cumadopt)[3]
+
+  list_disadopt <- list()
+
+  for (q in 1:num_of_behaviors) {
+    adopters <- which(cumadopt[, time, q, drop=FALSE] == 1)
+    if (length(adopters) == 0) {
+      # only disadopt those behaviors with adopters
+      list_disadopt[[q]] <- integer()
+    } else {
+      # selecting 10% of adopters to disadopt
+      list_disadopt[[q]] <- sample(adopters, ceiling(0.10 * length(adopters)))
+    }
+  }
+  return(list_disadopt)
+}
+
+diffnet_random_dis <- rdiffnet(seed.graph = graph, t = 10, disadopt = random_dis,
+                      seed.p.adopt = list(0.1, 0.1))
+
+
 ```
 
 # `exposure()` examples