# R/transform.relations.R In netrankr: Analyzing Partial Rankings in Networks

#### Documented in dist_2powdist_dpowdist_invdist_powdwalks_attenuatedwalks_expwalks_exp_evenwalks_exp_oddwalks_limit_propwalks_uptok

#' @title Transform indirect relations
#' @description Mostly wrapper functions that can be used in conjunction
#' with [indirect_relations] to fine tune indirect relations.
#' @param x Matrix of relations.
#' @param alpha Potential weighting factor.
#' @param k For walk counts up to a certain length.
#' @details The predefined functions follow the naming scheme relation_transformation.
#' Predefined functions walks_* are thus best used with type="walks" in
#' [indirect_relations]. Theoretically, however, any transformation can be used with any relation.
#' The results might, however, not be interpretable.
#'
#' The following functions are implemented so far:
#'
#' dist_2pow returns \eqn{2^{-x}}
#'
#' dist_inv returns \eqn{1/x}
#'
#' dist_dpow returns \eqn{x^{-\alpha}} where \eqn{\alpha} should be chosen greater than 0.
#'
#' dist_powd returns \eqn{\alpha^x} where \eqn{\alpha} should be chosen between 0 and 1.
#'
#'
#' walks_limit_prop returns the limit proportion of walks between pairs of nodes. Calculating
#' rowSums of this relation will result in the principle eigenvector of the network.
#'
#' walks_exp returns \eqn{\sum_{k=0}^\infty \frac{A^k}{k!}}
#'
#' walks_exp_even returns \eqn{\sum_{k=0}^\infty \frac{A^{2k}}{(2k)!}}
#'
#' walks_exp_odd returns \eqn{\sum_{k=0}^\infty \frac{A^{2k+1}}{(2k+1)!}}
#'
#' walks_attenuated returns \eqn{\sum_{k=0}^\infty \alpha^k A^k}
#'
#' walks_uptok returns \eqn{\sum_{j=0}^k \alpha^j A^j}
#'
#' Walk based transformation are defined on the eigen decomposition of the
#' adjacency matrix using the fact that
#' \deqn{f(A)=Xf(\Lambda)X^T.}
#' Care has to be taken when using user defined functions.
#'
#'
#' @name transform_relations
#' @return Transformed relations as matrix
#'
#' @author David Schoch
NULL

#' @rdname transform_relations
#' @export
dist_2pow <- function(x) {
2^(-x)
}

#' @rdname transform_relations
#' @export
dist_inv <- function(x) {
y <- x^(-1)
y[is.infinite(y)] <- 0
return(y)
}

#' @rdname transform_relations
#' @export
dist_dpow <- function(x, alpha = 1) {
x <- x^(-alpha)
diag(x) <- 0
return(x)
}

#' @rdname transform_relations
#' @export
dist_powd <- function(x, alpha = 0.5) {
alpha^(x)
}

# dist_triang <- function(x) {
#     n <- nrow(x)
#     y <- matrix(0, n, n)
#     for (s in 1:n) {
#         for (t in 1:n) {
#             for (u in 1:n) {
#                 if (s != t & u != s & u != t) {
#                   y[u, s] <- y[u, s] + (x[s, t])/(x[s, u] + x[u, t])
#                 }
#             }
#         }
#     }
#     return(y)
# }

#' @rdname transform_relations
#' @export
walks_limit_prop <- function(x) {
c(1, rep(0, length(x) - 1))
}

#' @rdname transform_relations
#' @export
walks_exp <- function(x, alpha = 1) {
exp(alpha * x)
}

#' @rdname transform_relations
#' @export
walks_exp_even <- function(x, alpha = 1) {
cosh(alpha * x)
}

#' @rdname transform_relations
#' @export
walks_exp_odd <- function(x, alpha = 1) {
sinh(alpha * x)
}

#' @rdname transform_relations
#' @export
walks_attenuated <- function(x, alpha = 1 / max(x) * 0.99) {
if (alpha > 1 / max(x)) {
warning(paste0("alpha should be smaller than ", 1 / max(x), ". Results are most likely wrong otherwise."))
}
1 / (1 - alpha * x)
}

#' @rdname transform_relations
#' @export
walks_uptok <- function(x, alpha = 1, k = 3) {
y <- 0
for (i in 1:k) {
y <- y + alpha^i * x^i
}
return(y)
}


## Try the netrankr package in your browser

Any scripts or data that you put into this service are public.

netrankr documentation built on Sept. 27, 2022, 1:07 a.m.