R/RcppExports.R

Defines functions occurance_table occurance_matrix attr_overlap attributeConnector attribute_graph replace_threshold

Documented in attributeConnector attribute_graph attr_overlap occurance_matrix occurance_table replace_threshold

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

#' Replace elements of an integer matrix.
#' 
#' This function replaces all elements of an integer matrix, which are under a 
#' certain threshold (<) with zero.
#' 
#' @param m A numeric matrix.
#' @param threshold A numeric threshold under which all elements in the 
#' matrix are replaced by zero.
#' @return An integer matrix.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # replace_threshold(m, 1)
#' 
#' @export
replace_threshold <- function(m, threshold) {
    .Call('_mosbi_replace_threshold', PACKAGE = 'mosbi', m, threshold)
}

#' Generate attribute specific co-occurance networks.
#'
#' The function generates co-occurance networks for all the attributes.
#' E.g. if \code{MARGIN="column"}, for each column, a oc-occurance matrix 
#' of rows is generated, which includes all biclusters, where the 
#' column element is present. 
#' 
#' @param bics A list of \code{\link{bicluster}}s.
#' @param m The matrix used for biclustering.
#' @param MARGIN \code{"row"} or \code{"row"}, Indicating if a list of 
#' row- or column-specific networks is generated
#' @return A list of numeric matrices.
#' If \code{MARGIN="column"} (\code{"row"}), the list has a 
#' length of \code{ncol(m)} (\code{nrow(m)}) 
#' and each matrix the dimensions of \code{c(nrow(m), 
#' nrow(m))} (\code{c(ncol(m), ncol(m))})
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # attribute_graph(bics, m)
#'
#' @export
attribute_graph <- function(bics, m, MARGIN = "column") {
    .Call('_mosbi_attribute_graph', PACKAGE = 'mosbi', bics, m, MARGIN)
}

#' Extract the class-wise degree of an adjacency matrix.
#' 
#' For a adjacency matrix as computed by \code{\link{full_graph}},
#' the function computes how many row-column interactions connect 
#' rows (columns) to columns (rows) of a specific class/category.
#' 
#' @param mat A adjacency matrix with bipartite interactions as 
#' computed by \code{\link{full_graph}} or \code{\link{attribute_graph}} 
#' (with parameter \code{bipartite=TRUE}).
#' @param otherclasses A logical vector indicating two classes 
#' of elements in rows (columns).
#' @param useOther Logical indicating if the attributes, that 
#' are classified appear first in the matrix (\code{True}) or 
#' the attributes that connect classified attributes (\code{False}).
#' @return A DataFrame that holds the total degree of every 
#' attribute (row/column) and the fraction of the degree that 
#' connects only to elements of class \code{True} (from 
#' parameter \code{otherclasses}).
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # fn <- feature_network(bics, m)
#' # attributeConnector(apply_threshold(fn), 
#' #     otherclasses=c(rep(FALSE, 100), rep(TRUE, 100)))
#' 
#' @export
attributeConnector <- function(mat, otherclasses, useOther = FALSE) {
    .Call('_mosbi_attributeConnector', PACKAGE = 'mosbi', mat, otherclasses, useOther)
}

#' Count how often row/column elements occur in biclusters.
#' 
#' Given a list of bicluster objects (\code{\link{bicluster}}), 
#' the function counts the occurance of all elements in the biclusters.
#' 
#' @param bics A list of \code{\link{bicluster}} objects.
#' @param named Boolean, indicating, if all bicluster objects have names.
#' @return A Data Frame with the counts oof all elements.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # attr_overlap(bics, named=FALSE)
#'
#' @export
attr_overlap <- function(bics, named) {
    .Call('_mosbi_attr_overlap', PACKAGE = 'mosbi', bics, named)
}

