Skip to content

Commit 1efc0be

Browse files
aoliveramgvegayon
andauthored
split_behaviors - function (#51)
* Adding myself to the project * Some discussion about the dimensions of ans (exposure calculation) * just fixing a paragraph in Ego exposure * looking as.vector things * out object from exposure_for() * More dimensional analysis. Changes to avoid ambiguous names * stats.R fixed * out object (in exposure_for() function) now allows q diff processes * Working forms of .exposure, exposure_for, and exposure.list * updates for .exposure and exposure.list functions * correcting labels of variables * Fixing tests of diffnet * changes to exposure.list() to allow arrays of cumadopt. Add multidiff-test-discussion too. * aditional test -multidiffusion exposure calculations- * updating to Steps 1.1 (initial adopters) and 1.2 (finding seed nodes) in rdiffnet function * updating cumadopt, exposure simulation, and toa for multi-diff processes * adding a set of tests for rdiffnet_validate_args function * rdiffnet function updated to allow multi-diff. An small error in rdiffnet_check_seed_graph fixed. * generalization of rdiffnet_make_threshold function. Some others modification following the merge of the 41... branch * lot of work in new_diffnet and toa_mat functions. New tests for rdiffnet_make_threshold. Some modification in rdiffnet too. Not expecting to work yet. * changes in new_diffnet and toa_mat. Now all the original tests for those functions are pass. * updating rdiffnet_validate_args to allow objects seed.nodes different from -list-. For example: rdiffnet(100,10, seed.p.adopt = list(.1, .05)), or adding seed.nodes=c(1,2,3,4), seed.nodes=random, or seed.nodes=c(random,central). Respective tests added. * rdiffnet now allow multiple diff, showing the results. There is still work to be done to display a line saying 'number of behaviors', and to fix the summary() function. * rdiffnet now allow multiple diff, showing the results. There is still work to be done to display a line saying 'number of behaviors', and to fix the summary() function. * Now rdiffnet allow multiple diff, and shows the name -Behavior-, -Num of behaviors-, and * some minor changes in summary.diffnet * advances in summary.diffnet() for multi-diff, but this will be change to something more simple later * changes in exposure.list and exposure_for to allow personalized attrs in multi-diff * minor changes in toa_mat * now new_diffnet sets the num_of behavior internally * more changes to toa_mat to compute num_of_adoption on more classes * now toa_mat can compute adopt and cumadopt from diffnet (multiple) and matrix objects. The same tests for single behavior were adapted. * all comments were addressed, except -behavior- as a vector. * checking the status of "dynamic" and "static" graphs. * draft of split_behaviors(), with tests. * a buch of things: 1. new test for toa_diff with diffnet obj as input, 2. modifications to toa_diff, now allowing for matrix and multiple-diff diffnet obj, 3. tests for toa_diff with multi-diff inputs, 4. adding split_behavior as new function in rdiffnet, and 5. adding tests for split_behaviors in test-rdiffnet * improving readability of toa_diff * Adding disadopt * Removing weird code * Adding prototype of disadopt * Adding missing file * saving local changes * changes to toa in rdiffnet. Now the test -Disadoption works- actually works. Nevertheless, there are a couple of failures that we have to fix. * Add something to the vignet, and modifications to rdiffnet, in calculating toa * Adding missing is.na() when checking new adopters * Adding the specific q, is.na(toa[,q]). Now works. * Fixing summary.diffnet() for multi-diff * Updating documentation for exposure() * Adding split_behavior for NAMESPACE * Add -behavior- to be splitted in split_behavior * Example for split_behavior documentation * Adding documentation and examples to rdiffnet * More documentation to split_behaviors and new_diffnet * Updating documentation for toa_mat * Adding documentation for rdiffnet, with random disadoption example * Updating toa_diff documentation --------- Co-authored-by: George G. Vega Yon <g.vegayon@gmail.com>
1 parent 78e2a44 commit 1efc0be

37 files changed

+1282
-278
lines changed

DESCRIPTION

+1-1
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ Suggests:
5151
survival
5252
VignetteBuilder: knitr
5353
LinkingTo: Rcpp, RcppArmadillo
54-
RoxygenNote: 7.2.3
54+
RoxygenNote: 7.3.1
5555
Encoding: UTF-8
5656
URL: https://github.com/USCCANA/netdiffuseR,
5757
https://USCCANA.github.io/netdiffuseR/

NAMESPACE

+1
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,7 @@ export(rgraph_ws)
173173
export(ring_lattice)
174174
export(round_to_seq)
175175
export(select_egoalter)
176+
export(split_behaviors)
176177
export(struct_equiv)
177178
export(struct_test)
178179
export(struct_test_asymp)

R/adjmat.r

+145-38
Original file line numberDiff line numberDiff line change
@@ -396,35 +396,19 @@ adjmat_to_edgelist.list <- function(graph, undirected, keep.isolates) {
396396
return(cbind(edgelist, times=times))
397397
}
398398

399-
# # Benchmark with the previous version
400-
# library(microbenchmark)
401-
# library(netdiffuseR)
402-
#
403-
# dat <- as.data.frame(cbind(edgelist, w))
404-
# colnames(dat) <- c('ego','alter','tie')
405-
# microbenchmark(
406-
# adjmatbuild(dat,n,1:n),
407-
# edgelist_to_adjmat(edgelist, w), times=100)
408-
#
409-
# old <- adjmatbuild(dat[,-3],n,1:n)
410-
# new <- (edgelist_to_adjmat(unique(edgelist), undirected = FALSE))[,,1]
411-
# arrayInd(which(old!=new), dim(old), dimnames(old))
412-
#
413-
# ## Dynamic
414-
# microbenchmark(
415-
# adjByTime(cbind(year=times,dat),n,max(times)),
416-
# edgelist_to_adjmat(edgelist, w, times), times=100)
417-
418399
#' Time of adoption matrix
419400
#'
420-
#' Creates two matrices recording times of adoption of the innovation. One matrix
401+
#' For a single behavior, creates two matrices recording times of adoption of the innovation. One matrix
421402
#' records the time period of adoption for each node with zeros elsewhere. The
422403
#' second records the cumulative time of adoption such that there are ones for
423-
#' the time of adoption and every time period thereafter.
424-
#'
425-
#' @param obj Either an integer vector of size \eqn{n} containing time of adoption of the innovation,
426-
#' or a \code{\link{diffnet}} object.
427-
#' @param labels Character vector of size \eqn{n}. Labels (ids) of the vertices.
404+
#' the time of adoption and every time period thereafter. For \eqn{Q} behaviors,
405+
#' creates a list of length \eqn{Q}, where each element contains those two
406+
#' matrices for each behavior.
407+
#'
408+
#' @param obj Either an integer vector of length \eqn{n} containing time of adoption
409+
#' of the innovation, a matrix of size \eqn{n \times Q} (for multiple \eqn{Q} behaviors), or
410+
#' a \code{\link{diffnet}} object (both for single or multiple behaviors).
411+
#' @param labels Character vector of length \eqn{n}. Labels (ids) of the vertices.
428412
#' @param t0 Integer scalar. Sets the lower bound of the time window (e.g. 1955).
429413
#' @param t1 Integer scalar. Sets the upper bound of the time window (e.g. 2000).
430414
#' @details
@@ -446,6 +430,12 @@ adjmat_to_edgelist.list <- function(graph, undirected, keep.isolates) {
446430
#' 2005 - 2000 + 1 = 6 columns instead of 2005 - 2001 + 1 = 5 columns, with the
447431
#' first column of the two matrices containing only zeros (as the first adoption
448432
#' happend after the year 2000).
433+
#'
434+
#' For multiple behaviors, the input can be a matrix or a \code{diffnet} object.
435+
#' In this case, the output will be a list, with each element replicating the output
436+
#' for a single diffusion: a matrix recording the time period of adoption for
437+
#' each node, and a second matrix with ones from the moment the node adopts the behavior.
438+
#'
449439
#' @examples
450440
#' # Random set of times of adoptions
451441
#' times <- sample(c(NA, 2001:2005), 10, TRUE)
@@ -454,14 +444,32 @@ adjmat_to_edgelist.list <- function(graph, undirected, keep.isolates) {
454444
#'
455445
#' # Now, suppose that we observe the graph from 2000 to 2006
456446
#' toa_mat(times, t0=2000, t1=2006)
447+
#'
448+
#' # For multiple behaviors, the input can be a matrix..
449+
#' times_1 <- c(2001L, 2004L, 2003L, 2008L)
450+
#' times_2 <- c(2001L, 2005L, 2006L, 2008L)
451+
#' times <- matrix(c(times_1, times_2), nrow = 4, ncol = 2)
452+
#'
453+
#' toa <- toa_mat(times)
454+
#' toa[[1]]$adopt # time period of adoption for the first behavior
455+
#'
456+
#' #.. or a diffnet object
457+
#' graph <- lapply(2001:2008, function(x) rgraph_er(4))
458+
#' diffnet <- new_diffnet(graph, times)
459+
#'
460+
#' toa <- toa_mat(diffnet)
461+
#' toa[[1]]$cumadopt # cumulative adoption matrix for the first behavior
462+
457463
#'
458464
#' @export
459-
#' @return A list of two \eqn{n \times T}{n x T}
460-
#' \item{\code{cumadopt}}{has 1's for all years in which a node indicates having the innovation.}
461-
#' \item{\code{adopt}}{has 1's only for the year of adoption and 0 for the rest.}
465+
#' @return For a single behavior, a list of two \eqn{n \times T}{n x T}:
466+
#' \item{\code{cumadopt}}{ has 1's for all years in which a node indicates having the innovation.}
467+
#' \item{\code{adopt}}{ has 1's only for the year of adoption and 0 for the rest.}
468+
#' For \eqn{Q} behaviors, a list of length \eqn{Q}, each element containing
469+
#' \code{cumadopt} ans \code{adopt} matrices.
462470
#' @keywords manip
463471
#' @include graph_data.r
464-
#' @author George G. Vega Yon & Thomas W. Valente
472+
#' @author George G. Vega Yon, Thomas W. Valente, and Aníbal Olivera M.
465473
toa_mat <- function(obj, labels=NULL, t0=NULL, t1=NULL) {
466474

467475
if (inherits(obj, "matrix")) {
@@ -581,33 +589,132 @@ toa_mat.integer <- function(times, labels=NULL,
581589

582590
#' Difference in Time of Adoption (TOA) between individuals
583591
#'
584-
#' Creates \eqn{n \times n}{n * n} matrix indicating the difference in times of adoption between
585-
#' each pair of nodes
592+
#' Creates an \eqn{n \times n}{n * n} matrix, or for \eqn{Q}{Q} behaviors, a list
593+
#' of length \eqn{Q}{Q} containing \eqn{n \times n}{n * n} matrices, that indicates
594+
#' the difference in adoption times between each pair of nodes.
586595
#' @inheritParams toa_mat
587-
#' @details Each cell ij of the resulting matrix is calculated as \eqn{toa_j - toa_i}{%
596+
#' @details Each cell \eqn{ij}{ij} of the resulting matrix is calculated as \eqn{toa_j - toa_i}{%
588597
#' toa(j) - toa(i)}, so that whenever its positive it means that the j-th individual (alter)
589598
#' adopted the innovation sooner.
590-
#' @return An \eqn{n \times n}{n * n} symmetric matrix indicating the difference in times of
599+
#' @return An \eqn{n \times n}{n * n} anti-symmetric matrix (or a list of them,
600+
#' for \eqn{Q}{Q} behaviors) indicating the difference in times of
591601
#' adoption between each pair of nodes.
592602
#' @export
593603
#' @examples
604+
#' # For a single behavior -----------------------------------------------------
605+
#'
594606
#' # Generating a random vector of time
595607
#' set.seed(123)
596608
#' times <- sample(2000:2005, 10, TRUE)
597609
#'
598610
#' # Computing the TOA differences
599611
#' toa_diff(times)
612+
#'
613+
#' # For Q=2 behaviors ---------------------------------------------------------
614+
#'
615+
#' # Generating a matrix time
616+
#'
617+
#' times_1 <- c(2001L, 2004L, 2003L, 2008L)
618+
#' times_2 <- c(2001L, 2005L, 2006L, 2008L)
619+
#' times <- matrix(c(times_1, times_2), nrow = 4, ncol = 2)
620+
#'
621+
#' # Computing the TOA differences
622+
#' toa_diff(times)
623+
#'
624+
#' # Or, from a diffnet object
625+
#'
626+
#' graph <- lapply(2001:2008, function(x) rgraph_er(4))
627+
#' diffnet <- new_diffnet(graph, times)
628+
#'
629+
#' # Computing the TOA differences
630+
#' toa_diff(diffnet)
631+
#'
632+
633+
#'
600634
#' @keywords manip
601635
#' @include graph_data.r
602-
#' @author George G. Vega Yon & Thomas W. Valente
636+
#' @author George G. Vega Yon, Thomas W. Valente, and Aníbal Olivera M.
603637
toa_diff <- function(obj, t0=NULL, labels=NULL) {
604638

605639
# Calculating t0 (if it was not provided)
606-
if (!inherits(obj, "diffnet") && !length(t0))
640+
if (!inherits(obj, "diffnet") && !length(t0)){
607641
t0 <- as.integer(min(obj, na.rm = TRUE))
608-
else
609-
t0 <- obj$meta$pers[1]
642+
} else {
643+
t0 <- obj$meta$pers[1]}
644+
645+
# determining num_of_behavior and prepare for multi-diffusion
646+
num_of_behavior <- 1
647+
multiple <- FALSE
648+
649+
if (inherits(obj, "matrix")) { # multiple
650+
num_of_behavior <- ncol(obj)
651+
obj <- lapply(asplit(obj, MARGIN = 2), as.integer)
652+
multiple <- TRUE
653+
} else if (inherits(obj, "diffnet")) {
654+
if (inherits(obj$toa, "matrix")) { # multiple
655+
num_of_behavior <- ncol(obj$toa)
656+
obj <- split_behaviors(obj)
657+
multiple <- TRUE
658+
}
659+
}
660+
661+
if (multiple) {
662+
out_list <- lapply(seq_len(num_of_behavior), function(q) toa_diff.unique(obj[[q]], t0))
663+
return(out_list)
664+
} else {
665+
return(toa_diff.unique(obj, t0))
666+
}
667+
}
668+
669+
#
670+
#
671+
# if (multiple) {
672+
# for (q in 1:ncol(obj$toa)) {
673+
#
674+
#
675+
# # Calculating t0 (if it was not provided)
676+
# if (!inherits(obj, "diffnet") && !length(t0)) {
677+
# t0 <- as.integer(min(obj[,q], na.rm = TRUE))
678+
# } else {
679+
# t0 <- obj$meta$pers[1]}
680+
#
681+
# # Computing the difference
682+
# if (inherits(obj, "integer")) {
683+
# out <- toa_diff_cpp(obj - t0 + 1L)
684+
# } else if (inherits(obj, "numeric")) {
685+
# warning("coercing -obj- to integer.")
686+
# out <- toa_diff_cpp(as.integer(obj) - t0 + 1L)
687+
# } else if (inherits(obj, "diffnet")) {
688+
# out <- toa_diff_cpp(obj$toa - t0 + 1L)
689+
# } else stop("No method defined for class -",class(obj),"-")
690+
#
691+
# out
692+
#
693+
# }
694+
#
695+
#
696+
# } else {
697+
# # Calculating t0 (if it was not provided)
698+
# if (!inherits(obj, "diffnet") && !length(t0))
699+
# t0 <- as.integer(min(obj, na.rm = TRUE))
700+
# else
701+
# t0 <- obj$meta$pers[1]
702+
#
703+
# # Computing the difference
704+
# if (inherits(obj, "integer")) {
705+
# out <- toa_diff_cpp(obj - t0 + 1L)
706+
# } else if (inherits(obj, "numeric")) {
707+
# warning("coercing -obj- to integer.")
708+
# out <- toa_diff_cpp(as.integer(obj) - t0 + 1L)
709+
# } else if (inherits(obj, "diffnet")) {
710+
# out <- toa_diff_cpp(obj$toa - t0 + 1L)
711+
# } else stop("No method defined for class -",class(obj),"-")
712+
#
713+
# return(out)
714+
# }
715+
# }
610716

717+
toa_diff.unique <- function(obj, t0) {
611718
# Computing the difference
612719
if (inherits(obj, "integer")) {
613720
out <- toa_diff_cpp(obj - t0 + 1L)
@@ -618,7 +725,7 @@ toa_diff <- function(obj, t0=NULL, labels=NULL) {
618725
out <- toa_diff_cpp(obj$toa - t0 + 1L)
619726
} else stop("No method defined for class -",class(obj),"-")
620727

621-
out
728+
return(out)
622729
}
623730

624731
# @rdname toa_diff

R/diffnet-class.r

+23-7
Original file line numberDiff line numberDiff line change
@@ -321,16 +321,18 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
321321

322322
#' Creates a \code{diffnet} class object
323323
#'
324-
#' \code{diffnet} objects contain difussion networks. With adjacency
325-
#' matrices and time of adoption (toa) vector as its main components, most of the
326-
#' package's functions have methods for this class of objects.
324+
#' \code{diffnet} objects contain diffusion networks. With adjacency
325+
#' matrices and time of adoption (toa) vector (or matrix, for multiple behavior diffusion),
326+
#' as its main components, most of the package's functions have methods for this class of objects.
327327
#'
328328
#' @templateVar dynamic TRUE
329329
#' @templateVar undirected TRUE
330330
#' @templateVar self TRUE
331331
#' @templateVar multiple TRUE
332332
#' @template graph_template
333-
#' @param toa Numeric vector of size \eqn{n}. Times of adoption.
333+
#' @param toa Numeric vector of size \eqn{n}. Times of adoption. For \eqn{Q}{Q}
334+
#' multiple behavior diffusion, \code{toa} must be a matrix \eqn{n \times Q}{n * Q}
335+
#' (see \code{\link{rdiffnet}}, examples of multiple behavior diffusion).
334336
#' @param t0 Integer scalar. Passed to \code{\link{toa_mat}}.
335337
#' @param t1 Integer scalar. Passed to \code{\link{toa_mat}}.
336338
#' @param ... Further arguments passed to the jmethod.
@@ -418,6 +420,8 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
418420
#' @aliases diffnet diffnet-class
419421
#' @examples
420422
#'
423+
#' # Creating a diffnet object from TOA (time of adoption) ---------------------
424+
#'
421425
#' # Creating a random graph
422426
#' set.seed(123)
423427
#' graph <- rgraph_ba(t=9)
@@ -435,6 +439,16 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
435439
#' # Plotting slice 4
436440
#' plot(diffnet, t=4)
437441
#'
442+
#' # A diffnet object from TOA of multiple behaviors ---------------------------
443+
#'
444+
#' # TOA for two behaviors
445+
#' toa_matrix <- matrix(sample(c(2001L:2005L,NA), 20, TRUE), ncol = 2)
446+
#'
447+
#' # Creating diffnet object
448+
#' diffnet_multi <- new_diffnet(graph, toa_matrix)
449+
#' diffnet_multi
450+
#' summary(diffnet_multi)
451+
#'
438452
#' # ATTRIBUTES ----------------------------------------------------------------
439453
#'
440454
#' # Retrieving attributes
@@ -491,9 +505,11 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
491505
#' A list of class \code{diffnet} with the following elements:
492506
#' \item{graph}{A list of length \eqn{T}. Containing sparse square matrices of size \eqn{n}
493507
#' and class \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}}.}
494-
#' \item{toa}{An integer vector of size \eqn{T} with times of adoption.}
508+
#' \item{toa}{An integer vector of length \eqn{n} with times of adoption. When \eqn{Q}{Q} multiple
509+
#' behavior diffusion is selected, a matrix of size \eqn{n \times Q}{n * Q}}.
495510
#' \item{adopt, cumadopt}{Numeric matrices of size \eqn{n\times T}{n*T} as those returned
496-
#' by \code{\link{toa_mat}}.}
511+
#' by \code{\link{toa_mat}}. For \eqn{Q}{Q} multiple behavior diffusion, \code{adopt} and \code{cumadopt}
512+
#' become a list of \eqn{n\times T}{n*T} elements, with \eqn{Q}{Q} elements.}
497513
#' \item{vertex.static.attrs}{If not NULL, a data frame with \eqn{n} rows with vertex static
498514
#' attributes.}
499515
#' \item{vertex.dyn.attrs}{A list of length \eqn{T} with data frames containing vertex attributes
@@ -514,7 +530,7 @@ check_as_diffnet_attrs <- function(attrs, meta, is.dynamic, id.and.per.vars=NULL
514530
#' \item \code{behavior}: Character scalar.
515531
#' }
516532
#' }
517-
#' @author George G. Vega Yon
533+
#' @author George G. Vega Yon & Aníbal Olivera M.
518534
#' @name diffnet-class
519535
NULL
520536

0 commit comments

Comments
 (0)