R/RcppExports.R

In USCCANA/netdiffuseR: Analysis of Diffusion and Contagion Processes on Networks

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

edgelist_to_adjmat_cpp <- function(edgelist, weights = as.numeric( c()), n = 0L, undirected = FALSE, self = FALSE, multiple = FALSE) {
    .Call(`_netdiffuseR_edgelist_to_adjmat_cpp`, edgelist, weights, n, undirected, self, multiple)
}

adjmat_to_edgelist_cpp <- function(adjmat, undirected = TRUE) {
    .Call(`_netdiffuseR_adjmat_to_edgelist_cpp`, adjmat, undirected)
}

toa_diff_cpp <- function(year) {
    .Call(`_netdiffuseR_toa_diff_cpp`, year)
}

egonet_attrs_cpp <- function(graph, V, outer = TRUE, self = TRUE, valued = TRUE) {
    .Call(`_netdiffuseR_egonet_attrs_cpp`, graph, V, outer, self, valued)
}

approx_geodesicCpp <- function(G, n = 6L, warn = FALSE) {
    .Call(`_netdiffuseR_approx_geodesicCpp`, G, n, warn)
}

infection_cpp <- function(graph, times, normalize = TRUE, K = 1L, r = 0.5, expdiscount = FALSE, n = 0L, valued = FALSE, outgoing = TRUE) {
    .Call(`_netdiffuseR_infection_cpp`, graph, times, normalize, K, r, expdiscount, n, valued, outgoing)
}

susceptibility_cpp <- function(graph, times, normalize = TRUE, K = 1L, r = 0.5, expdiscount = FALSE, n = 0L, valued = FALSE, outgoing = TRUE) {
    .Call(`_netdiffuseR_susceptibility_cpp`, graph, times, normalize, K, r, expdiscount, n, valued, outgoing)
}

select_egoalter_cpp <- function(adjmat_t0, adjmat_t1, adopt_t0, adopt_t1) {
    .Call(`_netdiffuseR_select_egoalter_cpp`, adjmat_t0, adjmat_t1, adopt_t0, adopt_t1)
}

sp_trimatl <- function(x) {
    .Call(`_netdiffuseR_sp_trimatl`, x)
}

sp_diag <- function(x, v) {
    .Call(`_netdiffuseR_sp_diag`, x, v)
}

unif_rand_w_exclusion <- function(n, e) {
    .Call(`_netdiffuseR_unif_rand_w_exclusion`, n, e)
}

sp_as_undirected <- function(x) {
    .Call(`_netdiffuseR_sp_as_undirected`, x)
}

bootnet_fillself <- function(graph, index, E) {
    .Call(`_netdiffuseR_bootnet_fillself`, graph, index, E)
}

#' Distribution over a grid
#'
#' Distribution of pairs over a grid of fix size.
#'
#' @param x Numeric vector of size \eqn{n}
#' @param y Numeric vector of size \eqn{n}
#' @param nlevels Integer scalar. Number of bins to return
#' @details
#'
#' This function ment for internal use only.
#'
#' @export
#' @keywords misc dplot
#' @family visualizations
#' @seealso Used by \code{\link{plot_infectsuscep}}
#' @return Returns a list with three elements
#' \item{x}{Numeric vector of size \code{nlevels} with the class marks for x}
#' \item{y}{Numeric vector of size \code{nlevels} with the class marks for y}
#' \item{z}{Numeric matrix of size \code{nlevels} by \code{nlevels} with the distribution %
#' of the elements in terms of frequency}
#' @section Examples:
#' \preformatted{
#' # Generating random vectors of size 100
#' x <- rnorm(100)
#' y <- rnorm(100)
#'
#' # Calculating distribution
#' grid_distribution(x,y,20)
#' }
grid_distribution <- function(x, y, nlevels = 100L) {
    .Call(`_netdiffuseR_grid_distribution`, x, y, nlevels)
}

