R/create_matrices.R

In baruuum/btoolbox: random toolbox

#' Create Agreement Matrix
#' 
#' Creates an agreement matrix by comparing either the row or the columns of a matrix
#' 
#' @param x an integer matrix
#' @param dim what dimensions to compare; must be either "row" or "column"; defaults to "row"
#' @param missing value that should be treated as missing (defaults to 99).  \code{NA} values are automatically transformed into missing values. If this is not desired assigning any other \code{integer} value to them will prevent this behavior.
#' @details Let \eqn{X} be a \eqn{n\times k} matrix. If comparison across rows is demended (i.e., \code{dim = "row"}, the function returns a \eqn{n\times n} matrix where the \eqn{(i,j)}th element is the number of columns on which the \eqn{i}th and the \eqn{j}th row agree by having the same value.
#' @export
gen_agreemat = function(x, dim = c("row", "col"), missing = 99L)
{

    # transform NA
    x[is.na(x)] = missing
    
    # check input
    if (!all(x %% 1 == 0))
        stop("x has to be an integer matrix")
    
    # get dimension
    what_dim = match.arg(dim)
    dim_int = if (what_dim == "row") {
        1L
    } else 0L
    
    return(.agreement_mat(x, dim_int, missing))

}


#' Helper function of update_affiliation (not exported)
#' 
#' Checks the input of the affiliation matrix update and returns the indices of the matrix to be updated
#' 
#' @param x the affiliation matrix to be updated
#' @param lookup the lookup table to map indices to ids
#' @param type type of the input
#' @return returns the indices of the matrix to be updated based on the lookup table (if provided)
.check_aff_input = function(x, lookup = NULL, type = "")
{
    
    if (!is.null(lookup)) {
        
        if (!("data.frame" %in% class(lookup)))
            stop("lookup has to be a data.frame or data.table object")
        
        if (!(all(c("id", "index") %in% names(lookup))))
            stop("lookup must have the columns id and index")
        
        inx = lookup[lookup$id %in% x, ]$index
        
        if (!is.integer(inx))
            stop("lookup$id has to be an integer vector")
        
    } else {
        
        inx = x
        
        if (!is.integer(inx) && type == "")
            stop("x has to be an integer vector (if lookup is not specified)")
        
        if (!is.integer(inx) && type == "list")
            stop("x has to be a list of integer vectors (if lookup is not specified)")
        
    }
    
    inx
    
}

#' Update sparse affiliation network with new data
#' 
#' Updates a affiliation network stored in sparse format with new data of an ego-centric network
#' 
#' @param aff_mat the affiliation network to be updated; must be a \code{sparseMatrix} of the \code{Matrix} package
#' @param x a vector containing the (group) names to which the new individual is affiliated to (if \code{lookup} is provided); or a vector of class \code{integer} that contains the indices of these groups as stored in \code{aff_mat}; or a list of these vectors
#' @param lookup optional lookup table. If \code{lookup} is provided, it has to be a \code{data.table} or \code{data.frame} with two columns named \code{index} and \code{id}, where \code{id} contains the (group-level) ids and \code{index} the numeric index of the groups (as stored in the affiliation matrix). If \code{x} itself contains the indices, \code{lookup} is not needed.
#' @param update_diag boolean; if \code{TRUE}, updates the diagonals of the affiliation matrix
#' @param normalize boolean; if \code{TRUE} the contribution of each ego-network to the affiliation matrix is weighted by the inverse-degree of ego (e.g., if ego has 4 ties, the weight for each tie is 1/4)
#' @param verbose boolean; if \code{TRUE} shows progress text
#' @return updates \code{aff_mat} by adding counts to it based on the information provided in \code{x}.
#' @details Given the affiliation matrix \code{aff_mat}, the function takes new data on a set of affiliations connected to the same unit and updates the affiliations accordingly. If \code{x} contains the indices \code{1,6,12}, for example, the affiliation network is updated by adding one count to the entries \code{(1, 6), (6, 1), (1, 12), (12, 1), (6, 12), (12, 6)}.
#' @examples 
#' 
#' library(Matrix)
#' k = 5L
#' aff_mat = Matrix(nrow = k, ncol = k, data = 0L, sparse = TRUE)
#' x = c(1L, 3L, 5L)
#' 
#' update_affiliation(aff_mat, x)
#' 
#' @export
update_affiliation = function(
    aff_mat, 
    x, 
    lookup = NULL,
    update_diag = FALSE,
    normalize = FALSE,
    verbose = FALSE
) {
    
    if (!is.list(x)) {
        
        inx = .check_aff_input(x, lookup)
        return(.update_aff_mat(aff_mat, inx, update_diag, normalize))
        
    }
    
    inx_list = lapply(x, function(w) .check_aff_input(w, lookup))
    return(.update_aff_list(aff_mat, inx_list, update_diag, normalize, verbose))
    
}