version 1.5.3

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: tnam
+Version: 1.5.3
+Date: 2015-09-20
+Title: Temporal Network Autocorrelation Models (TNAM)
+Authors@R: c(person(given = "Philip", family = "Leifeld", email = "philip.leifeld@eawag.ch", role = c("aut", "cre")), person(given = c("Skyler", "J."), family = "Cranmer", email = "cranmer.12@osu.edu", role = "ctb"))
+Description: Temporal and cross-sectional network autocorrelation models (TNAM).
+Depends: R (>= 2.14.0), xergm.common (>= 1.5.4)
+Imports: methods, utils, stats, network, sna, igraph, vegan, lme4 (>=
+        1.0), Rcpp (>= 0.11.0)
+Suggests: xergm, texreg, statnet
+License: GPL (>= 2)
+LinkingTo: Rcpp
+Author: Philip Leifeld [aut, cre],
+  Skyler J. Cranmer [ctb]
+Maintainer: Philip Leifeld <philip.leifeld@eawag.ch>
+Repository: CRAN
+Repository/R-Forge/Project: xergm
+Repository/R-Forge/Revision: 148
+Repository/R-Forge/DateTimeStamp: 2015-09-20 18:04:28
+Date/Publication: 2015-09-23 02:33:33
+NeedsCompilation: yes
+Packaged: 2015-09-20 18:25:35 UTC; rforge

MD5

@@ -0,0 +1,12 @@
+f2e219fe49e5e91ae5370596a1cbeffe *DESCRIPTION
+ee6f94bce47ea5cb1fd5b0bad4beaf7b *NAMESPACE
+66b78884ca62067e9a960c5a4cc65e10 *R/RcppExports.R
+915e6acdf8fcfd9a1037040a710611d7 *R/checkDataTypes.R
+d174225ba89f0ee9eaa2e4314d11c486 *R/tnam-terms.R
+bfc750ae7891de3295a2831f5e23bab6 *R/tnam.R
+728a2ab1bfe457105be882599f451521 *inst/CITATION
+55743a22c17a0ed63ce834b76a4940b3 *man/tnam-package.Rd
+9a4a942b3a2f7b3b10331600a0e7dba2 *man/tnam-terms.Rd
+96768fbebac8baed3cc13d7b5bf4aba3 *man/tnam.Rd
+e5c8de4e12abf9d6216c2eadfbb7653f *src/RcppExports.cpp
+0d926b73742afd800e53b55cdc4f43cb *src/tnam.cpp

NAMESPACE

@@ -0,0 +1,35 @@
+useDynLib(tnam)
+import("methods")
+import("utils")
+import("network")
+importFrom("stats", "dist", "gaussian", "glm", "na.omit")
+import("xergm.common")
+importFrom("sna", "gden")
+importFrom("sna", "sedist")
+importFrom("sna", "geodist")
+importFrom("sna", "evcent")
+importFrom("sna", "degree")
+importFrom("sna", "betweenness")
+importFrom("sna", "flowbet")
+importFrom("sna", "closeness")
+importFrom("sna", "infocent")
+importFrom("sna", "loadcent")
+importFrom("sna", "bonpow")
+importFrom("sna", "clique.census")
+importFrom("lme4", "lmer")
+importFrom("lme4", "glmer")
+importFrom("vegan", "vegdist")
+importFrom("igraph", "graph.adjacency")
+importFrom("igraph", "transitivity")
+importFrom("Rcpp", evalCpp)
+export("netlag")
+export("weightlag")
+export("interact")
+export("covariate")
+export("structsim")
+export("centrality")
+export("degreedummy")
+export("clustering")
+export("cliquelag")
+export("tnamdata")
+export("tnam")

R/RcppExports.R

@@ -0,0 +1,7 @@
+# This file was generated by Rcpp::compileAttributes
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+netLagCppLoop <- function(mat, pdistmat, pathdist, decay, y, normalization, reciprocal) {
+    .Call('tnam_netLagCppLoop', PACKAGE = 'tnam', mat, pdistmat, pathdist, decay, y, normalization, reciprocal)
+}
+

R/checkDataTypes.R