#' Compute ego/alter edge coordinates considering alter's size and aspect ratio
#'
#' Given a graph, vertices' positions and sizes, calculates the absolute positions
#' of the endpoints of the edges considering the plot's aspect ratio.
#'
#' @param graph A square matrix of size \eqn{n}. Adjacency matrix.
#' @param toa Integer vector of size \eqn{n}. Times of adoption.
#' @param x Numeric vector of size \eqn{n}. x-coordinta of vertices.
#' @param y Numeric vector of size \eqn{n}. y-coordinta of vertices.
#' @param vertex_cex Numeric vector of size \eqn{n}. Vertices' sizes in terms
#' of the x-axis (see \code{\link{symbols}}).
#' @param undirected Logical scalar. Whether the graph is undirected or not.
#' @param no_contemporary Logical scalar. Whether to return (compute) edges'
#' coordiantes for vertices with the same time of adoption (see details).
#' @param dev Numeric vector of size 2. Height and width of the device (see details).
#' @param ran Numeric vector of size 2. Range of the x and y axis (see details).
#' @param curved Logical vector.
#' @return A numeric matrix of size \eqn{m\times 5}{m * 5} with the following
#' columns:
#' \item{x0, y0}{Edge origin}
#' \item{x1, y1}{Edge target}
#' \item{alpha}{Relative angle between \code{(x0,y0)} and \code{(x1,y1)} in terms
#' of radians}
#' With \eqn{m} as the number of resulting edges.
#' @details
#'
#' In order to make the plot's visualization more appealing, this function provides
#' a straight forward way of computing the tips of the edges considering the
#' aspect ratio of the axes range. In particular, the following corrections are
#' made at the moment of calculating the egdes coords:
#'
#' \itemize{
#' \item{Instead of using the actual distance between ego and alter, a relative
#' one is calculated as follows
#' \deqn{d'=\left[(x_0-x_1)^2 + (y_0' - y_1')^2\right]^\frac{1}{2}}{d'=sqrt[(x0-x1)^2 + (y0'-y1')^2]}
#' where \eqn{%
#' y_i'=y_i\times\frac{\max x - \min x}{\max y - \min y} }{%
#' yi' = yi * [max(x) - min(x)]/[max(y) - min(y)]}
#' }
#' \item{Then, for the relative elevation angle, \code{alpha}, the relative distance \eqn{d'}
#' is used, \eqn{\alpha'=\arccos\left( (x_0 - x_1)/d' \right)}{\alpha' = acos[ (x0 - x1)/d' ]}}
#' \item{Finally, the edge's endpoint's (alter) coordinates are computed as follows: %
#' \deqn{%
#'   x_1' = x_1 + \cos(\alpha')\times v_1}{%
#'   x1' = x1 + cos(\alpha') * v1
#' }
#' \deqn{%
#'   y_1' = y_1 -+ \sin(\alpha')\times v_1 \times\frac{\max y - \min y}{\max x - \min x} }{%
#'   y1' = y1 -+ sin(\alpha')*[max(y) - min(y)]/[max(x) - min(x)]
#' }
#' Where \eqn{v_1}{v1} is alter's size in terms of the x-axis, and the sign of
#' the second term in \eqn{y_1'}{y1'} is negative iff \eqn{y_0 < y_1}{y0<y1}.
#' }
#' }
#'
#' The same process (with sign inverted) is applied to the edge starting piont.
#' The resulting values, \eqn{x_1',y_1'}{x1',y1'} can be used with the function
#' \code{\link{arrows}}. This is the workhorse function used in \code{\link{plot_threshold}}.
#'
#' The \code{dev} argument provides a reference to rescale the plot accordingly
#' to the device, and former, considering the size of the margins as well (this
#' can be easily fetched via \code{par("pin")}, plot area in inches).
#'
#' On the other hand, \code{ran} provides a reference for the adjustment
#' according to the range of the data, this is \code{range(x)[2] - range(x)[1]}
#' and \code{range(y)[2] - range(y)[1]} respectively.
#'
#' @keywords misc dplot
#' @examples
#' # --------------------------------------------------------------------------
#' data(medInnovationsDiffNet)
#' library(sna)
#'
#' # Computing coordinates
#' set.seed(79)
#' coords <- sna::gplot(as.matrix(medInnovationsDiffNet$graph[[1]]))
#'
#' # Getting edge coordinates
#' vcex <- rep(1.5, nnodes(medInnovationsDiffNet))
#' ecoords <- edges_coords(
#'   medInnovationsDiffNet$graph[[1]],
#'   diffnet.toa(medInnovationsDiffNet),
#'   x = coords[,1], y = coords[,2],
#'   vertex_cex = vcex,
#'   dev = par("pin")
#'   )
#'
#' ecoords <- as.data.frame(ecoords)
#'
#' # Plotting
#' symbols(coords[,1], coords[,2], circles=vcex,
#'   inches=FALSE, xaxs="i", yaxs="i")
#'
#' with(ecoords, arrows(x0,y0,x1,y1, length=.1))
#' @export
edges_coords <- function(graph, toa, x, y, vertex_cex, undirected = TRUE, no_contemporary = TRUE, dev = as.numeric( c()), ran = as.numeric( c()), curved = as.logical( c())) {
    .Call(`_netdiffuseR_edges_coords`, graph, toa, x, y, vertex_cex, undirected, no_contemporary, dev, ran, curved)
}