#' Occurance matrix of data points in a list of biclusters
#' 
#' The function computes a matrix with the same dimensions as the input 
#' matrix and fills the matrix elements with the frequence of occurance 
#' of the data points in the input list of biclusters.
#'  
#' @param bics A list of \code{\link{bicluster}} objects.
#' @param mat The data matrix used for biclustering.
#' @return A numeric matrix with the dimensions of the input matrix. 
#' The values represent the frequency of occurance of this point in 
#' the list of biclusters.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # occurance_matrix(bics, m)
#' 
#' @export
occurance_matrix <- function(bics, mat) {
    .Call('_mosbi_occurance_matrix', PACKAGE = 'mosbi', bics, mat)
}

#' Occurance table of data points in a list of biclusters
#' 
#' The function uses the \code{\link{occurance_matrix}} function and 
#' returns all values higher than the \code{threshold} as a DataFrame.
#' 
#' @param bics A list of \code{\link{bicluster}} objects.
#' @param mat The data matrix used for biclustering.
#' @param threshold Only data points higher than this threshold are returned.
#' @return A DataFrame with the frequencies of occurance for values higher 
#' than a \code{threshold}.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # occurance_table(bics, m, threshold=.1)
#' 
#' @export
occurance_table <- function(bics, mat, threshold = 0.) {
    .Call('_mosbi_occurance_table', PACKAGE = 'mosbi', bics, mat, threshold)
}

#' Indicates, whether a bicluster is valid.
#' That means it needs at least one row and one column.
#' 
#' @param bic A bicluster object
#' @param minRow Minimum number of required rows (Min=1).
#' @param minCol Minimum number of required columns (Min=1).
#' @return Logical indicating a valid bicluster object.
#' 
#' @examples
#' validate_bicluster(bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' 
#' @export
validate_bicluster <- function(bic, minRow = 1L, minCol = 1L) {
    .Call('_mosbi_validate_bicluster', PACKAGE = 'mosbi', bic, minRow, minCol)
}

#' Transpose a bicluster.
#' Row and column slots will be changed.
#' 
#' @param bic A bicluster object.
#' @return A transposed bicluster object,
#' 
#' @examples
#' transpose_bicluster(bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' 
#' @export
transpose_bicluster <- function(bic) {
    .Call('_mosbi_transpose_bicluster', PACKAGE = 'mosbi', bic)
}

#' Clean a list of biclusters, by returning only the valid ones,
#' @param bics A list of bicluster objects.
#' @return A lis tof bicluster objects
#' 
#' @examples
#' b <- list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' clean_bicluster_list(b)
#' 
#' @export
clean_bicluster_list <- function(bics) {
    .Call('_mosbi_clean_bicluster_list', PACKAGE = 'mosbi', bics)
}

#' Check if a bicluster is a subset (in rows AND columns) 
#' of identical to another bicluster. 
#' 
#' @param bic1 A bicluster.
#' @param bic2 A bicluster.
#' @return 1 if bic1 is a subset of bic2, 2 if bic 1 is 
#' identical to bic2, 0 else.
#' 
#' @examples
#' is_subset_or_identical(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'     bicluster(row=c(1,2,3,4), column=c(1,2,3,4)))
#'     
#' @export
is_subset_or_identical <- function(bic1, bic2) {
    .Call('_mosbi_is_subset_or_identical', PACKAGE = 'mosbi', bic1, bic2)
}

#' Remove all biclusters from a list, that are identical
#' or perfect subsets from each other.
#' Additionally all invalid biclusters are 
#' removed (See \code{\link{validate_bicluster}}).
#' 
#' @param bics A list of bicluster objects
#' @return A list of bicluster objects, where 
#' perfects subsets or identical biclusters are deleted.
#' 
#' @examples
#' filter_subsets(list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'     bicluster(row=c(1,2,3,4), column=c(1,2,3,4))))
#'     
#' @export
filter_subsets <- function(bics) {
    .Call('_mosbi_filter_subsets', PACKAGE = 'mosbi', bics)
}

#' Make a vector of R indices compatible with c++ by 
#' substracting every element by one.
#' @param v A numeric vector.
#' @return A numeric vector with every element decremented by one.
#' 
#' @examples
#' zero_subsetting(c(1,2,3,4,5))
#' 
#' @export
zero_subsetting <- function(v) {
    .Call('_mosbi_zero_subsetting', PACKAGE = 'mosbi', v)
}

