R/RcppExports.R

In systemicrisk: A Toolbox for Systemic Risk

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

#' Finds a Nonnegative Matrix Satisfying Row and Column Sums
#'
#' Given row and column sums and a matrix p which indicates which elements of the matrix can be present, this function computes a nonnegative matrix that match these row and column sums. If this is not possible then the function returns an error message.
#'
#' The function transforms the problem into a Maximum Flow
#' problem of a graph and uses the Edmonds-Karps algorithm to solve it.
#' If the error message "Could not find feasible matrix." is produced then this could be
#' due to p imposing disconnected components in the graph implied
#' by row and column sums that are not compatible with the row and column sums..
#'
#' @param r vector of row sums (nonnegative
#' @param c vector of column sums (nonnegative)
#' @param p matrix of probabilities (must be in [0,1]), matching the dimensions of r and c. Values of p=0 are interpreted that the corresponding matrix elements have to be 0. Note: p=1 does not force the corresponding matrix element to exist.
#' @param eps row and col sums can at most be different by eps.  Default 1e-9.
#' @return A feasible matrix.
#'
#' @examples
#' p=matrix(c(1,0,0,1),nrow=2)
#' findFeasibleMatrix(c(1,1),c(1,1),p=p)
#'
#' n <- 4
#' M <- matrix(nrow=n,ncol=n,rexp(n*n)*(runif(n*n)>0.6))
#' M
#' r <- rowSums(M)
#' c <- colSums(M)
#' Mnew <- findFeasibleMatrix(r=r,c=c,p=(M>0)*0.5)
#' Mnew
#' rowSums(M);rowSums(Mnew)
#' colSums(M);colSums(Mnew)
#' @export
findFeasibleMatrix <- function(r, c, p, eps = 1e-9) {
    .Call(`_systemicrisk_findFeasibleMatrix`, r, c, p, eps)
}

#' Creates a deep copy of a matrix
#'
#' Useful  when calling \code{\link{ERE_step_cycle}} or
#' \code{\link{GibbsSteps_kcycle}} to ensure that
#' there are no side effects for the return values.
#' @param M A matrix
#' @return A deep copy of the matrix.
#' @examples
#' lambda <- matrix(0.5,nrow=2,ncol=2)
#' p <- matrix(0.7, nrow=2,ncol=2)
#' L <- matrix(rexp(4),nrow=2);
#' L
#' Lold <- L
#' Lcopy <- cloneMatrix(L)
#' ERE_step_cycle(r=c(0,1),c=c(0,1),L=L,lambda=lambda,p=p)
#'
#' L     ## new value
#' Lold  ## equal to L !!!
#' Lcopy ## still has the original value
#' @export
cloneMatrix <- function(M) {
    .Call(`_systemicrisk_cloneMatrix`, M)
}

#' @title Does one Gibbs Step on a cycle
#'
#' @description Execute one Gibbs step on a cycle keeping
#' row and column sums fixed
#'
#' @param r Row indies of cycle, starting at 0 (vector of length k)
#' @param c Column indices of cycle, starting at 0 (vector of length k)
#' @param L nxn matrix with nonnegative values (will be modified)
#' @param lambda nxn matrix of intensities
#' @param p nxn matrix of probabilities (must be in [0,1] and 0 on diagonal)
#' @param eps Threshold for values to be interpreted as equal to 0 (default = 1e-10)
#' @return no return value
#'
#' @examples
#' L=matrix(rexp(9),nrow=3)
#' lambda <- matrix(0.5,nrow=3,ncol=3)
#' p <- matrix(0.7, nrow=3,ncol=3)
#' ERE_step_cycle(r=c(0,1),c=c(1,2),L=L,lambda=lambda,p=p)
#' ERE_step_cycle(r=c(0,1,2),c=c(0,1,2),L=L,lambda=lambda,p=p)
#' ERE_step_cycle(r=c(0,1,2),c=c(2,1,0),L=L,lambda=lambda,p=p)
#'
#' @export
ERE_step_cycle <- function(r, c, L, lambda, p, eps = 1e-10) {
    invisible(.Call(`_systemicrisk_ERE_step_cycle`, r, c, L, lambda, p, eps))
}

#' Gibbs sampling step of a matrix in the ERE model
#'
#' The sampling is conditional on row and column sums and uses k-cycle steps. Then dimensions of L, lambda and p must match.
#'
#' @param L Starting matrix - will be modified to contain the results.
#' @param lambda  Matrix of intensities
#' @param p Matrix of probabilities (must be in [0,1])
#' @param it Number of iterations (default=1000)
#' @param eps Threshold for values to be interpreted as equal to 0 (default = 1e-10)
#' @param debug Should addtional debug information be printed? (0 no output, 1 output debug information)
#' @return no return value
#'
#' @examples
#' L <- matrix(c(1,2,3,4,5,6,7,8,9),nrow=3)
#' diag(L) <- 0
#' lambda <- matrix(0.5,nrow=3,ncol=3)
#' p <- matrix(0.7, nrow=3,ncol=3)
#' diag(p) <- 0
#' GibbsSteps_kcycle(L=L,lambda=lambda,p=p)
#' L
#' L <- matrix(1:16,nrow=4)
#' diag(L) <- 0
#' lambda <- matrix(0.5,nrow=4,ncol=4)
#' p <- matrix(0.25, nrow=4,ncol=4)
#' diag(p) <- 0
#' GibbsSteps_kcycle(L=L,lambda=lambda,p=p)
#' L
#' @export
GibbsSteps_kcycle <- function(L, lambda, p, it = 1000L, eps = 1e-10, debug = 0L) {
    invisible(.Call(`_systemicrisk_GibbsSteps_kcycle`, L, lambda, p, it, eps, debug))
}