edges_arrow <- function(x0, y0, x1, y1, height, width, beta = 1.5707963267949, dev = as.numeric( c()), ran = as.numeric( c()), curved = FALSE) {
    .Call(`_netdiffuseR_edges_arrow`, x0, y0, x1, y1, height, width, beta, dev, ran, curved)
}

vertices_coords <- function(x, y, size, nsides, rot, dev = as.numeric( c()), ran = as.numeric( c())) {
    .Call(`_netdiffuseR_vertices_coords`, x, y, size, nsides, rot, dev, ran)
}

rgraph_er_cpp <- function(n = 10L, p = 0.3, undirected = TRUE, weighted = FALSE, self = FALSE) {
    .Call(`_netdiffuseR_rgraph_er_cpp`, n, p, undirected, weighted, self)
}

#' Ring lattice graph
#'
#' Creates a ring lattice with \eqn{n} vertices, each one of degree (at most) \eqn{k}
#' as an undirected graph. This is the basis of \code{\link{rgraph_ws}}.
#' @param n Integer scalar. Size of the graph.
#' @param k Integer scalar. Out-degree of each vertex.
#' @param undirected Logical scalar. Whether the graph is undirected or not.
#' @details when \code{undirected=TRUE}, the degree of each node always
#' even. So if \code{k=3}, then the degree will be \code{2}.
#' @return A sparse matrix of class \code{\link[Matrix:dgCMatrix-class]{dgCMatrix}} of size
#' \eqn{n\times n}{n * n}.
#' @references Watts, D. J., & Strogatz, S. H. (1998). Collective dynamics of
#' “small-world” networks. Nature, 393(6684), 440–2. \doi{10.1038/30918}
#' @export
#' @family simulation functions
ring_lattice <- function(n, k, undirected = FALSE) {
    .Call(`_netdiffuseR_ring_lattice`, n, k, undirected)
}

rewire_endpoints <- function(graph, p, both_ends = FALSE, self = FALSE, multiple = FALSE, undirected = FALSE) {
    .Call(`_netdiffuseR_rewire_endpoints`, graph, p, both_ends, self, multiple, undirected)
}

rewire_swap <- function(graph, nsteps = 100L, self = FALSE, multiple = FALSE, undirected = FALSE, pr_rewire = 0.5) {
    .Call(`_netdiffuseR_rewire_swap`, graph, nsteps, self, multiple, undirected, pr_rewire)
}

rewire_ws <- function(G, K, p = 0.0, self = FALSE, multiple = FALSE) {
    .Call(`_netdiffuseR_rewire_ws`, G, K, p, self, multiple)
}

permute_graph_cpp <- function(x, self = FALSE, multiple = FALSE) {
    .Call(`_netdiffuseR_permute_graph_cpp`, x, self, multiple)
}

rgraph_ba_cpp <- function(graph, dgr, m = 1L, t = 10L, self = TRUE) {
    .Call(`_netdiffuseR_rgraph_ba_cpp`, graph, dgr, m, t, self)
}

rgraph_ba_new_cpp <- function(m0 = 1L, m = 1L, t = 10L, self = TRUE) {
    .Call(`_netdiffuseR_rgraph_ba_new_cpp`, m0, m, t, self)
}

rgraph_sf_homo <- function(eta, graph, dgr, m = 1L, t = 10L, self = TRUE) {
    .Call(`_netdiffuseR_rgraph_sf_homo`, eta, graph, dgr, m, t, self)
}

rgraph_sf_homo_new <- function(eta, m0 = 1L, m = 1L, t = 10L, self = TRUE) {
    .Call(`_netdiffuseR_rgraph_sf_homo_new`, eta, m0, m, t, self)
}

#' @export
#' @rdname vertex_covariate_dist
vertex_covariate_dist <- function(graph, X, p = 2.0) {
    .Call(`_netdiffuseR_vertex_covariate_dist`, graph, X, p)
}

vertex_mahalanobis_dist_cpp <- function(graph, X, S) {
    .Call(`_netdiffuseR_vertex_mahalanobis_dist_cpp`, graph, X, S)
}