#' Subsetting of R matrices within c++.
#'
#' @param m A numeric matrix
#' @param bic A bicluster object.
#' @return Matrix subset.
#' 
#' @examples
#' cpp_matrix_subsetting(matrix(seq(1:16), nrow=4), 
#'     bicluster(row=c(1,2), column=c(1,2)))
#'     
#' @export
cpp_matrix_subsetting <- function(m, bic) {
    .Call('_mosbi_cpp_matrix_subsetting', PACKAGE = 'mosbi', m, bic)
}

#' Filter a list of bicluster objects, by erasing all biclusters, 
#' that do not fulfill the minimum number of rows and columns.
#' Utilizes the function \code{\link{validate_bicluster}}.
#' 
#' @param bics List of bicluster objects.
#' @param minRow Minimum number of rows.
#' @param minCol Minimum number of columns.
#' @return A filtered list of bicluster objects.
#' 
#' @examples
#' b <- list(bicluster(row=c(1,2), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' filter_bicluster_size(b, 3, 3)
#' 
#' @export
filter_bicluster_size <- function(bics, minRow, minCol) {
    .Call('_mosbi_filter_bicluster_size', PACKAGE = 'mosbi', bics, minRow, minCol)
}

#' Save adjacency matrix as GraphML file
#' 
#' Save and adjacency matrix as returned by \code{\link{full_graph}} or 
#' 1 - \code{\link{distance_matrix}} as a GraphML file.
#' 
#' @param m A symmetric numeric matrix (Adjacency matrix). Rownames 
#' are considered as node names.
#' @param filename Name of the resulting GraphML 
#' file (should end with ".gml").
#' @param cols Node colors.
#' @return 0 if successful.
#' @import BH
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # bn <- bicluster_network(bics, m)
#' # write_graphml(apply_threshold(bn), "testfile.txt")
#' 
#' @export
write_graphml <- function(m, filename, cols) {
    .Call('_mosbi_write_graphml', PACKAGE = 'mosbi', m, filename, cols)
}

#' Detect the number of elements in a list of biclusters.
#' 
#' Finds the highest element in a list of bicluster objects.
#'
#' @param bics A list of bicluster objects.
#' @param MARGIN Choose if the distance is computed over \code{"row"} 
#' or \code{"column"}.
#' @return Return highest row or column index from a list of biclusters.
#' 
#' @examples
#' b <- list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' detect_elements(b)
#' 
#' @export
detect_elements <- function(bics, MARGIN = "row") {
    .Call('_mosbi_detect_elements', PACKAGE = 'mosbi', bics, MARGIN)
}

#' Compute similarities between biclusters
#' 
#' This function computes a similarity matrix between biclusters using
#' different similarity metrics.
#' 
#' @param bics A list of bicluster objects.
#' @param MARGIN Choose if the distance is computed over \code{"row"}
#' , \code{"column"} or \code{"both"}.
#' @param metric Integer indicating which metric is used. 
#' 1: Bray-Curtis similarity (default), 2: Jaccard index, 
#' 3: overlap coefficient, 4: Fowlkes–Mallows index.
#' @param prob_scale Scale similarity by the probability of an 
#' overlap equal of higher to the observed one. The scaling is 
#' done by multiplying the similarity 
#' with \code{(1 - (1 / (1 - log(overlap_probability, base=100))))}. 
#' The probability is comupted using the 
#' function \code{\link{p_overlap_2d_higher}} 
#' for \code{MARGIN =="both"} and  \code{\link{p_overlap_higher}} 
#' otherwise. Can be helpful for big imbalances of bicluster sizes.
#' @param mat_row If \code{prob_scale == TRUE}, the number of rows of the 
#' input matrix for biclustering must be given.
#' @param mat_col If \code{prob_scale == TRUE}, the number of columns of 
#' the input matrix for biclustering must be given.
#' @param prl Compute the similarity matrix using multiple 
#' cores (works only for \code{MARGIN="both"}). The number of 
#' core can be defined by 
#' executing: \code{RcppParallel::setThreadOptions(numThreads = 4)} 
#' before running this function.
#' @return A numeric matrix of the similarities between all given biclusters.
#' 
#' @examples
#' b <- list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' similarity_matrix(b)
#'
#' @export
similarity_matrix <- function(bics, MARGIN = "both", metric = 1L, prob_scale = FALSE, mat_row = 0L, mat_col = 0L, prl = FALSE) {
    .Call('_mosbi_similarity_matrix', PACKAGE = 'mosbi', bics, MARGIN, metric, prob_scale, mat_row, mat_col, prl)
}

