USCCANA · gvegayon · Nov 22, 2024 · Oct 29, 2024 · Oct 30, 2024 · Oct 31, 2024
diff --git a/R/adjmat.r b/R/adjmat.r
@@ -464,29  464,59 @@ adjmat_to_edgelist.list <- function(graph, undirected, keep.isolates) {
 #' @author George G. Vega Yon & Thomas W. Valente
 toa_mat <- function(obj, labels=NULL, t0=NULL, t1=NULL) {
 
   if (inherits(obj, "matrix")) {
     num_of_behaviors <- dim(obj)[2]
   } else if (inherits(obj, "diffnet")){
     if (inherits(obj$toa, "matrix")) {
       num_of_behaviors <- dim(obj$toa)[2]}
     else {num_of_behaviors <- 1}
   } else {num_of_behaviors <- 1}
 
   if (!inherits(obj, "diffnet")) {
     if (!length(t0)) t0 <- min(obj, na.rm = TRUE)
     if (!length(t1)) t1 <- max(obj, na.rm = TRUE)
   }
 
-  cls <- class(obj)
-  ans <- if ("numeric" %in% cls) {
-    toa_mat.numeric(obj, labels, t0, t1)
-    } else if ("integer" %in% cls) {
-    toa_mat.integer(obj, labels, t0, t1)
-    } else if  ("diffnet" %in% cls) {
-    with(obj, list(adopt=adopt,cumadopt=cumadopt))
-    } else
-      stopifnot_graph(obj)
-
-
-  if (inherits(obj, "diffnet")) {
-    dimnames(ans$adopt) <- with(obj$meta, list(ids,pers))
-    dimnames(ans$cumadopt) <- with(obj$meta, list(ids,pers))
   ans <- list()
   if (num_of_behaviors == 1) {
     cls <- class(obj)
     ans[[1]] <- if ("numeric" %in% cls) {
             toa_mat.numeric(obj, labels, t0, t1)
             } else if ("integer" %in% cls) {
             toa_mat.integer(obj, labels, t0, t1)
             } else if  ("diffnet" %in% cls) {
             with(obj, list(adopt=adopt,cumadopt=cumadopt))
             } else {
               stopifnot_graph(obj)
             }
   } else {
     for (q in 1:num_of_behaviors) {
       ans[[q]] <- if ("matrix" %in% class(obj)) {
               if ("integer" %in% class(obj[,q])){
                 toa_mat.integer(obj[,q], labels, t0, t1)
               } else if ("numeric" %in% class(obj[,q])) { # Why included?
                 toa_mat.numeric(obj[,q], labels, t0, t1)
               }
             } else if  ("diffnet" %in% class(obj)) { # Why included?
               with(obj, list(adopt=adopt[[q]],cumadopt=cumadopt[[q]]))
             } else {
               stopifnot_graph(obj[,q])
             }
     }
   }
 
   for (q in 1:num_of_behaviors) {
     if (inherits(obj, "diffnet")) {
       dimnames(ans[[q]]$adopt) <- with(obj$meta, list(ids,pers))
       dimnames(ans[[q]]$cumadopt) <- with(obj$meta, list(ids,pers))
     }
   }
 
-  return(ans)
   if (num_of_behaviors==1) {
     return(ans[[1]])
   } else {
     return(ans)
   }
 }
 
 toa_mat.default <- function(per, t0, t1) {

diff --git a/R/diffnet-class.r b/R/diffnet-class.r
@@ -556,49  556,94 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm
     return(graph)
   }
 
   # Step 0.1: Setting num_of_behavior ------------------------------------------
 
   if (inherits(toa, "matrix")) {
     num_of_behaviors <- dim(toa)[2]
   } else {num_of_behaviors <- 1}
 
   # Step 1.1: Check graph ------------------------------------------------------
   meta <- classify_graph(graph)
   if (meta$type=="static")
     warning("-graph- is static and will be recycled (see ?new_diffnet).")
 
 
   # Step 1.2: Checking that lengths fit
-  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).")
-
-  # Step 2.1: Checking class of TOA and coercing if necesary -------------------
-  if (!inherits(toa, "integer")) {
-    warning("Coercing -toa- into integer.")
-    toa <- as.integer(toa)
   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).") }
   }
 
   # 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.2: Checking names of toa
-  if (!length(names(toa)))
-    names(toa) <- meta$ids
   if (num_of_behaviors==1) {
     if (!length(names(toa))) {names(toa) <- meta$ids}
   } else {
     if (!length(rownames(toa))) { # Not necessary? toa_mat(toa, labels = meta$ids, t0=t0, t1=t1) already has labels
       rownames(toa) <- meta$ids
     }
   }
 
   # Step 3.1: Creating Time of adoption matrix ---------------------------------
   mat <- toa_mat(toa, labels = meta$ids, t0=t0, t1=t1)
 
   # Step 3.2: Verifying dimensions and fixing meta$pers
 
-  if (meta$type != "static") {
-    tdiff <- meta$nper - ncol(mat[[1]])
-    if (tdiff < 0)
-      stop("Range of -toa- is bigger than the number of slices in -graph- (",
-           ncol(mat[[1]]), " 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]]), " and ", length(graph) ," respectively). ",
-           "Please provide lower and upper boundaries for the values in -toa- ",
-           "using -t0- and -t- (see ?toa_mat).")
   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.")
       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).")
     } else {
       graph <- lapply(1:ncol(mat$adopt), function(x) methods::as(graph, "dgCMatrix"))
       meta  <- classify_graph(graph)
     }
   } else {
-    graph <- lapply(1:ncol(mat[[1]]), function(x) methods::as(graph, "dgCMatrix"))
-    meta  <- classify_graph(graph)
     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.")
       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).")
     } else {
       graph <- lapply(1:ncol(mat[[1]]$adopt), function(x) methods::as(graph, "dgCMatrix"))
       meta  <- classify_graph(graph)
     }
   }
 
-  meta$pers <- as.integer(colnames(mat$adopt))
   # labels of the time periods
   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
 
   # Step 4.0: Checking the attributes ------------------------------------------
 
@@ -629,21  674,40 @@ new_diffnet <- function(graph, toa, t0=min(toa, na.rm = TRUE), t1=max(toa, na.rm
   meta$multiple   <- multiple
   meta$name       <- ifelse(!length(name), "", ifelse(is.na(name), "",
                                                       as.character(name)))
-  meta$behavior   <- ifelse(!length(behavior), "", ifelse(is.na(behavior), "",
-                                                          as.character(behavior)))
   meta$version    <- utils::packageVersion("netdiffuseR")
 
   # Removing dimnames
   graph                  <- Map(function(x) Matrix::unname(x), x=graph)
-  dimnames(toa)          <- NULL
-  dimnames(mat$adopt)    <- NULL
-  dimnames(mat$cumadopt) <- NULL
   #dimnames(toa)          <- NULL
 
   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 = ", ")
 
     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 = mat$adopt,
-    cumadopt = mat$cumadopt,
     adopt = adopt,
     cumadopt = cumadopt,
     # Attributes
     vertex.static.attrs = vertex.static.attrs,
     vertex.dyn.attrs    = vertex.dyn.attrs,