#' Comparisons at dyadic level
#'
#' @param graph A matrix of size \eqn{n\times n}{n*n} of class \code{dgCMatrix}.
#' @param X A numeric vector of length \eqn{n}.
#' @param funname Character scalar. Comparison to make (see details).
#' @details
#'
#' This auxiliary function takes advantage of the sparseness of \code{graph} and
#' applies a function in the form of \eqn{funname(x_i,x_j)}{funname(X[i],X[j])}
#' only to \eqn{(i,j)} that have no empty entry. In other words, applies a compares
#' elements of \code{X} only between vertices that have a link; making
#' \code{nlinks(graph)} comparisons instead of looping through \eqn{n\times n}{n*n},
#' which is much faster.
#'
#' \code{funname} can take any of the following values:
#' \code{"distance"}, \code{"^2"} or \code{"quaddistance"}, \code{">"} or \code{"greater"},
#' \code{"<"} or \code{"smaller"}, \code{">="} or \code{"greaterequal"},
#' \code{"<="} or \code{"smallerequal"}, \code{"=="} or \code{"equal"}.
#'
#'
#' @return A matrix \code{dgCMatrix} of size \eqn{n\times n}{n*n} with values in
#' the form of \eqn{funname(x_i,x_j)}{funname(X[i],X[j])}.
#' @family dyadic-level comparison functions
#' @examples
#'
#' # Basic example ------------------------------------------------------------
#' set.seed(1313)
#' G <- rgraph_ws(10, 4, .2)
#' x <- rnorm(10)
#'
#' vertex_covariate_compare(G, x, "distance")
#' vertex_covariate_compare(G, x, "^2")
#' vertex_covariate_compare(G, x, ">=")
#' vertex_covariate_compare(G, x, "<=")
#' @export
vertex_covariate_compare <- function(graph, X, funname) {
    .Call(`_netdiffuseR_vertex_covariate_compare`, graph, X, funname)
}

moran_cpp <- function(x, w) {
    .Call(`_netdiffuseR_moran_cpp`, x, w)
}

matrix_compareCpp <- function(A, B, fun) {
    .Call(`_netdiffuseR_matrix_compareCpp`, A, B, fun)
}

struct_test_mean <- function(y, funname, self = FALSE) {
    .Call(`_netdiffuseR_struct_test_mean`, y, funname, self)
}

struct_test_var <- function(y, funname, self = FALSE) {
    .Call(`_netdiffuseR_struct_test_var`, y, funname, self)
}

#' Computes variance of \eqn{Y} at ego level
#' @param graph A matrix of size \eqn{n\times n}{n*n} of class \code{dgCMatrix}.
#' @param Y A numeric vector of length \eqn{n}.
#' @param funname Character scalar. Comparison to make (see \code{\link{vertex_covariate_compare}}).
#' @param all Logical scalar. When \code{FALSE} (default) \eqn{f_i} is mean at
#' ego level. Otherwise is fix for all i (see details).
#' @details
#'
#' For each vertex \eqn{i} the variance is computed as follows
#'
#' \deqn{%
#' (\sum_j a_{ij})^{-1}\sum_j a_{ij} \left[f(y_i,y_j) - f_i\right]^2
#' }{%
#' (sum_j a(ij))^(-1) * \sum_j a(ij) * [f(y(i),y(j)) - f(i)]^2
#' }
#'
#' Where \eqn{a_{ij}}{a(ij)} is the ij-th element of \code{graph}, \eqn{f} is
#' the function specified in \code{funname}, and, if \code{all=FALSE}
#' \eqn{f_i = \sum_j a_{ij}f(y_i,y_j)^2/\sum_ja_{ij}}{f(i)=\sum_j a(ij)f(y(i), y(j))^2/\sum_j a(ij)},
#' otherwise \eqn{f_i = f_j = \frac{1}{n^2}\sum_{i,j}f(y_i,y_j)}{f(i)=f(j)=(1/n^2)\sum_(i,j) f(y_i,y_j)}
#'
#'
#' This is an auxiliary function for \code{\link{struct_test}}. The idea is
#' to compute an adjusted measure of disimilarity between vertices, so the
#' closest in terms of \eqn{f} is \eqn{i} to its neighbors, the smaller the
#' relative variance.
#' @return A numeric vector of length \eqn{n}.
#' @export
#' @seealso \code{\link{struct_test}}
#' @family statistics
ego_variance <- function(graph, Y, funname, all = FALSE) {
    .Call(`_netdiffuseR_ego_variance`, graph, Y, funname, all)
}