#' Compute distances between biclusters
#' 
#' This function computes a distance matrix between biclusters using 
#' different dissimilarity metrics.
#' 
#' @param bics A list of bicluster objects.
#' @param MARGIN Choose if the distance is computed over \code{"row"} 
#' or \code{"column"}.
#' @param metric Integer indicating which metric is used. 1: Bray-Curtis 
#' dissimilarity (default), 2: Jaccard distance, 3: 1-overlap coefficient  
#' 4: 1 - Fowlkes–Mallows index.
#' @return A numeric matrix of the dissimilarities between all 
#' given biclusters.
#' 
#' @examples
#' b <- list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' distance_matrix(b)
#'
#' @export
distance_matrix <- function(bics, MARGIN = "row", metric = 1L) {
    .Call('_mosbi_distance_matrix', PACKAGE = 'mosbi', bics, MARGIN, metric)
}

#' Probability for an overlap of two samples.
#' 
#' The probability is computed using the 
#' forumla \eqn{\frac{{y \choose x}\times {n-y \choose k-x}}{{n \choose k}}}.
#' 
#' @param x Overlap.
#' @param y Size of sample 1.
#' @param k Size of Sample 2.
#' @param n Number of all elements sampled from.
#' @return Overlap probability.
#' 
#' @examples
#' p_overlap(10, 20, 30, 100)
#'
#' @export
p_overlap <- function(x, y, k, n) {
    .Call('_mosbi_p_overlap', PACKAGE = 'mosbi', x, y, k, n)
}

#' Probability for an overlap higher or equal to the observed 
#' one of two samples
#' 
#' Is computed by adding up probabilities for all possible 
#' overlaps equal or higher to the observed one using the 
#' function \code{\link{p_overlap}}.
#' 
#' @param x Overlap.
#' @param y Size of sample 1.
#' @param k Size of Sample 2.
#' @param n Number of all elements sampled from.
#' @return Overlap probability.
#' 
#' @examples
#' p_overlap_higher(10, 20, 30, 100)
#' 
#' @export
p_overlap_higher <- function(x, y, k, n) {
    .Call('_mosbi_p_overlap_higher', PACKAGE = 'mosbi', x, y, k, n)
}

#' Probability for an overlap of two dimensional samples
#' 
#' Is computed by calculating the overlap probability for each 
#' dimension independently and multiplying them using the 
#' function \code{\link{p_overlap}}.
#' 
#' @param ov_x Overlap in the first dimension.
#' @param ov_y Overlap in the second dimension.
#' @param s1x First sample of the first dimension.
#' @param s1y First sample of the second dimension.
#' @param s2x Second sample of first dimension.
#' @param s2y Second sample of the second dimension.
#' @param mat_x Number of all elements from the first 
#' dimension sampled from.
#' @param mat_y Number of all elements from the second 
#' dimension sampled from.
#' @return Overlap probability.
#' 
#' @examples
#' p_overlap_2d(10, 10, 20, 20, 30, 30, 100, 100)
#' 
#' @export
p_overlap_2d <- function(ov_x, ov_y, s1x, s1y, s2x, s2y, mat_x, mat_y) {
    .Call('_mosbi_p_overlap_2d', PACKAGE = 'mosbi', ov_x, ov_y, s1x, s1y, s2x, s2y, mat_x, mat_y)
}