@@ -0,0 +1,243 @@
+# check if 'y' and 'networks' are compatible and preprocess them if necessary
+checkDataTypes <- function(y, networks = NULL, lag = 0) {
+
+  # error message if both are NULL
+  if (is.null(y) && is.null(networks)) {
+    stop("No 'y' and 'networks' arguments were provided.")
+  }
+
+  # make sure that 'y' is a list
+  stopmsg <- paste0("The data type of the 'y' argument is '", class(y), 
+      "'. 'y' must be provided as a numeric vector, a list of numeric ", 
+      "vectors, or a data frame with numeric columns.")
+  if (is.null(y)) {
+    # leave NULL as is
+  } else if (class(y) == "list") {
+    # OK
+  } else if (class(y) == "data.frame") {
+    # convert to a list of vectors
+    time.steps <- ncol(y)
+    y.copy <- y
+    y <- list()
+    for (i in 1:ncol(y.copy)) {
+      y[[i]] <- y.copy[, i]
+      names(y[[i]]) <- rownames(y.copy)
+    }
+    rm(y.copy)
+  } else if (class(y) == "matrix") {
+    stop(stopmsg)
+  } else if (class(y) == "integer") {
+    current.names <- names(y)
+    y <- as.numeric(y)
+    names(y) <- current.names
+    y <- list(y)  # wrap y in list
+  } else if (class(y) == "numeric") {
+    y <- list(y)  # wrap y in list
+  } else if (class(y) == "character") {
+    y <- list(y)  # wrap y in list
+  } else {
+    tryCatch({  # try to convert to numeric and wrap in list
+      current.names <- names(y)
+      y <- as.numeric(y)
+      names(y) <- current.names
+      y <- list(y)
+    }, error = function(e) {
+      stop(stopmsg)
+    })
+  }
+
+  # check validity of elements of 'y' list and convert if necessary
+  if (!is.null(y)) {
+    for (i in 1:length(y)) {
+      cl <- class(y[[i]])
+      stopmsg <- paste0("At t=", i, ", 'y' contains ", cl, " objects. 'y' ", 
+          "must be provided as a numeric vector, a list of numeric vectors, ", 
+          "or a data frame with numeric columns.")
+      if (is.integer(y[[i]])) {
+        current.names <- names(y[[i]])
+        y[[i]] <- as.numeric(y[[i]])
+        names(y[[i]]) <- current.names
+      } else if (cl == "character") {
+        stop(stopmsg)
+      } else {
+        tryCatch({  # try to convert to numeric
+          current.names <- names(y[[i]])
+          y[[i]] <- as.numeric(y[[i]])
+          names(y[[i]]) <- current.names
+        }, error = function(e) {
+          stop(stopmsg)
+        })
+      }
+    }
+  }
+
+  # make sure network matrices are in a list
+  if (is.null(networks)) {
+    # leave NULL as is
+  } else if (class(networks) == "matrix") {
+    # OK, but wrap in list
+    networks <- list(networks)
+  } else if (class(networks) == "network") {
+    # cast as matrix object and wrap in list
+    networks <- list(as.matrix(networks))
+  } else if (class(networks) == "list") {
+    # OK
+  } else {
+    # wrap in list
+    networks <- list(networks)
+  }
+
+  # check validity of network matrices and their cells and convert if necessary
+  if (!is.null(networks)) {
+    for (i in 1:length(networks)) {
+      if (class(networks[[i]]) != "matrix") {
+        # try to convert element to matrix
+        tryCatch({
+          networks[[i]] <- as.matrix(networks[[i]])
+        }, error = function(e) {
+          stop(paste0("At t=", i, ", the object in the 'networks' list could ", 
+              "not be converted to a matrix object."))
+        })
+      }
+      if (storage.mode(networks[[i]]) != "numeric") {
+        # try to set numeric storage mode
+        tryCatch({
+          storage.mode(networks[[i]]) <- "numeric"
+        }, error = function(e) {
+          stop(paste0("At t=", i, ", the matrix in the 'networks' list does ", 
+              "not contain numeric values."))
+        })
+      }
+    }
+  }
+
+  # check if length of 'y' and 'networks' is compatible and adjust if necessary
+  if (!is.null(y) && !is.null(networks) && length(y) != length(networks)) {
+    if (length(y) == 1 && length(networks) > 1) {
+      stop(paste("'y' has only one time step, but the network has multiple ", 
+          "time steps."))
+    } else if (length(y) > 1 && length(networks) == 1) {
+      for (i in length(y)) {
+        networks[[i]] <- networks[[1]]  # inflate networks list
+      }
+    } else {
+      stop(paste0("There should be the same number of elements in 'y' and ", 
+          "'networks'. There are ", length(y), " elements in 'y' and ", 
+          length(networks), " elements in 'networks'."))
+    }
+  }
+
+  # check if dimensions and labels match (if present); add labels if not present
+  if (!is.null(y) && !is.null(networks)) {
+    for (i in 1:length(y)) {
+      # compare dimensions; mutually adjust if necessary
+      if (length(y[[i]]) != nrow(networks[[i]])) {
+        if (is.null(rownames(networks))) {
+          stop(paste0("The dimensions of 'y' and 'networks' differ at t=", 
+              i, ", and the network (matrix) does not contain row names."))
+        } else if (is.null(names(y[[i]]))) {
+          stop(paste0("The dimensions of 'y' and 'networks' differ at t=", 
+              i, ", and the elements in 'y' are not named."))
+        } else {  # try to adjust dimensions of 'y' and 'networks'
+          warning(paste0("Dimensions of 'y' and 'networks' do not match at ", 
+              "t=", i, ". Trying to adjust them mutually."))
+          y[[i]] <- xergm.common::adjust(y[[i]], networks[[i]], add = FALSE)
+          networks[[i]] <- xergm.common::adjust(networks[[i]], y[[i]], 
+              add = FALSE)
+        }
+      }
+      # complain if labels do not match
+      if (!is.null(names(y[[i]])) && !is.null(rownames(networks[[i]])) && 
+          !all(names(y[[i]]) == rownames(networks[[i]]))) {
+        warning(paste("At t=", i, "the names of 'y' and the row names of", 
+            "'networks' do not match."))
+      }
+      # fix labels; use integers if no labels present at all
+      if (is.null(rownames(networks[[i]])) && !is.null(names(y[[i]]))) {
+        rownames(networks[[i]]) <- names(y[[i]])
+      } else if (is.null(names(y[[i]])) && !is.null(rownames(networks[[i]]))) {
+        names(y[[i]]) <- rownames(networks[[i]])
+      } else if (is.null(rownames(networks[[i]])) && is.null(names(y[[i]]))) {
+        names(y[[i]]) <- 1:length(y[[i]])
+        rownames(networks[[i]]) <- 1:nrow(networks[[i]])
+      }
+    }
+  }
+
+  # if only one of them present, add labels if necessary
+  if (is.null(y)) {
+    for (i in 1:length(networks)) {
+      if (is.null(rownames(networks[[i]]))) {
+        rownames(networks[[i]]) <- 1:nrow(networks[[i]])
+        if (i > 1) {
+          if (nrow(networks[[i]]) != nrow(networks[[i - 1]])) {
+            stop(paste0("No row names in 'networks' at t=", i, ". Tried to ", 
+                "create custom row names, but the dimensions differ from ", 
+                "the previous time point."))
+          }
+          if (!all(rownames(networks[[i]]) == rownames(networks[[i - 1]]))) {
+            stop(paste0("At t=", i, ", the row names of the network matrix ", 
+                "do not match the row names of the previous time step."))
+          }
+        }
+      }
+    }
+  }
+  if (is.null(networks)) {
+    for (i in 1:length(y)) {
+      if (is.null(names(y[[i]]))) {
+        names(y[[i]]) <- 1:length(y[[i]])
+        if (i > 1) {
+          if (length(y[[i]]) != length(y[[i - 1]])) {
+            stop(paste0("No names in 'y' vector at t=", i, ". Tried to ", 
+                "create custom names, but the length differs from ", 
+                "the previous time point."))
+          }
+          if (!all(names(y[[i]]) == names(y[[i - 1]]))) {
+            stop(paste0("At t=", i, ", the names of the 'y' vector ", 
+                "do not match the names of the previous time step."))
+          }
+        }
+      }
+    }
+  }
+
+  # check 'lag'
+  if (!is.null(y)) {
+    n <- length(y)
+  } else {
+    n <- length(networks)
+  }
+  if (!is.numeric(lag)) {
+    stop("The 'lag' argument must be numeric.")
+  } else if (length(lag) > 1) {
+    stop("The 'lag' argument must be of length 1.")
+  } else if (lag < 0) {
+    stop("The 'lag' argument must be >= 0.")
+  } else if (n - lag < 1) {
+    if (n == 1) {
+      stop(paste("A lag of", lag, "was specified, but there is only", 
+          "one time step."))
+    } else {
+      stop(paste("A lag of", lag, "was specified, but there are only", 
+          n, "time steps."))
+    }
+  }
+
+  # save everything in an object and return
+  objects <- list()
+  objects$y <- y
+  objects$networks <- networks
+  objects$time.steps <- n
+  if (!is.null(y)) {
+    objects$n <- lapply(y, length)
+    objects$nodelabels <- unlist(lapply(y, names))
+  } else {
+    objects$n <- lapply(networks, nrow)
+    objects$nodelabels <- unlist(lapply(networks, rownames))
+  }
+  names(objects$nodelabels) <- NULL
+
+  return(objects)
+}
+