#' Probability for an overlap higher or equal to the observed one 
#' of two dimensional samples
#' 
#' Is computed by adding up probabilities for all combinations of 
#' the observed or higher overlaps using the 
#' function \code{\link{p_overlap_2d}}.
#' 
#' @param ov_x Overlap in the first dimension.
#' @param ov_y Overlap in the second dimension.
#' @param s1x First sample of the first dimension.
#' @param s1y First sample of the second dimension.
#' @param s2x Second sample of first dimension.
#' @param s2y Second sample of the second dimension.
#' @param mat_x Number of all elements from the first 
#' dimension sampled from.
#' @param mat_y Number of all elements from the second 
#' dimension sampled from.
#' @return Overlap probability
#' 
#' @examples
#' p_overlap_2d_higher(10, 10, 20, 20, 30, 30, 100, 100)
#' 
#' @export
p_overlap_2d_higher <- function(ov_x, ov_y, s1x, s1y, s2x, s2y, mat_x, mat_y) {
    .Call('_mosbi_p_overlap_2d_higher', PACKAGE = 'mosbi', ov_x, ov_y, s1x, s1y, s2x, s2y, mat_x, mat_y)
}

#' Get the number of biclusters, generated by the Bi-Force algorithm.
#' @param filename Name of the Bi-Force output file.
#' @return Number of biclusters.
#' 
#' @examples
#' a <- "PathToBiForceOutput.txt"
#' # NoBFBiclusters(a)
#' 
#' @export
NoBFBiclusters <- function(filename) {
    .Call('_mosbi_NoBFBiclusters', PACKAGE = 'mosbi', filename)
}

#' Get a bicluster a Bi-Force output file
#' @param filename Name of the Bi-Force output file.
#' @param cluster Number of the bicluster that should be extracted.
#' @return Bicluster as list with rownames in attribute "row" 
#' and colnames in attribute "column".
#' 
#' @examples
#' a <- "PathToBiForceOutput.txt"
#' # getBFCluster(a, cluster=1)
#' 
#' @export
getBFCluster <- function(filename, cluster) {
    .Call('_mosbi_getBFCluster', PACKAGE = 'mosbi', filename, cluster)
}

#' Get all biclusters from a Bi-Force output file.
#' @param filename Name of the Bi-Force output file.
#' @return List of biclusters in the form of \code{\link{getBFCluster}}
#' 
#' @examples
#' a <- "PathToBiForceOutput.txt"
#' # getallBFClusters(a)
#' 
#' 
#' @export
getallBFClusters <- function(filename) {
    .Call('_mosbi_getallBFClusters', PACKAGE = 'mosbi', filename)
}

#' Extract QUBIC2 biclusters
#' 
#' Extract biclusters from a QUBIC2 "*.blocks" file. 
#' Row and column names are not added to the bicluster objects.
#' @param filename Path to the QUBIC2 results file.
#' @param transposed Set to TRUE, if the
#' biclustering was performed on a tranposed matrix.
#' @return A list of validated bicluster 
#' objects (See \code{\link{validate_bicluster}}).
#' 
#' @examples
#' a <- "PathToQUBIC2output.txt"
#' # Not run: getQUBIC2biclusters(a)
#' 
#' @export
getQUBIC2biclusters <- function(filename, transposed = FALSE) {
    .Call('_mosbi_getQUBIC2biclusters', PACKAGE = 'mosbi', filename, transposed)
}

#' Generate a similarity network for a list of biclusters
#' 
#' The function computes a adjacency 
#' matrix for rows and columns of biclusters.
#' The matrix values show, how often two rows or two columns or a row and a 
#' column occur together in biclusters.
#' In the resulting adjacency matrix, rows are listed first, followed 
#' by columns. 
#' They have the same order as the the rows and columns of the input matrix.
#' 
#' In case the given biclusters have overall more or less columns than rows, 
#' the interactions can be weighted to visualize the result properly.
#' @param bics A list of biclusters.
#' @param m The matrix, that was used to calculated the biclusters.
#' @param rr_weight Weight row-row interactions.
#' @param rc_weight Weight row-col interactions.
#' @param cc_weight Weight col-col interactions.
#' @param weighting Weight interactions by bicluster size. 0 - no weighting, 
#' 1 - multiply by bicluster size, 2 - divide by bicluster size.
#' @return An adjacency matrix.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' b <- list(bicluster(row=c(1,2,3,4), column=c(1,2,3,4)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)),
#'         bicluster(row=c(3,4,5,6), column=c(3,4,5,6)))
#' # full_graph(b, m)
#' 
#' @export
full_graph <- function(bics, m, rr_weight = 1L, rc_weight = 1L, cc_weight = 1L, weighting = 0L) {
    .Call('_mosbi_full_graph', PACKAGE = 'mosbi', bics, m, rr_weight, rc_weight, cc_weight, weighting)
}

#' Check, whether a matrix has row- and colnames.
#' @param m A matrix
#' @return Logical indicating existence of row- and colnames.
#' 
#' @examples
#' has_names(matrix(c(1,2,3,4), nrow=2))
#' 
#' m <- matrix(c(1,2,3,4), nrow=2)
#' rownames(m) <- c("r1", "r2")
#' rownames(m) <- c("c1", "c2")
#' has_names(m)
#' 
#' @export
has_names <- function(m) {
    .Call('_mosbi_has_names', PACKAGE = 'mosbi', m)
}

#' Throw an error, if a matrix has not both row- and colnames.
#' @param m A matrix.
#' @return Throws error, if matrix has no row- and column names.
#' 
#' @examples 
#' m <- matrix(c(1,2,3,4), nrow=2)
#' rownames(m) <- c("r1", "r2")
#' colnames(m) <- c("c1", "c2")
#' check_names(m)
#' 
#' @export
check_names <- function(m) {
    invisible(.Call('_mosbi_check_names', PACKAGE = 'mosbi', m))
}

#' Replace values in an integer adjacency matrix.
#'
#' Replace values in an integer matrix, that are lower than a certain 
#' threshold.
#'
#' @param mat An integer matrix
#' @param threshold All values in the matrix lower than this values are 
#' replaced by 0.
#' @param replace_higher If set to true, all values >= \code{threshold} 
#' are replaced by 1.
#' @return An integer matrix with (partially) replaced values.
#' 
#' @examples
#' replace_values(matrix(seq(1, 16), nrow=4), threshold=4)
#'
#' @export
replace_values <- function(mat, threshold, replace_higher = TRUE) {
    .Call('_mosbi_replace_values', PACKAGE = 'mosbi', mat, threshold, replace_higher)
}

#' Replace values in a adjacency matrix.
#' 
#' Same as \code{\link{replace_values}}, but for (positive) non-integer
#' matrices.
#'
#' Replace values in a numeric matrix, that are lower than a certain 
#' threshold.
#'
#' @param mat A numeric matrix
#' @param threshold All values in the matrix lower than this values are 
#' replaced by 0.
#' @param replace_higher If set to true, all values >= \code{threshold} 
#' are replaced by 1.
#' @return A numeric matrix with (partially) replaced values.
#' 
#' @examples
#' replace_values(matrix(rnorm(100), nrow=10), threshold=1)
#'
#' @export
replace_values_float <- function(mat, threshold, replace_higher = TRUE) {
    .Call('_mosbi_replace_values_float', PACKAGE = 'mosbi', mat, threshold, replace_higher)
}

#' Count edges in an adjacency matrix using different cut-off thresholds.
#' 
#' Computes the how many edges remain in a network if edges with a weight 
#' lower than a certain threshold are removed.
#' The number of remaining edges between 1 and max(adjm) are calculated.
#' It is assumend that the matrix is symmetric and therefore the number 
#' of edges divided by two.
#' Uses the function \code{\link{replace_values}}.
#' 
#' @param adjm A symmetrix numeric matrix.
#' @return A numeirc matrix of \code{dim(max(adjm), 2)}. The first column 
#' indicated the applied threshold, the second column the remaining edges.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # fn <- feature_network(bics, m)
#' # network_edge_strength(apply_threshold(fn))
#' 
#' @export
network_edge_strength <- function(adjm) {
    .Call('_mosbi_network_edge_strength', PACKAGE = 'mosbi', adjm)
}

#' Count edges in an adjacency matrix using different cut-off 
#' thresholds.
#'
#' Same as \code{\link{network_edge_strength}}, but for (positive) 
#' non-integer matrices.
#' 
#' Computes the how many edges remain in a network if edges with a 
#' weight lower than a certain threshold are removed.
#' The number of remaining edges between 1 and max(adjm) are calculated.
#' It is assumend that the matrix is symmetric and therefore 
#' the number of edges divided by two.
#' Uses the function \code{\link{replace_values_float}}.
#' 
#' @param adjm A symmetrix numeric matrix.
#' @param steps Number of steps for which the edge count is evaluated.
#' @param maximum Highest value until which the edge weight is evaluated. 
#' If maximum=0, the max value of \code{adjm} is used.
#' @return A numeirc matrix of \code{dim(max(adjm), 2)}. 
#' The first column indicated the applied threshold, the second 
#' column the remaining edges.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # bn <- bicluster_network(bics, m)
#' # network_edge_strength_float(apply_threshold(bn))
#'
#' @export
network_edge_strength_float <- function(adjm, steps = 100L, maximum = 0) {
    .Call('_mosbi_network_edge_strength_float', PACKAGE = 'mosbi', adjm, steps, maximum)
}

#' Get the rowlengths for a list of bicluster objects.
#' 
#' Can be used for e.g. histograms.
#' @param bic A list  of bicluster objects.
#' @return A vector with the lenghts of the rows in every bicluster object.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # rowhistogram(bics)
#' 
#' @export
rowhistogram <- function(bic) {
    .Call('_mosbi_rowhistogram', PACKAGE = 'mosbi', bic)
}

#' Get the columnlengths for a list of bicluster objects.
#' 
#' Can be used for e.g. histograms.
#' @param bic A list  of bicluster objects.
#' @return A vector with the lenghts of the columns in every bicluster object.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # colhistogram(bics)
#' 
#' @export
colhistogram <- function(bic) {
    .Call('_mosbi_colhistogram', PACKAGE = 'mosbi', bic)
}

#' Get list the list of algorithms from a list of bicluster objects.
#' 
#' Can be used for .g. histograms.
#' @param bic A list  of bicluster objects.
#' @return A character vector with the extracted biclustering algorithms 
#' used for each bicluster of the input list.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # algohistogram(bics)
#' 
#' @export
algohistogram <- function(bic) {
    .Call('_mosbi_algohistogram', PACKAGE = 'mosbi', bic)
}

#' Sample a list of biclusters.
#' 
#' The function generates a list of biclusters given an input list of 
#' biclusters, where each bicluster has the same number or rows and columns, 
#' but with sampled entries from a uniform distribution of all rows and 
#' columns is the matrix.
#' @param bics A list of validated bicluster objects.
#' @param mat The numeric matrix, that was used to generate the biclusters.
#' @return A list of \link{bicluster} objects.
#' 
#' @examples
#' m <- matrix(seq(1:16), nrow=4)
#' # m <- matrix(rnorm(10000), nrow=100)
#' # bics <- c(run_fabia(m), run_isa(m), run_plaid(m))
#' # sample_biclusters(bics, m)
#' 
#' @export
sample_biclusters <- function(bics, mat) {
    .Call('_mosbi_sample_biclusters', PACKAGE = 'mosbi', bics, mat)
}

#' Write an R matrix to a file (In a Bi-Force or QUBIC2 readable format).
#' @param m A Numeric matrix.
#' @param filename Name of the output file.
#' @param qubic2_format Write the matrix in a format QUBIC2 is able to read. 
#' This means adding a row- and column names to the file.
#' @return 0 if file was written successfully.
#' 
#' @examples
#' write_matrix(matrix(c(1,2,3,4), nrow=2), "testfile.txt")
#' 
#' @export
write_matrix <- function(m, filename, qubic2_format = FALSE) {
    .Call('_mosbi_write_matrix', PACKAGE = 'mosbi', m, filename, qubic2_format)
}
tdrose/mosbi documentation built on May 4, 2022, 3:22 p.m.