MatrixGenerics/DESCRIPTION0000644000175200017520000000503614136073637016244 0ustar00biocbuildbiocbuildPackage: MatrixGenerics Title: S4 Generic Summary Statistic Functions that Operate on Matrix-Like Objects Description: S4 generic functions modeled after the 'matrixStats' API for alternative matrix implementations. Packages with alternative matrix implementation can depend on this package and implement the generic functions that are defined here for a useful set of row and column summary statistics. Other package developers can import this package and handle a different matrix implementations without worrying about incompatibilities. biocViews: Infrastructure, Software URL: https://bioconductor.org/packages/MatrixGenerics BugReports: https://github.com/Bioconductor/MatrixGenerics/issues Version: 1.6.0 License: Artistic-2.0 Encoding: UTF-8 Authors@R: c(person("Constantin", "Ahlmann-Eltze", email = "artjom31415@googlemail.com", role = c("aut"), comment = c(ORCID = "0000-0002-3762-068X")), person("Peter", "Hickey", role = c("aut", "cre"), email = "peter.hickey@gmail.com", comment = c(ORCID = "0000-0002-8153-6258")), person("Hervé", "Pagès", email = "hpages.on.github@gmail.com", role = "aut")) Depends: matrixStats (>= 0.60.1) Imports: methods Suggests: sparseMatrixStats, DelayedMatrixStats, SummarizedExperiment, testthat (>= 2.1.0) RoxygenNote: 7.1.1 Roxygen: list(markdown = TRUE, old_usage = TRUE) Collate: 'MatrixGenerics-package.R' 'rowAlls.R' 'rowAnyNAs.R' 'rowAnys.R' 'rowAvgsPerColSet.R' 'rowCollapse.R' 'rowCounts.R' 'rowCummaxs.R' 'rowCummins.R' 'rowCumprods.R' 'rowCumsums.R' 'rowDiffs.R' 'rowIQRDiffs.R' 'rowIQRs.R' 'rowLogSumExps.R' 'rowMadDiffs.R' 'rowMads.R' 'rowMaxs.R' 'rowMeans2.R' 'rowMedians.R' 'rowMins.R' 'rowOrderStats.R' 'rowProds.R' 'rowQuantiles.R' 'rowRanges.R' 'rowRanks.R' 'rowSdDiffs.R' 'rowSds.R' 'rowSums2.R' 'rowTabulates.R' 'rowVarDiffs.R' 'rowVars.R' 'rowWeightedMads.R' 'rowWeightedMeans.R' 'rowWeightedMedians.R' 'rowWeightedSds.R' 'rowWeightedVars.R' git_url: https://git.bioconductor.org/packages/MatrixGenerics git_branch: RELEASE_3_14 git_last_commit: 4588a60 git_last_commit_date: 2021-10-26 Date/Publication: 2021-10-26 NeedsCompilation: no Packaged: 2021-10-26 21:48:15 UTC; biocbuild Author: Constantin Ahlmann-Eltze [aut] (), Peter Hickey [aut, cre] (), Hervé Pagès [aut] Maintainer: Peter Hickey MatrixGenerics/NAMESPACE0000644000175200017520000000655414136053374015757 0ustar00biocbuildbiocbuild# Generated by roxygen2: do not edit by hand export(colAlls) export(colAnyNAs) export(colAnys) export(colAvgsPerRowSet) export(colCollapse) export(colCounts) export(colCummaxs) export(colCummins) export(colCumprods) export(colCumsums) export(colDiffs) export(colIQRDiffs) export(colIQRs) export(colLogSumExps) export(colMadDiffs) export(colMads) export(colMaxs) export(colMeans2) export(colMedians) export(colMins) export(colOrderStats) export(colProds) export(colQuantiles) export(colRanges) export(colRanks) export(colSdDiffs) export(colSds) export(colSums2) export(colTabulates) export(colVarDiffs) export(colVars) export(colWeightedMads) export(colWeightedMeans) export(colWeightedMedians) export(colWeightedSds) export(colWeightedVars) export(rowAlls) export(rowAnyNAs) export(rowAnys) export(rowAvgsPerColSet) export(rowCollapse) export(rowCounts) export(rowCummaxs) export(rowCummins) export(rowCumprods) export(rowCumsums) export(rowDiffs) export(rowIQRDiffs) export(rowIQRs) export(rowLogSumExps) export(rowMadDiffs) export(rowMads) export(rowMaxs) export(rowMeans2) export(rowMedians) export(rowMins) export(rowOrderStats) export(rowProds) export(rowQuantiles) export(rowRanges) export(rowRanks) export(rowSdDiffs) export(rowSds) export(rowSums2) export(rowTabulates) export(rowVarDiffs) export(rowVars) export(rowWeightedMads) export(rowWeightedMeans) export(rowWeightedMedians) export(rowWeightedSds) export(rowWeightedVars) exportClasses(matrix_OR_array_OR_table_OR_numeric) exportMethods(colAlls) exportMethods(colAnyNAs) exportMethods(colAnys) exportMethods(colAvgsPerRowSet) exportMethods(colCollapse) exportMethods(colCounts) exportMethods(colCummaxs) exportMethods(colCummins) exportMethods(colCumprods) exportMethods(colCumsums) exportMethods(colDiffs) exportMethods(colIQRDiffs) exportMethods(colIQRs) exportMethods(colLogSumExps) exportMethods(colMadDiffs) exportMethods(colMads) exportMethods(colMaxs) exportMethods(colMeans2) exportMethods(colMedians) exportMethods(colMins) exportMethods(colOrderStats) exportMethods(colProds) exportMethods(colQuantiles) exportMethods(colRanges) exportMethods(colRanks) exportMethods(colSdDiffs) exportMethods(colSds) exportMethods(colSums2) exportMethods(colTabulates) exportMethods(colVarDiffs) exportMethods(colVars) exportMethods(colWeightedMads) exportMethods(colWeightedMeans) exportMethods(colWeightedMedians) exportMethods(colWeightedSds) exportMethods(colWeightedVars) exportMethods(rowAlls) exportMethods(rowAnyNAs) exportMethods(rowAnys) exportMethods(rowAvgsPerColSet) exportMethods(rowCollapse) exportMethods(rowCounts) exportMethods(rowCummaxs) exportMethods(rowCummins) exportMethods(rowCumprods) exportMethods(rowCumsums) exportMethods(rowDiffs) exportMethods(rowIQRDiffs) exportMethods(rowIQRs) exportMethods(rowLogSumExps) exportMethods(rowMadDiffs) exportMethods(rowMads) exportMethods(rowMaxs) exportMethods(rowMeans2) exportMethods(rowMedians) exportMethods(rowMins) exportMethods(rowOrderStats) exportMethods(rowProds) exportMethods(rowQuantiles) exportMethods(rowRanges) exportMethods(rowRanks) exportMethods(rowSdDiffs) exportMethods(rowSds) exportMethods(rowSums2) exportMethods(rowTabulates) exportMethods(rowVarDiffs) exportMethods(rowVars) exportMethods(rowWeightedMads) exportMethods(rowWeightedMeans) exportMethods(rowWeightedMedians) exportMethods(rowWeightedSds) exportMethods(rowWeightedVars) import(methods) importFrom(matrixStats,allocArray) MatrixGenerics/R/0000755000175200017520000000000014136053374014727 5ustar00biocbuildbiocbuildMatrixGenerics/R/MatrixGenerics-package.R0000644000175200017520000001176514136053374021401 0ustar00biocbuildbiocbuild#' The MatrixGenerics package #' #' The \pkg{MatrixGenerics} package defines S4 generic summary statistic #' functions that operate on matrix-Like objects. #' # NOTE: Import a single function to quieten R CMD check NOTE: # Package in Depends field not imported from: ‘matrixStats’ # These packages need to be imported from (in the NAMESPACE file) # for when this namespace is loaded but not attached. #' @importFrom matrixStats allocArray #' @import methods # #' @name MatrixGenerics-package #' @exportClass matrix_OR_array_OR_table_OR_numeric #' @aliases class:matrix_OR_array_OR_table_OR_numeric #' @aliases matrix_OR_array_OR_table_OR_numeric-class #' @aliases matrix_OR_array_OR_table_OR_numeric # NOTE: Starting with R 4.0.0 a matrix is an array so no need to explicitly # list "matrix" as a member of the union. setClassUnion("matrix_OR_array_OR_table_OR_numeric", c("array", "table", "numeric") ) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## make_default_method_def() ## ## All packages listed below must also be listed in the Suggests field. ## They are expected to implement methods for the generics defined in ## MatrixGenerics. No need to list matrixStats here as it is special and ## already imported by default. .SUGGESTED_PACKAGES_TO_SEARCH <- c( "sparseMatrixStats", ## We list DelayedMatrixStats even though the methods defined in it ## won't be found by the generics in MatrixGenerics. This is because ## DelayedMatrixStats defines its own matrixStats generics. "DelayedMatrixStats" # ... add more packages in the future ) .long_and_fancy_errmsg <- function(short_errmsg, unloaded_pkgs) { plural <- length(unloaded_pkgs) > 1L pkgs_to_install <- if (plural) "..." else paste0("\"", unloaded_pkgs, "\"") errmsg <- paste0(short_errmsg, "\n However, the following package", if (plural) "s are" else " is", " likely to contain the missing method\n but ", if (plural) "are" else "is", " not installed: ", paste0(unloaded_pkgs, collapse=", "), ".\n ", "Please install ", if (plural) "them" else "it", " (with 'BiocManager::install(", pkgs_to_install, ")')", if (plural) " " else "\n ", "and try again.") if (plural) errmsg <- paste0(errmsg, "\n Alternatively, if you know where ", "the missing method is defined, install\n only ", "that package.") errmsg } ## The purpose of .load_next_suggested_package_to_search() is to support ## useful fallbacks methods i.e. "ANY" methods that implement a fallback ## mechanism in case dispatch failed to find a suitable method. ## Try to load installed packages first. .load_next_suggested_package_to_search <- function(x, genericName=NULL) { if (is.null(genericName)) { ## The ugly and hacky code below tries to find the name of the ## generic. Taken from the implementation of callGeneric(). call <- sys.call(sys.parent(1L)) .local <- identical(call[[1L]], quote(.local)) methodCtxInd <- 1L + if (.local) 1L else 0L callerCtxInd <- methodCtxInd + 1L methodCall <- sys.call(sys.parent(methodCtxInd)) if (methods:::fromNextMethod(methodCall)) methodCtxInd <- methodCtxInd + 1L methodFrame <- parent.frame(methodCtxInd) genericName <- methods:::getGenericFromCall(methodCall, methodFrame) if (is.null(genericName)) stop("when 'genericName' is not supplied, ", ".load_next_suggested_package_to_search()\n ", "must be called from within a method body") } short_errmsg <- paste0("Failed to find a ", genericName,"() method ", "for ", class(x), " objects.") is_loaded <- vapply(.SUGGESTED_PACKAGES_TO_SEARCH, isNamespaceLoaded, logical(1)) if (all(is_loaded)) stop(short_errmsg) unloaded_pkgs <- .SUGGESTED_PACKAGES_TO_SEARCH[!is_loaded] for (pkg in unloaded_pkgs) { if (requireNamespace(pkg, quietly=TRUE)) { ## This is just a hack to refresh the method dispatch cache. ## Calling trace() on the method has the side effect of making ## showMethods(genericName) aware of the method. ## See https://github.com/Bioconductor/MatrixGenerics/pull/16#issuecomment-707516999 ## for more information. GENERIC <- match.fun(genericName) suppressMessages(trace(GENERIC, signature=class(x))) suppressMessages(untrace(GENERIC, signature=class(x))) return() } } stop(.long_and_fancy_errmsg(short_errmsg, unloaded_pkgs)) } make_default_method_def <- function(genericName) { def <- function() { } formals(def) <- formals(match.fun(genericName)) e <- expression(MatrixGenerics:::.load_next_suggested_package_to_search(x), callGeneric()) body(def) <- as.call(c(as.name("{"), e)) environment(def) <- getNamespace("MatrixGenerics") def } MatrixGenerics/R/rowAlls.R0000644000175200017520000000445014136053374016500 0ustar00biocbuildbiocbuild#' Check if all elements in a row (column) of a matrix-like object are equal to #' a value #' #' Check if all elements in a row (column) of a matrix-like object are equal to #' a value. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowAlls #' #' @templateVar rowName rowAlls #' @templateVar colName colAlls #' #' @template matrixStatsLink #' #' @template standardParameters #' @template valueParameter #' @template dimParameter #' @template na_rmParameter #' @template returnVectorLgl #' @template useNamesParameter #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowAlls]{rowAlls}()} and #' \code{matrixStats::\link[matrixStats:rowAlls]{colAlls}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For checks if \emph{any} element is equal to a value, see #' \code{\link{rowAnys}()}. #' \item \code{base::\link{all}()}. #' } #' #' @template standardExamples setGeneric("rowAlls", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowAlls"), signature = "x" ) .matrixStats_rowAlls <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowAlls(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowAlls setMethod("rowAlls", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowAlls) #' @export #' @rdname rowAlls ## Default method with user-friendly fallback mechanism. setMethod("rowAlls", "ANY", make_default_method_def("rowAlls")) #' @export #' @rdname rowAlls setGeneric("colAlls", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("colAlls"), signature = "x" ) .matrixStats_colAlls <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colAlls(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowAlls setMethod("colAlls", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colAlls) #' @export #' @rdname rowAlls ## Default method with user-friendly fallback mechanism. setMethod("colAlls", "ANY", make_default_method_def("colAlls")) MatrixGenerics/R/rowAnyNAs.R0000644000175200017520000000405314136053374016735 0ustar00biocbuildbiocbuild#' Check if any elements in a row (column) of a matrix-like object is missing #' #' Check if any elements in a row (column) of a matrix-like object is missing. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowAnyNAs #' #' @templateVar rowName rowAnyNAs #' @templateVar colName colAnyNAs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template useNamesParameter #' #' @template returnVectorLgl #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:anyMissing]{rowAnyNAs}()} and #' \code{matrixStats::\link[matrixStats:anyMissing]{colAnyNAs}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For checks if any element is equal to a value, see #' \code{\link{rowAnys}()}. #' \item \code{base::\link{is.na}()} and \code{base::\link{any}()}. #' } #' #' @template standardExamples setGeneric("rowAnyNAs", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("rowAnyNAs"), signature = "x" ) .matrixStats_rowAnyNAs <- function(x, rows = NULL, cols = NULL, ..., useNames = NA){ matrixStats::rowAnyNAs(x, rows = rows, cols = cols, ..., useNames = useNames) } #' @export #' @rdname rowAnyNAs setMethod("rowAnyNAs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowAnyNAs) #' @export #' @rdname rowAnyNAs ## Default method with user-friendly fallback mechanism. setMethod("rowAnyNAs", "ANY", make_default_method_def("rowAnyNAs")) #' @export #' @rdname rowAnyNAs setGeneric("colAnyNAs", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("colAnyNAs"), signature = "x" ) .matrixStats_colAnyNAs <- function(x, rows = NULL, cols = NULL, ..., useNames = NA){ matrixStats::colAnyNAs(x, rows = rows, cols = cols, ..., useNames = useNames) } #' @export #' @rdname rowAnyNAs setMethod("colAnyNAs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colAnyNAs) #' @export #' @rdname rowAnyNAs ## Default method with user-friendly fallback mechanism. setMethod("colAnyNAs", "ANY", make_default_method_def("colAnyNAs")) MatrixGenerics/R/rowAnys.R0000644000175200017520000000445114136053374016520 0ustar00biocbuildbiocbuild#' Check if any elements in a row (column) of a matrix-like object is equal to #' a value #' #' Check if any elements in a row (column) of a matrix-like object is equal to #' a value. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowAnys #' #' @templateVar rowName rowAnys #' @templateVar colName colAnys #' #' @template matrixStatsLink #' #' @template standardParameters #' @template valueParameter #' @template dimParameter #' @template na_rmParameter #' @template useNamesParameter #' @template returnVectorLgl #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowAlls]{rowAnys}()} and #' \code{matrixStats::\link[matrixStats:rowAlls]{colAnys}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For checks if \emph{all} elements are equal to a value, see #' \code{\link{rowAlls}()}. #' \item \code{base::\link{any}()}. #' } #' #' @template standardExamples setGeneric("rowAnys", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowAnys"), signature = "x" ) .matrixStats_rowAnys <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowAnys(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowAnys setMethod("rowAnys", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowAnys) #' @export #' @rdname rowAnys ## Default method with user-friendly fallback mechanism. setMethod("rowAnys", "ANY", make_default_method_def("rowAnys")) #' @export #' @rdname rowAnys setGeneric("colAnys", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("colAnys"), signature = "x" ) .matrixStats_colAnys <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colAnys(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowAnys setMethod("colAnys", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colAnys) #' @export #' @rdname rowAnys ## Default method with user-friendly fallback mechanism. setMethod("colAnys", "ANY", make_default_method_def("colAnys")) MatrixGenerics/R/rowAvgsPerColSet.R0000644000175200017520000000675514136053374020300 0ustar00biocbuildbiocbuild#' Calculates for each row (column) a summary statistic for equally sized #' subsets of columns (rows) #' #' Calculates for each row (column) a summary statistic for equally sized #' subsets of columns (rows). #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowAvgsPerColSet #' #' @templateVar rowName rowAvgsPerColSet #' @templateVar colName colAvgsPerRowSet #' #' @template matrixStatsLink #' #' @param X An `NxM` matrix-like object. #' @param W An optional numeric `NxM` matrix of weights. #' @param rows,cols A \code{\link{vector}} indicating the subset (and/or #' columns) to operate over. If \code{\link{NULL}}, no subsetting is #' done. #' @param S An [integer] `KxJ` matrix that specifying the `J` subsets. Each #' column hold `K` column (row) indices for the corresponding subset. The #' range of values is \[1, M\] (\[1,N\]). #' @param FUN A row-by-row (column-by-column) summary statistic function. It is #' applied to to each column (row) subset of `X` that is specified by `S`. #' @param ... Additional arguments passed to `FUN`. #' @param na.rm (logical) Argument passed to `FUN()` as `na.rm = na.rm`. #' If `NA` (default), then `na.rm = TRUE` is used if `X` or `S` holds missing values, #' otherwise `na.rm = FALSE`. #' @param tFUN If `TRUE`, `X` is transposed before it is passed to `FUN`. #' #' #' @return Returns a numeric `JxN` (`MxJ`) matrix. #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowAvgsPerColSet]{rowAvgsPerColSet}()} #' and \code{matrixStats::\link[matrixStats:rowAvgsPerColSet]{colAvgsPerRowSet}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' } #' #' @examples #' mat <- matrix(rnorm(20), nrow = 5, ncol = 4) #' mat[2, 1] <- NA #' mat[3, 3] <- Inf #' mat[4, 1] <- 0 #' #' print(mat) #' #' S <- matrix(1:ncol(mat), ncol = 2) #' print(S) #' #' rowAvgsPerColSet(mat, S = S, FUN = rowMeans) #' rowAvgsPerColSet(mat, S = S, FUN = rowVars) #' #' @keywords array iteration robust univar2 setGeneric("rowAvgsPerColSet", function(X, W = NULL, rows = NULL, S, FUN = rowMeans, ..., na.rm = NA, tFUN = FALSE) standardGeneric("rowAvgsPerColSet"), signature = "X" ) .matrixStats_rowAvgsPerColSet <- function(X, W = NULL, rows = NULL, S, FUN = rowMeans, ..., na.rm = NA, tFUN = FALSE){ matrixStats::rowAvgsPerColSet(X = X, W = W, rows = rows, S = S, FUN = FUN, ..., na.rm = na.rm, tFUN = tFUN) } #' @export #' @rdname rowAvgsPerColSet setMethod("rowAvgsPerColSet", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowAvgsPerColSet) #' @export #' @rdname rowAvgsPerColSet ## Default method with user-friendly fallback mechanism. setMethod("rowAvgsPerColSet", "ANY", make_default_method_def("rowAvgsPerColSet")) #' @export #' @rdname rowAvgsPerColSet setGeneric("colAvgsPerRowSet", function(X, W = NULL, cols = NULL, S, FUN = colMeans, ..., na.rm = NA, tFUN = FALSE) standardGeneric("colAvgsPerRowSet"), signature = "X" ) .matrixStats_colAvgsPerRowSet <- function(X, W = NULL, cols = NULL, S, FUN = colMeans, ..., na.rm = NA, tFUN = FALSE){ matrixStats::colAvgsPerRowSet(X = X, W = W, cols = cols, S = S, FUN = FUN, ..., na.rm = na.rm, tFUN = tFUN) } #' @export #' @rdname rowAvgsPerColSet setMethod("colAvgsPerRowSet", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colAvgsPerRowSet) #' @export #' @rdname rowAvgsPerColSet ## Default method with user-friendly fallback mechanism. setMethod("colAvgsPerRowSet", "ANY", make_default_method_def("colAvgsPerRowSet")) MatrixGenerics/R/rowCollapse.R0000644000175200017520000000457514136053374017357 0ustar00biocbuildbiocbuild#' Extract one cell from each row (column) of a matrix-like object #' #' Extract one cell from each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCollapse #' #' @templateVar rowName rowCollapse #' @templateVar colName colCollapse #' #' @template matrixStatsLink #' #' @template standardParameters #' @template dimParameter #' @param idxs An index \code{\link{vector}} with the position to extract. #' It is recycled to match the number of rows (column) #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowCollapse]{rowCollapse}()} #' and \code{matrixStats::\link[matrixStats:rowCollapse]{colCollapse}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' } #' #' @examples #' mat <- matrix(rnorm(15), nrow = 5, ncol = 3) #' mat[2, 1] <- NA #' mat[3, 3] <- Inf #' mat[4, 1] <- 0 #' #' print(mat) #' #' rowCollapse(mat, idxs = 2) #' rowCollapse(mat, idxs = c(1,1,2,3,2)) #' #' colCollapse (mat, idxs = 4) #' #' @keywords array iteration robust univar setGeneric("rowCollapse", function(x, idxs, rows = NULL, ..., useNames = NA) standardGeneric("rowCollapse"), signature = "x" ) .matrixStats_rowCollapse <- function(x, idxs, rows = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCollapse(x, idxs = idxs, rows = rows, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCollapse setMethod("rowCollapse", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCollapse) #' @export #' @rdname rowCollapse ## Default method with user-friendly fallback mechanism. setMethod("rowCollapse", "ANY", make_default_method_def("rowCollapse")) #' @export #' @rdname rowCollapse setGeneric("colCollapse", function(x, idxs = idxs, cols = NULL, ..., useNames = NA) standardGeneric("colCollapse"), signature = "x" ) .matrixStats_colCollapse <- function(x, idxs, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colCollapse(x, idxs = idxs, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCollapse setMethod("colCollapse", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCollapse) #' @export #' @rdname rowCollapse ## Default method with user-friendly fallback mechanism. setMethod("colCollapse", "ANY", make_default_method_def("colCollapse")) MatrixGenerics/R/rowCounts.R0000644000175200017520000000473214136053374017063 0ustar00biocbuildbiocbuild#' Count how often an element in a row (column) of a matrix-like object is #' equal to a value #' #' Count how often an element in a row (column) of a matrix-like object is #' equal to a value. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCounts #' #' @templateVar rowName rowCounts #' @templateVar colName colCounts #' #' @template matrixStatsLink #' #' @template standardParameters #' @template valueParameter #' @template dimParameter #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVectorInt #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowCounts}()} and #' \code{matrixStats::\link[matrixStats:rowCounts]{colCounts}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For checks if any element is equal to a value, see #' \code{\link{rowAnys}()}. To check if all elements are equal, see #' \code{\link{rowAlls}()}. #' } #' #' @template standardExamples #' #' @examples #' rowCounts(mat, value = 0) #' colCounts(mat, value = Inf, na.rm = TRUE) setGeneric("rowCounts", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowCounts"), signature = "x" ) .matrixStats_rowCounts <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCounts(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCounts setMethod("rowCounts", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCounts) #' @export #' @rdname rowCounts ## Default method with user-friendly fallback mechanism. setMethod("rowCounts", "ANY", make_default_method_def("rowCounts")) #' @export #' @rdname rowCounts setGeneric("colCounts", function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) standardGeneric("colCounts"), signature = "x" ) .matrixStats_colCounts <- function(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colCounts(x, rows = rows, cols = cols, value = value, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCounts setMethod("colCounts", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCounts) #' @export #' @rdname rowCounts ## Default method with user-friendly fallback mechanism. setMethod("colCounts", "ANY", make_default_method_def("colCounts")) MatrixGenerics/R/rowCummaxs.R0000644000175200017520000000424514136053374017224 0ustar00biocbuildbiocbuild#' Calculates the cumulative maxima for each row (column) of a matrix-like #' object #' #' Calculates the cumulative maxima for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCummaxs #' #' @templateVar rowName rowCummaxs #' @templateVar colName colCummaxs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template dimParameter #' @template useNamesParameter #' #' @template returnMatrix_SameDimX #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCummaxs}()} and #' \code{matrixStats::\link[matrixStats:rowCumsums]{colCummaxs}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For single maximum estimates, see \code{\link{rowMaxs}()}. #' \item \code{base::\link{cummax}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowCummaxs", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("rowCummaxs"), signature = "x" ) .matrixStats_rowCummaxs <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCummaxs(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCummaxs setMethod("rowCummaxs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCummaxs) #' @export #' @rdname rowCummaxs ## Default method with user-friendly fallback mechanism. setMethod("rowCummaxs", "ANY", make_default_method_def("rowCummaxs")) #' @export #' @rdname rowCummaxs setGeneric("colCummaxs", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("colCummaxs"), signature = "x" ) .matrixStats_colCummaxs <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colCummaxs(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCummaxs setMethod("colCummaxs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCummaxs) #' @export #' @rdname rowCummaxs ## Default method with user-friendly fallback mechanism. setMethod("colCummaxs", "ANY", make_default_method_def("colCummaxs")) MatrixGenerics/R/rowCummins.R0000644000175200017520000000424514136053374017222 0ustar00biocbuildbiocbuild#' Calculates the cumulative minima for each row (column) of a matrix-like #' object #' #' Calculates the cumulative minima for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCummins #' #' @templateVar rowName rowCummins #' @templateVar colName colCummins #' #' @template matrixStatsLink #' #' @template standardParameters #' @template dimParameter #' @template useNamesParameter #' #' @template returnMatrix_SameDimX #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCummins}()} and #' \code{matrixStats::\link[matrixStats:rowCumsums]{colCummins}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For single minimum estimates, see \code{\link{rowMins}()}. #' \item \code{base::\link{cummin}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowCummins", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("rowCummins"), signature = "x" ) .matrixStats_rowCummins <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCummins(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCummins setMethod("rowCummins", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCummins) #' @export #' @rdname rowCummins ## Default method with user-friendly fallback mechanism. setMethod("rowCummins", "ANY", make_default_method_def("rowCummins")) #' @export #' @rdname rowCummins setGeneric("colCummins", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("colCummins"), signature = "x" ) .matrixStats_colCummins <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colCummins(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCummins setMethod("colCummins", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCummins) #' @export #' @rdname rowCummins ## Default method with user-friendly fallback mechanism. setMethod("colCummins", "ANY", make_default_method_def("colCummins")) MatrixGenerics/R/rowCumprods.R0000644000175200017520000000417714136053374017407 0ustar00biocbuildbiocbuild#' Calculates the cumulative product for each row (column) of a matrix-like #' object #' #' Calculates the cumulative product for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCumprods #' #' @templateVar rowName rowCumprods #' @templateVar colName colCumprods #' #' @template matrixStatsLink #' #' @template standardParameters #' @template dimParameter #' @template useNamesParameter #' #' @template returnMatrix_SameDimX #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCumprods}()} and #' \code{matrixStats::\link[matrixStats:rowCumsums]{colCumprods}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' \item \code{base::\link{cumprod}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowCumprods", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("rowCumprods"), signature = "x" ) .matrixStats_rowCumprods <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCumprods(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCumprods setMethod("rowCumprods", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCumprods) #' @export #' @rdname rowCumprods ## Default method with user-friendly fallback mechanism. setMethod("rowCumprods", "ANY", make_default_method_def("rowCumprods")) #' @export #' @rdname rowCumprods setGeneric("colCumprods", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("colCumprods"), signature = "x" ) .matrixStats_colCumprods <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colCumprods(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCumprods setMethod("colCumprods", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCumprods) #' @export #' @rdname rowCumprods ## Default method with user-friendly fallback mechanism. setMethod("colCumprods", "ANY", make_default_method_def("colCumprods")) MatrixGenerics/R/rowCumsums.R0000644000175200017520000000411314136053374017235 0ustar00biocbuildbiocbuild#' Calculates the cumulative sum for each row (column) of a matrix-like object #' #' Calculates the cumulative sum for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowCumsums #' #' @templateVar rowName rowCumsums #' @templateVar colName colCumsums #' #' @template matrixStatsLink #' #' @template standardParameters #' @template dimParameter #' @template useNamesParameter #' #' @template returnMatrix_SameDimX #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowCumsums}()} and #' \code{matrixStats::\link[matrixStats:rowCumsums]{colCumsums}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item \code{base::\link{cumsum}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowCumsums", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("rowCumsums"), signature = "x" ) .matrixStats_rowCumsums <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowCumsums(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCumsums setMethod("rowCumsums", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowCumsums) #' @export #' @rdname rowCumsums ## Default method with user-friendly fallback mechanism. setMethod("rowCumsums", "ANY", make_default_method_def("rowCumsums")) #' @export #' @rdname rowCumsums setGeneric("colCumsums", function(x, rows = NULL, cols = NULL, ..., useNames = NA) standardGeneric("colCumsums"), signature = "x" ) .matrixStats_colCumsums <- function(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colCumsums(x, rows = rows, cols = cols, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowCumsums setMethod("colCumsums", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colCumsums) #' @export #' @rdname rowCumsums ## Default method with user-friendly fallback mechanism. setMethod("colCumsums", "ANY", make_default_method_def("colCumsums")) MatrixGenerics/R/rowDiffs.R0000644000175200017520000000470414136053374016642 0ustar00biocbuildbiocbuild#' Calculates the difference between each element of a row (column) of a #' matrix-like object #' #' Calculates the difference between each element of a row (column) of a #' matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowDiffs #' #' @templateVar rowName rowDiffs #' @templateVar colName colDiffs #' #' @template matrixStatsLink #' #' @template standardParameters #' @param lag An integer specifying the lag. #' @param differences An integer specifying the order of difference. #' @template dimParameter #' @template useNamesParameter #' #' @return Returns a \code{\link{numeric}} \code{\link{matrix}} with one column #' (row) less than x: \eqn{Nx(K-1)} or \eqn{(N-1)xK}. #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowDiffs}()} and #' \code{matrixStats::\link[matrixStats:rowDiffs]{colDiffs}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item \code{base::\link{diff}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowDiffs", function(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) standardGeneric("rowDiffs"), signature = "x" ) .matrixStats_rowDiffs <- function(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, dim. = dim(x), ..., useNames = NA){ matrixStats::rowDiffs(x, rows = rows, cols = cols, lag = lag, differences = differences, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowDiffs setMethod("rowDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowDiffs) #' @export #' @rdname rowDiffs ## Default method with user-friendly fallback mechanism. setMethod("rowDiffs", "ANY", make_default_method_def("rowDiffs")) #' @export #' @rdname rowDiffs setGeneric("colDiffs", function(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) standardGeneric("colDiffs"), signature = "x" ) .matrixStats_colDiffs <- function(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, dim. = dim(x), ..., useNames = NA){ matrixStats::colDiffs(x, rows = rows, cols = cols, lag = lag, differences = differences, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowDiffs setMethod("colDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colDiffs) #' @export #' @rdname rowDiffs ## Default method with user-friendly fallback mechanism. setMethod("colDiffs", "ANY", make_default_method_def("colDiffs")) MatrixGenerics/R/rowIQRDiffs.R0000644000175200017520000000463414136053374017220 0ustar00biocbuildbiocbuild#' Calculates the interquartile range of the difference between each element of #' a row (column) of a matrix-like object #' #' Calculates the interquartile range of the difference between each element of #' a row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowIQRDiffs #' #' @templateVar rowName rowIQRDiffs #' @templateVar colName colIQRDiffs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template diff_trimParameters #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:varDiff]{rowIQRDiffs}()} and #' \code{matrixStats::\link[matrixStats:varDiff]{colIQRDiffs}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' \item For the direct interquartile range see also [rowIQRs]. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowIQRDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("rowIQRDiffs"), signature = "x" ) .matrixStats_rowIQRDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::rowIQRDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowIQRDiffs setMethod("rowIQRDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowIQRDiffs) #' @export #' @rdname rowIQRDiffs ## Default method with user-friendly fallback mechanism. setMethod("rowIQRDiffs", "ANY", make_default_method_def("rowIQRDiffs")) #' @export #' @rdname rowIQRDiffs setGeneric("colIQRDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("colIQRDiffs"), signature = "x" ) .matrixStats_colIQRDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::colIQRDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowIQRDiffs setMethod("colIQRDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colIQRDiffs) #' @export #' @rdname rowIQRDiffs ## Default method with user-friendly fallback mechanism. setMethod("colIQRDiffs", "ANY", make_default_method_def("colIQRDiffs")) MatrixGenerics/R/rowIQRs.R0000644000175200017520000000422514136053374016423 0ustar00biocbuildbiocbuild#' Calculates the interquartile range for each row (column) of a matrix-like #' object #' #' Calculates the interquartile range for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowIQRs #' #' @templateVar rowName rowIQRs #' @templateVar colName colIQRs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowIQRs}()} and #' \code{matrixStats::\link[matrixStats:rowIQRs]{colIQRs}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For a non-robust analog, see \code{\link{rowSds}()}. For a more #' robust version see [rowMads()] #' \item \code{stats::\link[stats]{IQR}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowIQRs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowIQRs"), signature = "x" ) .matrixStats_rowIQRs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::rowIQRs(x, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowIQRs setMethod("rowIQRs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowIQRs) #' @export #' @rdname rowIQRs ## Default method with user-friendly fallback mechanism. setMethod("rowIQRs", "ANY", make_default_method_def("rowIQRs")) #' @export #' @rdname rowIQRs setGeneric("colIQRs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colIQRs"), signature = "x" ) .matrixStats_colIQRs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::colIQRs(x, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowIQRs setMethod("colIQRs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colIQRs) #' @export #' @rdname rowIQRs ## Default method with user-friendly fallback mechanism. setMethod("colIQRs", "ANY", make_default_method_def("colIQRs")) MatrixGenerics/R/rowLogSumExps.R0000644000175200017520000000511014136053374017645 0ustar00biocbuildbiocbuild#' Accurately calculates the logarithm of the sum of exponentials for each row #' (column) of a matrix-like object #' #' Accurately calculates the logarithm of the sum of exponentials for each row #' (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowLogSumExps #' #' @templateVar rowName rowLogSumExps #' @templateVar colName colLogSumExps #' #' @template matrixStatsLink #' #' @param lx An NxK matrix-like object. Typically `lx` are `log(x)` values. #' @param rows,cols A \code{\link{vector}} indicating the subset (and/or #' columns) to operate over. If \code{\link{NULL}}, no subsetting is done. #' @param ... Additional arguments passed to specific methods. #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowLogSumExps}()} and #' \code{matrixStats::\link[matrixStats:rowLogSumExps]{colLogSumExps}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item [rowSums2()] #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowLogSumExps", function(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowLogSumExps"), signature = "lx" ) .matrixStats_rowLogSumExps <- function(lx, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(lx), ..., useNames = NA){ matrixStats::rowLogSumExps(lx, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowLogSumExps setMethod("rowLogSumExps", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowLogSumExps) #' @export #' @rdname rowLogSumExps ## Default method with user-friendly fallback mechanism. setMethod("rowLogSumExps", "ANY", make_default_method_def("rowLogSumExps")) #' @export #' @rdname rowLogSumExps setGeneric("colLogSumExps", function(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colLogSumExps"), signature = "lx" ) .matrixStats_colLogSumExps <- function(lx, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(lx), ..., useNames = NA){ matrixStats::colLogSumExps(lx, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowLogSumExps setMethod("colLogSumExps", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colLogSumExps) #' @export #' @rdname rowLogSumExps ## Default method with user-friendly fallback mechanism. setMethod("colLogSumExps", "ANY", make_default_method_def("colLogSumExps")) MatrixGenerics/R/rowMadDiffs.R0000644000175200017520000000454314136053374017265 0ustar00biocbuildbiocbuild#' Calculates the mean absolute deviation of the difference between each #' element of a row (column) of a matrix-like object #' #' Calculates the mean absolute deviation of the difference between each #' element of a row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMadDiffs #' #' @templateVar rowName rowMadDiffs #' @templateVar colName colMadDiffs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template diff_trimParameters #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:varDiff]{rowMadDiffs}()} and #' \code{matrixStats::\link[matrixStats:varDiff]{colMadDiffs}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowMadDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("rowMadDiffs"), signature = "x" ) .matrixStats_rowMadDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::rowMadDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowMadDiffs setMethod("rowMadDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMadDiffs) #' @export #' @rdname rowMadDiffs ## Default method with user-friendly fallback mechanism. setMethod("rowMadDiffs", "ANY", make_default_method_def("rowMadDiffs")) #' @export #' @rdname rowMadDiffs setGeneric("colMadDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("colMadDiffs"), signature = "x" ) .matrixStats_colMadDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::colMadDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff =diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowMadDiffs setMethod("colMadDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMadDiffs) #' @export #' @rdname rowMadDiffs ## Default method with user-friendly fallback mechanism. setMethod("colMadDiffs", "ANY", make_default_method_def("colMadDiffs")) MatrixGenerics/R/rowMads.R0000644000175200017520000000522614136053374016473 0ustar00biocbuildbiocbuild#' Calculates the median absolute deviation for each row (column) of a #' matrix-like object #' #' Calculates the median absolute deviation for each row (column) of a #' matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMads #' #' @templateVar rowName rowMads #' @templateVar colName colMads #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @param center (optional) the center, defaults to the row means #' @param constant A scale factor. See \code{stats::\link[stats]{mad}()} for #' details. #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowSds]{rowMads}()} and #' \code{matrixStats::\link[matrixStats:rowSds]{colMads}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For mean estimates, see \code{\link{rowMeans2}()} and #' \code{\link[base:colSums]{rowMeans}()}. #' \item For non-robust standard deviation estimates, see #' \code{\link{rowSds}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowMads", function(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowMads"), signature = "x" ) .matrixStats_rowMads <- function(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowMads(x, rows = rows, cols = cols, center = center, constant = constant, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMads setMethod("rowMads", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMads) #' @export #' @rdname rowMads ## Default method with user-friendly fallback mechanism. setMethod("rowMads", "ANY", make_default_method_def("rowMads")) #' @export #' @rdname rowMads setGeneric("colMads", function(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) standardGeneric("colMads"), signature = "x" ) .matrixStats_colMads <- function(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colMads(x, rows = rows, cols = cols, center = center, constant = constant, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMads setMethod("colMads", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMads) #' @export #' @rdname rowMads ## Default method with user-friendly fallback mechanism. setMethod("colMads", "ANY", make_default_method_def("colMads")) MatrixGenerics/R/rowMaxs.R0000644000175200017520000000416614136053374016521 0ustar00biocbuildbiocbuild#' Calculates the maximum for each row (column) of a matrix-like object #' #' Calculates the maximum for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMaxs #' #' @templateVar rowName rowMaxs #' @templateVar colName colMaxs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowRanges]{rowMaxs}()} and #' \code{matrixStats::\link[matrixStats:rowRanges]{colMaxs}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For min estimates, see \code{\link{rowMins}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowMaxs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowMaxs"), signature = "x" ) .matrixStats_rowMaxs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowMaxs(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMaxs setMethod("rowMaxs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMaxs) #' @export #' @rdname rowMaxs ## Default method with user-friendly fallback mechanism. setMethod("rowMaxs", "ANY", make_default_method_def("rowMaxs")) #' @export #' @rdname rowMaxs setGeneric("colMaxs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colMaxs"), signature = "x" ) .matrixStats_colMaxs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colMaxs(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMaxs setMethod("colMaxs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMaxs) #' @export #' @rdname rowMaxs ## Default method with user-friendly fallback mechanism. setMethod("colMaxs", "ANY", make_default_method_def("colMaxs")) MatrixGenerics/R/rowMeans2.R0000644000175200017520000000451714136053374016736 0ustar00biocbuildbiocbuild#' Calculates the mean for each row (column) of a matrix-like object #' #' Calculates the mean for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMeans2 #' #' @templateVar rowName rowMeans2 #' @templateVar colName colMeans2 #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowMeans2}()} and #' \code{matrixStats::\link[matrixStats:rowMeans2]{colMeans2}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also \code{\link[base:colSums]{rowMeans}()} for the #' corresponding function in base R. #' \item For variance estimates, see \code{\link{rowVars}()}. #' \item See also the base R version \code{base::\link{rowMeans}()}. #' } #' #' @template standardExamples #' #' #' @keywords array iteration robust univar setGeneric("rowMeans2", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowMeans2"), signature = "x" ) .matrixStats_rowMeans2 <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowMeans2(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMeans2 setMethod("rowMeans2", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMeans2) #' @export #' @rdname rowMeans2 ## Default method with user-friendly fallback mechanism. setMethod("rowMeans2", "ANY", make_default_method_def("rowMeans2")) #' @export #' @rdname rowMeans2 setGeneric("colMeans2", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colMeans2"), signature = "x" ) .matrixStats_colMeans2 <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colMeans2(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMeans2 setMethod("colMeans2", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMeans2) #' @export #' @rdname rowMeans2 ## Default method with user-friendly fallback mechanism. setMethod("colMeans2", "ANY", make_default_method_def("colMeans2")) MatrixGenerics/R/rowMedians.R0000644000175200017520000000435414136053374017170 0ustar00biocbuildbiocbuild#' Calculates the median for each row (column) of a matrix-like object #' #' Calculates the median for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMedians #' #' @templateVar rowName rowMedians #' @templateVar colName colMedians #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowMedians}()} and #' \code{matrixStats::\link[matrixStats:rowMedians]{colMedians}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For mean estimates, see \code{\link{rowMeans2}()} and #' \code{\link[base:colSums]{rowMeans}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowMedians", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowMedians"), signature = "x" ) .matrixStats_rowMedians <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowMedians(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMedians setMethod("rowMedians", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMedians) #' @export #' @rdname rowMedians ## Default method with user-friendly fallback mechanism. setMethod("rowMedians", "ANY", make_default_method_def("rowMedians")) #' @export #' @rdname rowMedians setGeneric("colMedians", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colMedians"), signature = "x" ) .matrixStats_colMedians <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colMedians(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMedians setMethod("colMedians", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMedians) #' @export #' @rdname rowMedians ## Default method with user-friendly fallback mechanism. setMethod("colMedians", "ANY", make_default_method_def("colMedians")) MatrixGenerics/R/rowMins.R0000644000175200017520000000416614136053374016517 0ustar00biocbuildbiocbuild#' Calculates the minimum for each row (column) of a matrix-like object #' #' Calculates the minimum for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowMins #' #' @templateVar rowName rowMins #' @templateVar colName colMins #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:rowRanges]{rowMins}()} and #' \code{matrixStats::\link[matrixStats:rowRanges]{colMins}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For max estimates, see \code{\link{rowMaxs}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowMins", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowMins"), signature = "x" ) .matrixStats_rowMins <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowMins(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMins setMethod("rowMins", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowMins) #' @export #' @rdname rowMins ## Default method with user-friendly fallback mechanism. setMethod("rowMins", "ANY", make_default_method_def("rowMins")) #' @export #' @rdname rowMins setGeneric("colMins", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colMins"), signature = "x" ) .matrixStats_colMins <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colMins(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowMins setMethod("colMins", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colMins) #' @export #' @rdname rowMins ## Default method with user-friendly fallback mechanism. setMethod("colMins", "ANY", make_default_method_def("colMins")) MatrixGenerics/R/rowOrderStats.R0000644000175200017520000000473114136053374017701 0ustar00biocbuildbiocbuild#' Calculates an order statistic for each row (column) of a matrix-like object #' #' Calculates an order statistic for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowOrderStats #' #' @templateVar rowName rowOrderStats #' @templateVar colName colOrderStats #' #' @template matrixStatsLink #' #' @template standardParameters #' @param which An integer index in \[1,K\] (\[1,N\]) indicating which order #' statistic to be returned #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowOrderStats}()} and #' \code{matrixStats::\link[matrixStats:rowOrderStats]{colOrderStats}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' } #' #' @examples #' mat <- matrix(rnorm(15), nrow = 5, ncol = 3) #' mat[2, 1] <- 2 #' mat[3, 3] <- Inf #' mat[4, 1] <- 0 #' #' print(mat) #' #' rowOrderStats(mat, which = 1) #' colOrderStats(mat, which = 3) #' #' @keywords array iteration robust univar setGeneric("rowOrderStats", function(x, rows = NULL, cols = NULL, which, ..., useNames = NA) standardGeneric("rowOrderStats"), signature = "x" ) .matrixStats_rowOrderStats <- function(x, rows = NULL, cols = NULL, which, dim. = dim(x), ..., useNames = NA){ matrixStats::rowOrderStats(x, rows = rows, cols = cols, which = which, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowOrderStats setMethod("rowOrderStats", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowOrderStats) #' @export #' @rdname rowOrderStats ## Default method with user-friendly fallback mechanism. setMethod("rowOrderStats", "ANY", make_default_method_def("rowOrderStats")) #' @export #' @rdname rowOrderStats setGeneric("colOrderStats", function(x, rows = NULL, cols = NULL, which, ..., useNames = NA) standardGeneric("colOrderStats"), signature = "x" ) .matrixStats_colOrderStats <- function(x, rows = NULL, cols = NULL, which, dim. = dim(x), ..., useNames = NA){ matrixStats::colOrderStats(x, rows = rows, cols = cols, which = which, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowOrderStats setMethod("colOrderStats", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colOrderStats) #' @export #' @rdname rowOrderStats ## Default method with user-friendly fallback mechanism. setMethod("colOrderStats", "ANY", make_default_method_def("colOrderStats")) MatrixGenerics/R/rowProds.R0000644000175200017520000000465014136053374016676 0ustar00biocbuildbiocbuild#' Calculates the product for each row (column) of a matrix-like object #' #' Calculates the product for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowProds #' #' @templateVar rowName rowProds #' @templateVar colName colProds #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @param method A character vector of length one that specifies the #' how the product is calculated. Note, that this is not a generic #' argument and not all implementation have to provide it. #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowProds}()} and #' \code{matrixStats::\link[matrixStats:rowProds]{colProds}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For sums across rows (columns), see #' \code{\link{rowSums2}()} ([colSums2()]) #' \item \code{base::\link{prod}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowProds", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowProds"), signature = "x" ) .matrixStats_rowProds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, method = c("direct", "expSumLog"), ..., useNames = NA){ matrixStats::rowProds(x, rows = rows, cols = cols, na.rm = na.rm, method = method, ..., useNames = useNames) } #' @export #' @rdname rowProds setMethod("rowProds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowProds) #' @export #' @rdname rowProds ## Default method with user-friendly fallback mechanism. setMethod("rowProds", "ANY", make_default_method_def("rowProds")) #' @export #' @rdname rowProds setGeneric("colProds", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colProds"), signature = "x" ) .matrixStats_colProds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, method = c("direct", "expSumLog"), ..., useNames = NA){ matrixStats::colProds(x, rows = rows, cols = cols, na.rm = na.rm, method = method, ..., useNames = useNames) } #' @export #' @rdname rowProds setMethod("colProds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colProds) #' @export #' @rdname rowProds ## Default method with user-friendly fallback mechanism. setMethod("colProds", "ANY", make_default_method_def("colProds")) MatrixGenerics/R/rowQuantiles.R0000644000175200017520000000543614136053374017557 0ustar00biocbuildbiocbuild#' Calculates quantiles for each row (column) of a matrix-like object #' #' Calculates quantiles for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowQuantiles #' #' @templateVar rowName rowQuantiles #' @templateVar colName colQuantiles #' #' @template matrixStatsLink #' #' @template standardParameters #' @param probs A numeric vector of J probabilities in \[0, 1\]. #' @template na_rmParameter #' @param type An integer specifying the type of estimator. See #' \code{stats::\link[stats]{quantile}()}. for more details. #' @param drop If `TRUE` a vector is returned if `J == 1`. #' @template useNamesParameter #' #' @template returnMatrix_JDim #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowQuantiles}()} and #' \code{matrixStats::\link[matrixStats:rowQuantiles]{colQuantiles}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' \item [stats::quantile] #' } #' #' @template standardExamples #' #' @keywords array iteration robust setGeneric("rowQuantiles", function(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) standardGeneric("rowQuantiles"), signature = "x" ) .matrixStats_rowQuantiles <- function(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) { matrixStats::rowQuantiles(x = x, rows = rows, cols = cols, probs = probs, na.rm = na.rm, type = type, ..., useNames = useNames, drop = drop) } #' @export #' @rdname rowQuantiles setMethod("rowQuantiles", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowQuantiles) #' @export #' @rdname rowQuantiles ## Default method with user-friendly fallback mechanism. setMethod("rowQuantiles", "ANY", make_default_method_def("rowQuantiles")) #' @export #' @rdname rowQuantiles setGeneric("colQuantiles", function(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) standardGeneric("colQuantiles"), signature = "x" ) .matrixStats_colQuantiles <- function(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) { matrixStats::colQuantiles(x = x, rows = rows, cols = cols, probs = probs, na.rm = na.rm, type = type, ..., useNames = useNames, drop = drop) } #' @export #' @rdname rowQuantiles setMethod("colQuantiles", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colQuantiles) #' @export #' @rdname rowQuantiles ## Default method with user-friendly fallback mechanism. setMethod("colQuantiles", "ANY", make_default_method_def("colQuantiles")) MatrixGenerics/R/rowRanges.R0000644000175200017520000000734714136053374017034 0ustar00biocbuildbiocbuild#' Calculates the minimum and maximum for each row (column) of a matrix-like #' object #' #' Calculates the minimum and maximum for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowRanges #' #' @templateVar rowName rowRanges #' @templateVar colName colRanges #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @return a \code{\link{numeric}} \code{Nx2} (\code{Kx2}) #' \code{\link{matrix}}, where N (K) is the number of rows (columns) for #' which the ranges are calculated. #' #' @note Unfortunately for the argument list of the \code{rowRanges()} #' generic function we cannot follow the scheme used for the other #' row/column matrix summarization generic functions. This is because #' we need to be compatible with the historic \code{rowRanges()} getter #' for \link[SummarizedExperiment]{RangedSummarizedExperiment} objects. #' See \code{?SummarizedExperiment::\link[SummarizedExperiment]{rowRanges}}. #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowRanges}()} and #' \code{matrixStats::\link[matrixStats:rowRanges]{colRanges}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item For max estimates, see \code{\link{rowMaxs}()}. #' \item For min estimates, see \code{\link{rowMins}()}. #' \item \code{base::\link{range}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust setGeneric("rowRanges", function(x, ...) standardGeneric("rowRanges")) .matrixStats_rowRanges <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowRanges(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowRanges setMethod("rowRanges", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowRanges) ## Note that because the rowRanges() accessor for SummarizedExperiment ## objects (and other objects in Bioconductor) is implemented as a method ## for the MatrixGenerics::rowRanges() generic, the user-friendly fallback ## mechanism for rowRanges() could produce an error message like: ## ## Error in MatrixGenerics:::.load_next_suggested_package_to_search(x) : ## Failed to find a rowRanges() method for objects. ## However, the following package is likely to contain the missing ## method but is not installed: sparseMatrixStats. ## Please install it (with 'BiocManager::install("sparseMatrixStats")') ## and try again. ## ## in the (admittedly rare) situations where the user tries to call the ## accessor on a SummarizedExperiment or RaggedExperiment object etc.. but ## doesn't have the SummarizedExperiment or RaggedExperiment package loaded. ## Not clear that this can even happen, but if it did, the error message ## would be quite misleading. #' @export #' @rdname rowRanges ## Default method with user-friendly fallback mechanism. setMethod("rowRanges", "ANY", make_default_method_def("rowRanges")) #' @export #' @rdname rowRanges setGeneric("colRanges", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colRanges"), signature = "x" ) .matrixStats_colRanges <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colRanges(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowRanges setMethod("colRanges", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colRanges) #' @export #' @rdname rowRanges ## Default method with user-friendly fallback mechanism. setMethod("colRanges", "ANY", make_default_method_def("colRanges")) MatrixGenerics/R/rowRanks.R0000644000175200017520000000720014136053374016657 0ustar00biocbuildbiocbuild#' Calculates the rank of the elements for each row (column) of a matrix-like #' object #' #' Calculates the rank of the elements for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowRanks #' #' @templateVar rowName rowRanks #' @templateVar colName colRanks #' #' @template matrixStatsLink #' #' @template standardParameters #' @param ties.method A character string specifying how ties are treated. Note #' that the default specifies fewer options than the original matrixStats #' package. #' @template dimParameter #' @param preserveShape If `TRUE` the output matrix has the same shape as the #' input x. Note, that this is not a generic argument and not all #' implementation of this function have to provide it. #' @template useNamesParameter #' #' @return a matrix of type \code{\link{integer}} is returned unless #' `ties.method = "average"`. Ithas dimensions` \code{NxJ} (\code{KxJ}) #' \code{\link{matrix}}, where N (K) is the number of rows (columns) of the #' input x. #' #' @details #' The `matrixStats::rowRanks()` function can handle a lot of different #' values for the `ties.method` argument. Users of the generic function #' should however only rely on `max` and `average` because the other ones #' are not guaranteed to be implemented: #' \describe{ #' \item{`max`}{for values with identical values the maximum rank is #' returned} #' \item{`average`}{for values with identical values the average of the #' ranks they cover is returned. Note, that in this case the return #' value is of type `numeric`.} #' } #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowRanks}()} and #' \code{matrixStats::\link[matrixStats:rowRanks]{colRanks}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item [base::rank] #' } #' #' @template standardExamples #' #' @keywords array iteration robust setGeneric("rowRanks", function(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) standardGeneric("rowRanks"), signature = "x" ) .matrixStats_rowRanks <- function(x, rows = NULL, cols = NULL, ties.method = c("max", "average", "first", "last", "random", "max", "min", "dense"), dim. = dim(x), ..., useNames = NA){ matrixStats::rowRanks(x = x, rows = rows, cols = cols, ties.method = ties.method, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowRanks setMethod("rowRanks", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowRanks) #' @export #' @rdname rowRanks ## Default method with user-friendly fallback mechanism. setMethod("rowRanks", "ANY", make_default_method_def("rowRanks")) #' @export #' @rdname rowRanks setGeneric("colRanks", function(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) standardGeneric("colRanks"), signature = "x" ) .matrixStats_colRanks <- function(x, rows = NULL, cols = NULL, ties.method = c("max", "average", "first", "last", "random", "max", "min", "dense"), dim. = dim(x), preserveShape = FALSE, ..., useNames = NA){ matrixStats::colRanks(x = x, rows = rows, cols = cols, ties.method = ties.method, dim. = dim., preserveShape = preserveShape, ..., useNames = useNames) } #' @export #' @rdname rowRanks setMethod("colRanks", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colRanks) #' @export #' @rdname rowRanks ## Default method with user-friendly fallback mechanism. setMethod("colRanks", "ANY", make_default_method_def("colRanks")) MatrixGenerics/R/rowSdDiffs.R0000644000175200017520000000457414136053374017136 0ustar00biocbuildbiocbuild#' Calculates the standard deviation of the difference between each element of #' a row (column) of a matrix-like object #' #' Calculates the standard deviation of the difference between each element of #' a row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowSdDiffs #' #' @templateVar rowName rowSdDiffs #' @templateVar colName colSdDiffs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template diff_trimParameters #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:varDiff]{rowSdDiffs}()} and #' \code{matrixStats::\link[matrixStats:varDiff]{colSdDiffs}()} which are #' used when the input is a \code{matrix} or \code{numeric} vector. #' \item for the direct standard deviation see [rowSds()]. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowSdDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("rowSdDiffs"), signature = "x" ) .matrixStats_rowSdDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::rowSdDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowSdDiffs setMethod("rowSdDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowSdDiffs) #' @export #' @rdname rowSdDiffs ## Default method with user-friendly fallback mechanism. setMethod("rowSdDiffs", "ANY", make_default_method_def("rowSdDiffs")) #' @export #' @rdname rowSdDiffs setGeneric("colSdDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("colSdDiffs"), signature = "x" ) .matrixStats_colSdDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::colSdDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowSdDiffs setMethod("colSdDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colSdDiffs) #' @export #' @rdname rowSdDiffs ## Default method with user-friendly fallback mechanism. setMethod("colSdDiffs", "ANY", make_default_method_def("colSdDiffs")) MatrixGenerics/R/rowSds.R0000644000175200017520000000457414136053374016345 0ustar00biocbuildbiocbuild#' Calculates the standard deviation for each row (column) of a matrix-like #' object #' #' Calculates the standard deviation for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowSds #' #' @templateVar rowName rowSds #' @templateVar colName colSds #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @param center (optional) the center, defaults to the row means #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowSds}()} and #' \code{matrixStats::\link[matrixStats:rowSds]{colSds}()} which are used when #' the input is a \code{matrix} or \code{numeric} vector. #' \item For mean estimates, see \code{\link{rowMeans2}()} and #' \code{\link[base:colSums]{rowMeans}()}. #' \item For variance estimates, see \code{\link{rowVars}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowSds", function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) standardGeneric("rowSds"), signature = "x" ) .matrixStats_rowSds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowSds(x, rows = rows, cols = cols, na.rm = na.rm, center = center, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowSds setMethod("rowSds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowSds) #' @export #' @rdname rowSds ## Default method with user-friendly fallback mechanism. setMethod("rowSds", "ANY", make_default_method_def("rowSds")) #' @export #' @rdname rowSds setGeneric("colSds", function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) standardGeneric("colSds"), signature = "x" ) .matrixStats_colSds <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colSds(x, rows = rows, cols = cols, na.rm = na.rm, center = center, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowSds setMethod("colSds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colSds) #' @export #' @rdname rowSds ## Default method with user-friendly fallback mechanism. setMethod("colSds", "ANY", make_default_method_def("colSds")) MatrixGenerics/R/rowSums2.R0000644000175200017520000000432414136053374016616 0ustar00biocbuildbiocbuild#' Calculates the sum for each row (column) of a matrix-like object #' #' Calculates the sum for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowSums2 #' #' @templateVar rowName rowSums2 #' @templateVar colName colSums2 #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowSums2}()} and #' \code{matrixStats::\link[matrixStats:rowSums2]{colSums2}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For mean estimates, see \code{\link{rowMeans2}()} and #' \code{\link[base:colSums]{rowMeans}()}. #' \item \code{base::\link{sum}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowSums2", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowSums2"), signature = "x" ) .matrixStats_rowSums2 <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::rowSums2(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowSums2 setMethod("rowSums2", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowSums2) #' @export #' @rdname rowSums2 ## Default method with user-friendly fallback mechanism. setMethod("rowSums2", "ANY", make_default_method_def("rowSums2")) #' @export #' @rdname rowSums2 setGeneric("colSums2", function(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colSums2"), signature = "x" ) .matrixStats_colSums2 <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA){ matrixStats::colSums2(x, rows = rows, cols = cols, na.rm = na.rm, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowSums2 setMethod("colSums2", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colSums2) #' @export #' @rdname rowSums2 ## Default method with user-friendly fallback mechanism. setMethod("colSums2", "ANY", make_default_method_def("colSums2")) MatrixGenerics/R/rowTabulates.R0000644000175200017520000000462514136053374017535 0ustar00biocbuildbiocbuild#' Tabulates the values in a matrix-like object by row (column) #' #' Tabulates the values in a matrix-like object by row (column). #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowTabulates #' #' @templateVar rowName rowTabulates #' @templateVar colName colTabulates #' #' @template matrixStatsLink #' #' @template standardParameters #' @param values the values to search for. #' @template useNamesParameter #' #' @template returnMatrix_JDim #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowTabulates}()} and #' \code{matrixStats::\link[matrixStats:rowTabulates]{colTabulates}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' \item \code{base::\link{table}()} #' } #' #' @examples #' mat <- matrix(rpois(15, lambda = 3), nrow = 5, ncol = 3) #' mat[2, 1] <- NA_integer_ #' mat[3, 3] <- 0L #' mat[4, 1] <- 0L #' #' print(mat) #' #' rowTabulates(mat) #' colTabulates(mat) #' #' rowTabulates(mat, values = 0) #' colTabulates(mat, values = 0) #' #' @keywords array iteration robust univar setGeneric("rowTabulates", function(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) standardGeneric("rowTabulates"), signature = "x" ) .matrixStats_rowTabulates <- function(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA){ matrixStats::rowTabulates(x, rows = rows, cols = cols, values = values, ..., useNames = useNames) } #' @export #' @rdname rowTabulates setMethod("rowTabulates", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowTabulates) #' @export #' @rdname rowTabulates ## Default method with user-friendly fallback mechanism. setMethod("rowTabulates", "ANY", make_default_method_def("rowTabulates")) #' @export #' @rdname rowTabulates setGeneric("colTabulates", function(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) standardGeneric("colTabulates"), signature = "x" ) .matrixStats_colTabulates <- function(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA){ matrixStats::colTabulates(x, rows = rows, cols = cols, values = values, ..., useNames = useNames) } #' @export #' @rdname rowTabulates setMethod("colTabulates", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colTabulates) #' @export #' @rdname rowTabulates ## Default method with user-friendly fallback mechanism. setMethod("colTabulates", "ANY", make_default_method_def("colTabulates")) MatrixGenerics/R/rowVarDiffs.R0000644000175200017520000000457014136053374017314 0ustar00biocbuildbiocbuild#' Calculates the variance of the difference between each element of a row #' (column) of a matrix-like object #' #' Calculates the variance of the difference between each element of a row #' (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowVarDiffs #' #' @templateVar rowName rowVarDiffs #' @templateVar colName colVarDiffs #' #' @template matrixStatsLink #' #' @template standardParameters #' @template diff_trimParameters #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:varDiff]{rowVarDiffs}()} and #' \code{matrixStats::\link[matrixStats:varDiff]{colVarDiffs}()} which #' are used when the input is a \code{matrix} or \code{numeric} vector. #' \item for the direct variance see [rowVars()]. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowVarDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("rowVarDiffs"), signature = "x" ) .matrixStats_rowVarDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::rowVarDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowVarDiffs setMethod("rowVarDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowVarDiffs) #' @export #' @rdname rowVarDiffs ## Default method with user-friendly fallback mechanism. setMethod("rowVarDiffs", "ANY", make_default_method_def("rowVarDiffs")) #' @export #' @rdname rowVarDiffs setGeneric("colVarDiffs", function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) standardGeneric("colVarDiffs"), signature = "x" ) .matrixStats_colVarDiffs <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA){ matrixStats::colVarDiffs(x, rows = rows, cols = cols, na.rm = na.rm, diff = diff, trim = trim, ..., useNames = useNames) } #' @export #' @rdname rowVarDiffs setMethod("colVarDiffs", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colVarDiffs) #' @export #' @rdname rowVarDiffs ## Default method with user-friendly fallback mechanism. setMethod("colVarDiffs", "ANY", make_default_method_def("colVarDiffs")) MatrixGenerics/R/rowVars.R0000644000175200017520000000466714136053374016532 0ustar00biocbuildbiocbuild#' Calculates the variance for each row (column) of a matrix-like object #' #' Calculates the variance for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowVars #' #' @templateVar rowName rowVars #' @templateVar colName colVars #' #' @template matrixStatsLink #' #' @template standardParameters #' @template na_rmParameter #' @param center (optional) the center, defaults to the row means. #' @template dimParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowVars}()} and #' \code{matrixStats::\link[matrixStats:rowVars]{colVars}()} which are used #' when the input is a \code{matrix} or \code{numeric} vector. #' \item For mean estimates, see \code{\link{rowMeans2}()} and #' \code{\link[base:colSums]{rowMeans}()}. #' \item For standard deviation estimates, see \code{\link{rowSds}()}. #' \item \code{stats::\link[stats:cor]{var}()}. #' } #' #' @template standardExamples #' #' @keywords array iteration robust univar setGeneric("rowVars", function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) standardGeneric("rowVars"), signature = "x" ) .matrixStats_rowVars <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::rowVars(x, rows = rows, cols = cols, na.rm = na.rm, center = center, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowVars setMethod("rowVars", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowVars) #' @export #' @rdname rowVars ## Default method with user-friendly fallback mechanism. setMethod("rowVars", "ANY", make_default_method_def("rowVars")) #' @export #' @rdname rowVars setGeneric("colVars", function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) standardGeneric("colVars"), signature = "x" ) .matrixStats_colVars <- function(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA){ matrixStats::colVars(x, rows = rows, cols = cols, na.rm = na.rm, center = center, dim. = dim., ..., useNames = useNames) } #' @export #' @rdname rowVars setMethod("colVars", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colVars) #' @export #' @rdname rowVars ## Default method with user-friendly fallback mechanism. setMethod("colVars", "ANY", make_default_method_def("colVars")) MatrixGenerics/R/rowWeightedMads.R0000644000175200017520000000542514136053374020155 0ustar00biocbuildbiocbuild#' Calculates the weighted median absolute deviation for each row (column) of a #' matrix-like object #' #' Calculates the weighted median absolute deviation for each row (column) of #' a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowWeightedMads #' #' @templateVar rowName rowWeightedMads #' @templateVar colName colWeightedMads #' #' @template matrixStatsLink #' #' @template standardParameters #' @template weightParam #' @template na_rmParameter #' @template useNamesParameter #' @param center (optional) the center, defaults to the row means #' @param constant A scale factor. See \code{stats::\link[stats]{mad}()} for #' details. #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:weightedMad]{rowWeightedMads}()} and #' \code{matrixStats::\link[matrixStats:weightedMad]{colWeightedMads}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also [rowMads] for the corresponding unweighted function. #' } #' #' @template weightedExamples #' #' @keywords array iteration robust univar setGeneric("rowWeightedMads", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ...) standardGeneric("rowWeightedMads"), signature = "x" ) .matrixStats_rowWeightedMads <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA){ matrixStats::rowWeightedMads(x, w = w, rows = rows, cols = cols, na.rm = na.rm, constant = constant, center = center, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMads setMethod("rowWeightedMads", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowWeightedMads) #' @export #' @rdname rowWeightedMads ## Default method with user-friendly fallback mechanism. setMethod("rowWeightedMads", "ANY", make_default_method_def("rowWeightedMads")) #' @export #' @rdname rowWeightedMads setGeneric("colWeightedMads", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA) standardGeneric("colWeightedMads"), signature = "x" ) .matrixStats_colWeightedMads <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA){ matrixStats::colWeightedMads(x, w = w, rows = rows, cols = cols, na.rm = na.rm, constant = constant, center = center, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMads setMethod("colWeightedMads", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colWeightedMads) #' @export #' @rdname rowWeightedMads ## Default method with user-friendly fallback mechanism. setMethod("colWeightedMads", "ANY", make_default_method_def("colWeightedMads")) MatrixGenerics/R/rowWeightedMeans.R0000644000175200017520000000457214136053374020336 0ustar00biocbuildbiocbuild#' Calculates the weighted mean for each row (column) of a matrix-like object #' #' Calculates the weighted mean for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowWeightedMeans #' #' @templateVar rowName rowWeightedMeans #' @templateVar colName colWeightedMeans #' #' @template matrixStatsLink #' #' @template standardParameters #' @template weightParam #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowWeightedMeans}()} and #' \code{matrixStats::\link[matrixStats:rowWeightedMeans]{colWeightedMeans}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also [rowMeans2] for the corresponding unweighted function. #' } #' #' @template weightedExamples #' #' #' @keywords array iteration robust univar setGeneric("rowWeightedMeans", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowWeightedMeans"), signature = "x" ) .matrixStats_rowWeightedMeans <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::rowWeightedMeans(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMeans setMethod("rowWeightedMeans", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowWeightedMeans) #' @export #' @rdname rowWeightedMeans ## Default method with user-friendly fallback mechanism. setMethod("rowWeightedMeans", "ANY", make_default_method_def("rowWeightedMeans")) #' @export #' @rdname rowWeightedMeans setGeneric("colWeightedMeans", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colWeightedMeans"), signature = "x" ) .matrixStats_colWeightedMeans <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::colWeightedMeans(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMeans setMethod("colWeightedMeans", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colWeightedMeans) #' @export #' @rdname rowWeightedMeans ## Default method with user-friendly fallback mechanism. setMethod("colWeightedMeans", "ANY", make_default_method_def("colWeightedMeans")) MatrixGenerics/R/rowWeightedMedians.R0000644000175200017520000000466414136053374020655 0ustar00biocbuildbiocbuild#' Calculates the weighted median for each row (column) of a matrix-like object #' #' Calculates the weighted median for each row (column) of a matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowWeightedMedians #' #' @templateVar rowName rowWeightedMedians #' @templateVar colName colWeightedMedians #' #' @template matrixStatsLink #' #' @template standardParameters #' @template weightParam #' @template na_rmParameter #' @template useNamesParameter #' #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats]{rowWeightedMedians}()} and #' \code{matrixStats::\link[matrixStats:rowWeightedMedians]{colWeightedMedians}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also [rowMedians] for the corresponding unweighted function. #' } #' #' @template weightedExamples #' #' @keywords array iteration robust univar setGeneric("rowWeightedMedians", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowWeightedMedians"), signature = "x" ) .matrixStats_rowWeightedMedians <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::rowWeightedMedians(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMedians setMethod("rowWeightedMedians", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowWeightedMedians) #' @export #' @rdname rowWeightedMedians ## Default method with user-friendly fallback mechanism. setMethod("rowWeightedMedians", "ANY", make_default_method_def("rowWeightedMedians")) #' @export #' @rdname rowWeightedMedians setGeneric("colWeightedMedians", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colWeightedMedians"), signature = "x" ) .matrixStats_colWeightedMedians <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::colWeightedMedians(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedMedians setMethod("colWeightedMedians", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colWeightedMedians) #' @export #' @rdname rowWeightedMedians ## Default method with user-friendly fallback mechanism. setMethod("colWeightedMedians", "ANY", make_default_method_def("colWeightedMedians")) MatrixGenerics/R/rowWeightedSds.R0000644000175200017520000000455014136053374020020 0ustar00biocbuildbiocbuild#' Calculates the weighted standard deviation for each row (column) of a #' matrix-like object #' #' Calculates the weighted standard deviation for each row (column) of a #' matrix-like object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowWeightedSds #' #' @templateVar rowName rowWeightedSds #' @templateVar colName colWeightedSds #' #' @template matrixStatsLink #' #' @template standardParameters #' @template weightParam #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:weightedVar]{rowWeightedSds}()} and #' \code{matrixStats::\link[matrixStats:weightedVar]{colWeightedSds}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also [rowSds] for the corresponding unweighted function. #' } #' #' @template weightedExamples #' #' @keywords array iteration robust univar setGeneric("rowWeightedSds", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowWeightedSds"), signature = "x" ) .matrixStats_rowWeightedSds <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::rowWeightedSds(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedSds setMethod("rowWeightedSds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowWeightedSds) #' @export #' @rdname rowWeightedSds ## Default method with user-friendly fallback mechanism. setMethod("rowWeightedSds", "ANY", make_default_method_def("rowWeightedSds")) #' @export #' @rdname rowWeightedSds setGeneric("colWeightedSds", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colWeightedSds"), signature = "x" ) .matrixStats_colWeightedSds <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::colWeightedSds(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedSds setMethod("colWeightedSds", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colWeightedSds) #' @export #' @rdname rowWeightedSds ## Default method with user-friendly fallback mechanism. setMethod("colWeightedSds", "ANY", make_default_method_def("colWeightedSds")) MatrixGenerics/R/rowWeightedVars.R0000644000175200017520000000455714136053374020211 0ustar00biocbuildbiocbuild#' Calculates the weighted variance for each row (column) of a matrix-like #' object #' #' Calculates the weighted variance for each row (column) of a matrix-like #' object. #' #' @include MatrixGenerics-package.R #' #' @export #' @name rowWeightedVars #' #' @templateVar rowName rowWeightedVars #' @templateVar colName colWeightedVars #' #' @template matrixStatsLink #' #' @template standardParameters #' @template weightParam #' @template na_rmParameter #' @template useNamesParameter #' #' @template returnVector #' #' @seealso #' \itemize{ #' \item \code{matrixStats::\link[matrixStats:weightedVar]{rowWeightedVars}()} and #' \code{matrixStats::\link[matrixStats:weightedVar]{colWeightedVars}()} #' which are used when the input is a \code{matrix} or \code{numeric} vector. #' \item See also [rowVars] for the corresponding unweighted function. #' } #' #' @template weightedExamples #' #' @keywords array iteration robust univar setGeneric("rowWeightedVars", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("rowWeightedVars"), signature = "x" ) .matrixStats_rowWeightedVars <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::rowWeightedVars(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedVars setMethod("rowWeightedVars", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_rowWeightedVars) #' @export #' @rdname rowWeightedVars ## Default method with user-friendly fallback mechanism. setMethod("rowWeightedVars", "ANY", make_default_method_def("rowWeightedVars")) #' @export #' @rdname rowWeightedVars setGeneric("colWeightedVars", function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) standardGeneric("colWeightedVars"), signature = "x" ) .matrixStats_colWeightedVars <- function(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA){ matrixStats::colWeightedVars(x, w = w, rows = rows, cols = cols, na.rm = na.rm, ..., useNames = useNames) } #' @export #' @rdname rowWeightedVars setMethod("colWeightedVars", "matrix_OR_array_OR_table_OR_numeric", .matrixStats_colWeightedVars) #' @export #' @rdname rowWeightedVars ## Default method with user-friendly fallback mechanism. setMethod("colWeightedVars", "ANY", make_default_method_def("colWeightedVars")) MatrixGenerics/README.md0000644000175200017520000000330714136053374016010 0ustar00biocbuildbiocbuild[](https://bioconductor.org/) **MatrixGenerics** is an R/Bioconductor package that provides the S4 generics for popular row and column aggregation functions for matrices (e.g. `colVars()`, `rowMedians()`). It follows the API developed by the [**matrixStats**](https://cran.r-project.org/package=matrixStats) package. The target audience for **MatrixGenerics** are R package developers that want to write code that can automatically handle different kind of matrix implementations: for example base R `matrix`, the S4 `Matrix` (including sparse representations), and `DelayedMatrix` objects. A prerequisite to handle these matrix objects is that a package with the corresponding implementation is available. So far, there are three packages: * [**matrixStats**](https://cran.r-project.org/package=matrixStats) for base R `matrix` objects * [**DelayedMatrixStats**](https://bioconductor.org/packages/DelayedMatrixStats/) for `DelayedMatrix` objects from the [**DelayedArray**](https://bioconductor.org/packages/DelayedArray/) package * [**sparseMatrixStats**](https://github.com/const-ae/sparseMatrixStats) for `dgCMatrix` (sparse matrix) objects from the **Matrix** package This package imports **matrixStats** and automatically forwards all function calls with `matrix`, `numeric`, and `array` objects to **matrixStats**. To handle other matrix objects, the user must manually install the corresponding **xxxMatrixStats** package. See https://bioconductor.org/packages/MatrixGenerics for more information including how to install the release version of the package (please refrain from installing directly from GitHub). MatrixGenerics/inst/0000755000175200017520000000000014136053374015503 5ustar00biocbuildbiocbuildMatrixGenerics/inst/NEWS.Rd0000644000175200017520000000350414136053374016550 0ustar00biocbuildbiocbuild\name{NEWS} \title{News for Package \pkg{MatrixGenerics}} \encoding{UTF-8} \section{Version 1.5.4}{\itemize{ \item Sync API with \pkg{matrixStats} \code{v0.60.1}. }} \section{Version 1.5.2}{\itemize{ \item Sync API with \pkg{matrixStats} \code{v0.60.0}. }} \section{Version 1.5.1}{\itemize{ \item Fix problem with function environment of fallback mechanism (\url{https://github.com/Bioconductor/MatrixGenerics/issues/25} and \url{https://github.com/Bioconductor/MatrixGenerics/pull/26}). Make sure that packages can use MatrixGenerics with the \code{::} notation to call functions from \pkg{sparseMatrixStats} and \pkg{DelayedMatrixStats}. }} \section{Version 1.2.1}{\itemize{ \item Sync API with \pkg{matrixStats} \code{v0.58.0}. }} \section{Version 1.2.0}{\itemize{ \item Add \code{drop} and \code{type} to generic signature of \code{[row|col]Quantiles} (\url{https://github.com/Bioconductor/MatrixGenerics/pull/14}). \item Sync API with \pkg{matrixStats} \code{v0.57.0} (\url{https://github.com/Bioconductor/MatrixGenerics/issues/17}). \item Add default methods with user-friendly fallback mechanism (\url{https://github.com/Bioconductor/MatrixGenerics/pull/16}). Suggested packages are now loaded the first time a MatrixGenerics' generic is called (e.g. the first time \code{MatrixGenerics::colVars()} is called). With this new approach, if the user passes a \emph{dgCMatrix} object and if \pkg{sparseMatrixStats} is already loaded, will 'just work' and the fallback mechanism won't try to load anything. \item Dispatch on methods for matrix objects when table objects are supplied (\url{https://github.com/Bioconductor/MatrixGenerics/pull/15}) }} \section{Version 1.0.0}{\itemize{ \item New package \pkg{MatrixGenerics}, providing S4 generic functions modeled after the 'matrixStats' API for alternative matrix implementations. }} MatrixGenerics/man/0000755000175200017520000000000014136053374015301 5ustar00biocbuildbiocbuildMatrixGenerics/man/MatrixGenerics-package.Rd0000644000175200017520000000075414136053374022113 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/MatrixGenerics-package.R \docType{class} \name{MatrixGenerics-package} \alias{MatrixGenerics-package} \alias{class:matrix_OR_array_OR_table_OR_numeric} \alias{matrix_OR_array_OR_table_OR_numeric-class} \alias{matrix_OR_array_OR_table_OR_numeric} \title{The MatrixGenerics package} \description{ The \pkg{MatrixGenerics} package defines S4 generic summary statistic functions that operate on matrix-Like objects. } MatrixGenerics/man/rowAlls.Rd0000644000175200017520000000545314136053374017222 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowAlls.R \name{rowAlls} \alias{rowAlls} \alias{rowAlls,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowAlls,ANY-method} \alias{colAlls} \alias{colAlls,matrix_OR_array_OR_table_OR_numeric-method} \alias{colAlls,ANY-method} \title{Check if all elements in a row (column) of a matrix-like object are equal to a value} \usage{ rowAlls(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{rowAlls}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowAlls}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) colAlls(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{colAlls}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colAlls}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{value}{The value to search for.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{logical}} \code{\link{vector}} of length N (K). } \description{ Check if all elements in a row (column) of a matrix-like object are equal to a value. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowAlls} / \code{matrixStats::colAlls}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowAlls(mat) colAlls(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowAlls]{rowAlls}()} and \code{matrixStats::\link[matrixStats:rowAlls]{colAlls}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For checks if \emph{any} element is equal to a value, see \code{\link{rowAnys}()}. \item \code{base::\link{all}()}. } } MatrixGenerics/man/rowAnyNAs.Rd0000644000175200017520000000437614136053374017463 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowAnyNAs.R \name{rowAnyNAs} \alias{rowAnyNAs} \alias{rowAnyNAs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowAnyNAs,ANY-method} \alias{colAnyNAs} \alias{colAnyNAs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colAnyNAs,ANY-method} \title{Check if any elements in a row (column) of a matrix-like object is missing} \usage{ rowAnyNAs(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowAnyNAs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowAnyNAs}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) colAnyNAs(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colAnyNAs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colAnyNAs}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{logical}} \code{\link{vector}} of length N (K). } \description{ Check if any elements in a row (column) of a matrix-like object is missing. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowAnyNAs} / \code{matrixStats::colAnyNAs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowAnyNAs(mat) colAnyNAs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:anyMissing]{rowAnyNAs}()} and \code{matrixStats::\link[matrixStats:anyMissing]{colAnyNAs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For checks if any element is equal to a value, see \code{\link{rowAnys}()}. \item \code{base::\link{is.na}()} and \code{base::\link{any}()}. } } MatrixGenerics/man/rowAnys.Rd0000644000175200017520000000545314136053374017241 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowAnys.R \name{rowAnys} \alias{rowAnys} \alias{rowAnys,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowAnys,ANY-method} \alias{colAnys} \alias{colAnys,matrix_OR_array_OR_table_OR_numeric-method} \alias{colAnys,ANY-method} \title{Check if any elements in a row (column) of a matrix-like object is equal to a value} \usage{ rowAnys(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{rowAnys}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowAnys}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) colAnys(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{colAnys}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colAnys}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{value}{The value to search for.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{logical}} \code{\link{vector}} of length N (K). } \description{ Check if any elements in a row (column) of a matrix-like object is equal to a value. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowAnys} / \code{matrixStats::colAnys}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowAnys(mat) colAnys(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowAlls]{rowAnys}()} and \code{matrixStats::\link[matrixStats:rowAlls]{colAnys}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For checks if \emph{all} elements are equal to a value, see \code{\link{rowAlls}()}. \item \code{base::\link{any}()}. } } MatrixGenerics/man/rowAvgsPerColSet.Rd0000644000175200017520000000613614136053374021007 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowAvgsPerColSet.R \name{rowAvgsPerColSet} \alias{rowAvgsPerColSet} \alias{rowAvgsPerColSet,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowAvgsPerColSet,ANY-method} \alias{colAvgsPerRowSet} \alias{colAvgsPerRowSet,matrix_OR_array_OR_table_OR_numeric-method} \alias{colAvgsPerRowSet,ANY-method} \title{Calculates for each row (column) a summary statistic for equally sized subsets of columns (rows)} \usage{ rowAvgsPerColSet(X, W = NULL, rows = NULL, S, FUN = rowMeans, ..., na.rm = NA, tFUN = FALSE) \S4method{rowAvgsPerColSet}{matrix_OR_array_OR_table_OR_numeric}(X, W = NULL, rows = NULL, S, FUN = rowMeans, ..., na.rm = NA, tFUN = FALSE) \S4method{rowAvgsPerColSet}{ANY}(X, W = NULL, rows = NULL, S, FUN = rowMeans, ..., na.rm = NA, tFUN = FALSE) colAvgsPerRowSet(X, W = NULL, cols = NULL, S, FUN = colMeans, ..., na.rm = NA, tFUN = FALSE) \S4method{colAvgsPerRowSet}{matrix_OR_array_OR_table_OR_numeric}(X, W = NULL, cols = NULL, S, FUN = colMeans, ..., na.rm = NA, tFUN = FALSE) \S4method{colAvgsPerRowSet}{ANY}(X, W = NULL, cols = NULL, S, FUN = colMeans, ..., na.rm = NA, tFUN = FALSE) } \arguments{ \item{X}{An \code{NxM} matrix-like object.} \item{W}{An optional numeric \code{NxM} matrix of weights.} \item{rows, cols}{A \code{\link{vector}} indicating the subset (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{S}{An \link{integer} \code{KxJ} matrix that specifying the \code{J} subsets. Each column hold \code{K} column (row) indices for the corresponding subset. The range of values is [1, M] ([1,N]).} \item{FUN}{A row-by-row (column-by-column) summary statistic function. It is applied to to each column (row) subset of \code{X} that is specified by \code{S}.} \item{...}{Additional arguments passed to \code{FUN}.} \item{na.rm}{(logical) Argument passed to \code{FUN()} as \code{na.rm = na.rm}. If \code{NA} (default), then \code{na.rm = TRUE} is used if \code{X} or \code{S} holds missing values, otherwise \code{na.rm = FALSE}.} \item{tFUN}{If \code{TRUE}, \code{X} is transposed before it is passed to \code{FUN}.} } \value{ Returns a numeric \code{JxN} (\code{MxJ}) matrix. } \description{ Calculates for each row (column) a summary statistic for equally sized subsets of columns (rows). } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowAvgsPerColSet} / \code{matrixStats::colAvgsPerRowSet}. } \examples{ mat <- matrix(rnorm(20), nrow = 5, ncol = 4) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) S <- matrix(1:ncol(mat), ncol = 2) print(S) rowAvgsPerColSet(mat, S = S, FUN = rowMeans) rowAvgsPerColSet(mat, S = S, FUN = rowVars) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowAvgsPerColSet]{rowAvgsPerColSet}()} and \code{matrixStats::\link[matrixStats:rowAvgsPerColSet]{colAvgsPerRowSet}()} which are used when the input is a \code{matrix} or \code{numeric} vector. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar2} MatrixGenerics/man/rowCollapse.Rd0000644000175200017520000000516014136053374020064 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCollapse.R \name{rowCollapse} \alias{rowCollapse} \alias{rowCollapse,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCollapse,ANY-method} \alias{colCollapse} \alias{colCollapse,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCollapse,ANY-method} \title{Extract one cell from each row (column) of a matrix-like object} \usage{ rowCollapse(x, idxs, rows = NULL, ..., useNames = NA) \S4method{rowCollapse}{matrix_OR_array_OR_table_OR_numeric}(x, idxs, rows = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowCollapse}{ANY}(x, idxs, rows = NULL, ..., useNames = NA) colCollapse(x, idxs = idxs, cols = NULL, ..., useNames = NA) \S4method{colCollapse}{matrix_OR_array_OR_table_OR_numeric}(x, idxs, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colCollapse}{ANY}(x, idxs = idxs, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{idxs}{An index \code{\link{vector}} with the position to extract. It is recycled to match the number of rows (column)} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Extract one cell from each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCollapse} / \code{matrixStats::colCollapse}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCollapse(mat, idxs = 2) rowCollapse(mat, idxs = c(1,1,2,3,2)) colCollapse (mat, idxs = 4) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowCollapse]{rowCollapse}()} and \code{matrixStats::\link[matrixStats:rowCollapse]{colCollapse}()} which are used when the input is a \code{matrix} or \code{numeric} vector. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowCounts.Rd0000644000175200017520000000566614136053374017610 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCounts.R \name{rowCounts} \alias{rowCounts} \alias{rowCounts,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCounts,ANY-method} \alias{colCounts} \alias{colCounts,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCounts,ANY-method} \title{Count how often an element in a row (column) of a matrix-like object is equal to a value} \usage{ rowCounts(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{rowCounts}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowCounts}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) colCounts(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) \S4method{colCounts}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colCounts}{ANY}(x, rows = NULL, cols = NULL, value = TRUE, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{value}{The value to search for.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{integer}} \code{\link{vector}} of length N (K). } \description{ Count how often an element in a row (column) of a matrix-like object is equal to a value. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCounts} / \code{matrixStats::colCounts}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCounts(mat) colCounts(mat) rowCounts(mat, value = 0) colCounts(mat, value = Inf, na.rm = TRUE) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowCounts}()} and \code{matrixStats::\link[matrixStats:rowCounts]{colCounts}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For checks if any element is equal to a value, see \code{\link{rowAnys}()}. To check if all elements are equal, see \code{\link{rowAlls}()}. } } MatrixGenerics/man/rowCummaxs.Rd0000644000175200017520000000512714136053374017742 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCummaxs.R \name{rowCummaxs} \alias{rowCummaxs} \alias{rowCummaxs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCummaxs,ANY-method} \alias{colCummaxs} \alias{colCummaxs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCummaxs,ANY-method} \title{Calculates the cumulative maxima for each row (column) of a matrix-like object} \usage{ rowCummaxs(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowCummaxs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowCummaxs}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) colCummaxs(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colCummaxs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colCummaxs}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{matrix}}with the same dimensions as \code{x}. } \description{ Calculates the cumulative maxima for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCummaxs} / \code{matrixStats::colCummaxs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCummaxs(mat) colCummaxs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCummaxs}()} and \code{matrixStats::\link[matrixStats:rowCumsums]{colCummaxs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For single maximum estimates, see \code{\link{rowMaxs}()}. \item \code{base::\link{cummax}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowCummins.Rd0000644000175200017520000000512714136053374017740 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCummins.R \name{rowCummins} \alias{rowCummins} \alias{rowCummins,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCummins,ANY-method} \alias{colCummins} \alias{colCummins,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCummins,ANY-method} \title{Calculates the cumulative minima for each row (column) of a matrix-like object} \usage{ rowCummins(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowCummins}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowCummins}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) colCummins(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colCummins}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colCummins}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{matrix}}with the same dimensions as \code{x}. } \description{ Calculates the cumulative minima for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCummins} / \code{matrixStats::colCummins}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCummins(mat) colCummins(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCummins}()} and \code{matrixStats::\link[matrixStats:rowCumsums]{colCummins}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For single minimum estimates, see \code{\link{rowMins}()}. \item \code{base::\link{cummin}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowCumprods.Rd0000644000175200017520000000505514136053374020121 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCumprods.R \name{rowCumprods} \alias{rowCumprods} \alias{rowCumprods,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCumprods,ANY-method} \alias{colCumprods} \alias{colCumprods,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCumprods,ANY-method} \title{Calculates the cumulative product for each row (column) of a matrix-like object} \usage{ rowCumprods(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowCumprods}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowCumprods}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) colCumprods(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colCumprods}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colCumprods}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{matrix}}with the same dimensions as \code{x}. } \description{ Calculates the cumulative product for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCumprods} / \code{matrixStats::colCumprods}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCumprods(mat) colCumprods(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowCumsums]{rowCumprods}()} and \code{matrixStats::\link[matrixStats:rowCumsums]{colCumprods}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \code{base::\link{cumprod}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowCumsums.Rd0000644000175200017520000000500514136053374017754 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowCumsums.R \name{rowCumsums} \alias{rowCumsums} \alias{rowCumsums,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowCumsums,ANY-method} \alias{colCumsums} \alias{colCumsums,matrix_OR_array_OR_table_OR_numeric-method} \alias{colCumsums,ANY-method} \title{Calculates the cumulative sum for each row (column) of a matrix-like object} \usage{ rowCumsums(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{rowCumsums}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowCumsums}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) colCumsums(x, rows = NULL, cols = NULL, ..., useNames = NA) \S4method{colCumsums}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colCumsums}{ANY}(x, rows = NULL, cols = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{matrix}}with the same dimensions as \code{x}. } \description{ Calculates the cumulative sum for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowCumsums} / \code{matrixStats::colCumsums}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowCumsums(mat) colCumsums(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowCumsums}()} and \code{matrixStats::\link[matrixStats:rowCumsums]{colCumsums}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \code{base::\link{cumsum}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowDiffs.Rd0000644000175200017520000000547114136053374017362 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowDiffs.R \name{rowDiffs} \alias{rowDiffs} \alias{rowDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowDiffs,ANY-method} \alias{colDiffs} \alias{colDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colDiffs,ANY-method} \title{Calculates the difference between each element of a row (column) of a matrix-like object} \usage{ rowDiffs(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) \S4method{rowDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, dim. = dim(x), ..., useNames = NA) \S4method{rowDiffs}{ANY}(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) colDiffs(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) \S4method{colDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, dim. = dim(x), ..., useNames = NA) \S4method{colDiffs}{ANY}(x, rows = NULL, cols = NULL, lag = 1L, differences = 1L, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{lag}{An integer specifying the lag.} \item{differences}{An integer specifying the order of difference.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{matrix}} with one column (row) less than x: \eqn{Nx(K-1)} or \eqn{(N-1)xK}. } \description{ Calculates the difference between each element of a row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowDiffs} / \code{matrixStats::colDiffs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowDiffs(mat) colDiffs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowDiffs}()} and \code{matrixStats::\link[matrixStats:rowDiffs]{colDiffs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \code{base::\link{diff}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowIQRDiffs.Rd0000644000175200017520000000557414136053374017742 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowIQRDiffs.R \name{rowIQRDiffs} \alias{rowIQRDiffs} \alias{rowIQRDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowIQRDiffs,ANY-method} \alias{colIQRDiffs} \alias{colIQRDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colIQRDiffs,ANY-method} \title{Calculates the interquartile range of the difference between each element of a row (column) of a matrix-like object} \usage{ rowIQRDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowIQRDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowIQRDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) colIQRDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colIQRDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colIQRDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{diff}{An integer specifying the order of difference.} \item{trim}{A double in [0,1/2] specifying the fraction of observations to be trimmed from each end of (sorted) x before estimation.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the interquartile range of the difference between each element of a row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowIQRDiffs} / \code{matrixStats::colIQRDiffs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowIQRDiffs(mat) colIQRDiffs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:varDiff]{rowIQRDiffs}()} and \code{matrixStats::\link[matrixStats:varDiff]{colIQRDiffs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For the direct interquartile range see also \link{rowIQRs}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowIQRs.Rd0000644000175200017520000000475614136053374017152 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowIQRs.R \name{rowIQRs} \alias{rowIQRs} \alias{rowIQRs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowIQRs,ANY-method} \alias{colIQRs} \alias{colIQRs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colIQRs,ANY-method} \title{Calculates the interquartile range for each row (column) of a matrix-like object} \usage{ rowIQRs(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowIQRs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowIQRs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colIQRs(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colIQRs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colIQRs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the interquartile range for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowIQRs} / \code{matrixStats::colIQRs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowIQRs(mat) colIQRs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowIQRs}()} and \code{matrixStats::\link[matrixStats:rowIQRs]{colIQRs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For a non-robust analog, see \code{\link{rowSds}()}. For a more robust version see \code{\link[=rowMads]{rowMads()}} \item \code{stats::\link[stats]{IQR}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowLogSumExps.Rd0000644000175200017520000000556214136053374020376 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowLogSumExps.R \name{rowLogSumExps} \alias{rowLogSumExps} \alias{rowLogSumExps,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowLogSumExps,ANY-method} \alias{colLogSumExps} \alias{colLogSumExps,matrix_OR_array_OR_table_OR_numeric-method} \alias{colLogSumExps,ANY-method} \title{Accurately calculates the logarithm of the sum of exponentials for each row (column) of a matrix-like object} \usage{ rowLogSumExps(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowLogSumExps}{matrix_OR_array_OR_table_OR_numeric}(lx, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(lx), ..., useNames = NA) \S4method{rowLogSumExps}{ANY}(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colLogSumExps(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colLogSumExps}{matrix_OR_array_OR_table_OR_numeric}(lx, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(lx), ..., useNames = NA) \S4method{colLogSumExps}{ANY}(lx, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{lx}{An NxK matrix-like object. Typically \code{lx} are \code{log(x)} values.} \item{rows, cols}{A \code{\link{vector}} indicating the subset (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Accurately calculates the logarithm of the sum of exponentials for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowLogSumExps} / \code{matrixStats::colLogSumExps}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowLogSumExps(mat) colLogSumExps(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowLogSumExps}()} and \code{matrixStats::\link[matrixStats:rowLogSumExps]{colLogSumExps}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \code{\link[=rowSums2]{rowSums2()}} } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMadDiffs.Rd0000644000175200017520000000550214136053374017777 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMadDiffs.R \name{rowMadDiffs} \alias{rowMadDiffs} \alias{rowMadDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMadDiffs,ANY-method} \alias{colMadDiffs} \alias{colMadDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMadDiffs,ANY-method} \title{Calculates the mean absolute deviation of the difference between each element of a row (column) of a matrix-like object} \usage{ rowMadDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowMadDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowMadDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) colMadDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colMadDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colMadDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{diff}{An integer specifying the order of difference.} \item{trim}{A double in [0,1/2] specifying the fraction of observations to be trimmed from each end of (sorted) x before estimation.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the mean absolute deviation of the difference between each element of a row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMadDiffs} / \code{matrixStats::colMadDiffs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMadDiffs(mat) colMadDiffs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:varDiff]{rowMadDiffs}()} and \code{matrixStats::\link[matrixStats:varDiff]{colMadDiffs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMads.Rd0000644000175200017520000000622314136053374017207 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMads.R \name{rowMads} \alias{rowMads} \alias{rowMads,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMads,ANY-method} \alias{colMads} \alias{colMads,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMads,ANY-method} \title{Calculates the median absolute deviation for each row (column) of a matrix-like object} \usage{ rowMads(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) \S4method{rowMads}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowMads}{ANY}(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) colMads(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) \S4method{colMads}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colMads}{ANY}(x, rows = NULL, cols = NULL, center = NULL, constant = 1.4826, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{center}{(optional) the center, defaults to the row means} \item{constant}{A scale factor. See \code{stats::\link[stats]{mad}()} for details.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the median absolute deviation for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMads} / \code{matrixStats::colMads}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMads(mat) colMads(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowSds]{rowMads}()} and \code{matrixStats::\link[matrixStats:rowSds]{colMads}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For mean estimates, see \code{\link{rowMeans2}()} and \code{\link[base:colSums]{rowMeans}()}. \item For non-robust standard deviation estimates, see \code{\link{rowSds}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMaxs.Rd0000644000175200017520000000521114136053374017227 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMaxs.R \name{rowMaxs} \alias{rowMaxs} \alias{rowMaxs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMaxs,ANY-method} \alias{colMaxs} \alias{colMaxs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMaxs,ANY-method} \title{Calculates the maximum for each row (column) of a matrix-like object} \usage{ rowMaxs(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowMaxs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowMaxs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colMaxs(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colMaxs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colMaxs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the maximum for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMaxs} / \code{matrixStats::colMaxs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMaxs(mat) colMaxs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowRanges]{rowMaxs}()} and \code{matrixStats::\link[matrixStats:rowRanges]{colMaxs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For min estimates, see \code{\link{rowMins}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMeans2.Rd0000644000175200017520000000551014136053374017446 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMeans2.R \name{rowMeans2} \alias{rowMeans2} \alias{rowMeans2,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMeans2,ANY-method} \alias{colMeans2} \alias{colMeans2,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMeans2,ANY-method} \title{Calculates the mean for each row (column) of a matrix-like object} \usage{ rowMeans2(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowMeans2}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowMeans2}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colMeans2(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colMeans2}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colMeans2}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the mean for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMeans2} / \code{matrixStats::colMeans2}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMeans2(mat) colMeans2(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowMeans2}()} and \code{matrixStats::\link[matrixStats:rowMeans2]{colMeans2}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \code{\link[base:colSums]{rowMeans}()} for the corresponding function in base R. \item For variance estimates, see \code{\link{rowVars}()}. \item See also the base R version \code{base::\link{rowMeans}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMedians.Rd0000644000175200017520000000535014136053374017703 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMedians.R \name{rowMedians} \alias{rowMedians} \alias{rowMedians,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMedians,ANY-method} \alias{colMedians} \alias{colMedians,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMedians,ANY-method} \title{Calculates the median for each row (column) of a matrix-like object} \usage{ rowMedians(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowMedians}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowMedians}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colMedians(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colMedians}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colMedians}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the median for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMedians} / \code{matrixStats::colMedians}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMedians(mat) colMedians(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowMedians}()} and \code{matrixStats::\link[matrixStats:rowMedians]{colMedians}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For mean estimates, see \code{\link{rowMeans2}()} and \code{\link[base:colSums]{rowMeans}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowMins.Rd0000644000175200017520000000521114136053374017225 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowMins.R \name{rowMins} \alias{rowMins} \alias{rowMins,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowMins,ANY-method} \alias{colMins} \alias{colMins,matrix_OR_array_OR_table_OR_numeric-method} \alias{colMins,ANY-method} \title{Calculates the minimum for each row (column) of a matrix-like object} \usage{ rowMins(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowMins}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowMins}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colMins(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colMins}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colMins}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the minimum for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowMins} / \code{matrixStats::colMins}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowMins(mat) colMins(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:rowRanges]{rowMins}()} and \code{matrixStats::\link[matrixStats:rowRanges]{colMins}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For max estimates, see \code{\link{rowMaxs}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowOrderStats.Rd0000644000175200017520000000527014136053374020416 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowOrderStats.R \name{rowOrderStats} \alias{rowOrderStats} \alias{rowOrderStats,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowOrderStats,ANY-method} \alias{colOrderStats} \alias{colOrderStats,matrix_OR_array_OR_table_OR_numeric-method} \alias{colOrderStats,ANY-method} \title{Calculates an order statistic for each row (column) of a matrix-like object} \usage{ rowOrderStats(x, rows = NULL, cols = NULL, which, ..., useNames = NA) \S4method{rowOrderStats}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, which, dim. = dim(x), ..., useNames = NA) \S4method{rowOrderStats}{ANY}(x, rows = NULL, cols = NULL, which, ..., useNames = NA) colOrderStats(x, rows = NULL, cols = NULL, which, ..., useNames = NA) \S4method{colOrderStats}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, which, dim. = dim(x), ..., useNames = NA) \S4method{colOrderStats}{ANY}(x, rows = NULL, cols = NULL, which, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{which}{An integer index in [1,K] ([1,N]) indicating which order statistic to be returned} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates an order statistic for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowOrderStats} / \code{matrixStats::colOrderStats}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- 2 mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowOrderStats(mat, which = 1) colOrderStats(mat, which = 3) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowOrderStats}()} and \code{matrixStats::\link[matrixStats:rowOrderStats]{colOrderStats}()} which are used when the input is a \code{matrix} or \code{numeric} vector. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowProds.Rd0000644000175200017520000000533414136053374017414 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowProds.R \name{rowProds} \alias{rowProds} \alias{rowProds,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowProds,ANY-method} \alias{colProds} \alias{colProds,matrix_OR_array_OR_table_OR_numeric-method} \alias{colProds,ANY-method} \title{Calculates the product for each row (column) of a matrix-like object} \usage{ rowProds(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowProds}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, method = c("direct", "expSumLog"), ..., useNames = NA) \S4method{rowProds}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colProds(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colProds}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, method = c("direct", "expSumLog"), ..., useNames = NA) \S4method{colProds}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{method}{A character vector of length one that specifies the how the product is calculated. Note, that this is not a generic argument and not all implementation have to provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the product for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowProds} / \code{matrixStats::colProds}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowProds(mat) colProds(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowProds}()} and \code{matrixStats::\link[matrixStats:rowProds]{colProds}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For sums across rows (columns), see \code{\link{rowSums2}()} (\code{\link[=colSums2]{colSums2()}}) \item \code{base::\link{prod}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowQuantiles.Rd0000644000175200017520000000624514136053374020274 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowQuantiles.R \name{rowQuantiles} \alias{rowQuantiles} \alias{rowQuantiles,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowQuantiles,ANY-method} \alias{colQuantiles} \alias{colQuantiles,matrix_OR_array_OR_table_OR_numeric-method} \alias{colQuantiles,ANY-method} \title{Calculates quantiles for each row (column) of a matrix-like object} \usage{ rowQuantiles(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) \S4method{rowQuantiles}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) \S4method{rowQuantiles}{ANY}(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) colQuantiles(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) \S4method{colQuantiles}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) \S4method{colQuantiles}{ANY}(x, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = FALSE, type = 7L, ..., useNames = NA, drop = TRUE) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{probs}{A numeric vector of J probabilities in [0, 1].} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{type}{An integer specifying the type of estimator. See \code{stats::\link[stats]{quantile}()}. for more details.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{drop}{If \code{TRUE} a vector is returned if \code{J == 1}.} } \value{ a \code{\link{numeric}} \code{NxJ} (\code{KxJ}) \code{\link{matrix}}, where N (K) is the number of rows (columns) for which the J values are calculated. } \description{ Calculates quantiles for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowQuantiles} / \code{matrixStats::colQuantiles}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowQuantiles(mat) colQuantiles(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowQuantiles}()} and \code{matrixStats::\link[matrixStats:rowQuantiles]{colQuantiles}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \link[stats:quantile]{stats::quantile} } } \keyword{array} \keyword{iteration} \keyword{robust} MatrixGenerics/man/rowRanges.Rd0000644000175200017520000000620614136053374017543 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowRanges.R \name{rowRanges} \alias{rowRanges} \alias{rowRanges,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowRanges,ANY-method} \alias{colRanges} \alias{colRanges,matrix_OR_array_OR_table_OR_numeric-method} \alias{colRanges,ANY-method} \title{Calculates the minimum and maximum for each row (column) of a matrix-like object} \usage{ rowRanges(x, ...) \S4method{rowRanges}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowRanges}{ANY}(x, ...) colRanges(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colRanges}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colRanges}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{...}{Additional arguments passed to specific methods.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ a \code{\link{numeric}} \code{Nx2} (\code{Kx2}) \code{\link{matrix}}, where N (K) is the number of rows (columns) for which the ranges are calculated. } \description{ Calculates the minimum and maximum for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowRanges} / \code{matrixStats::colRanges}. } \note{ Unfortunately for the argument list of the \code{rowRanges()} generic function we cannot follow the scheme used for the other row/column matrix summarization generic functions. This is because we need to be compatible with the historic \code{rowRanges()} getter for \link[SummarizedExperiment]{RangedSummarizedExperiment} objects. See \code{?SummarizedExperiment::\link[SummarizedExperiment]{rowRanges}}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowRanges(mat) colRanges(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowRanges}()} and \code{matrixStats::\link[matrixStats:rowRanges]{colRanges}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For max estimates, see \code{\link{rowMaxs}()}. \item For min estimates, see \code{\link{rowMins}()}. \item \code{base::\link{range}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} MatrixGenerics/man/rowRanks.Rd0000644000175200017520000000745214136053374017406 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowRanks.R \name{rowRanks} \alias{rowRanks} \alias{rowRanks,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowRanks,ANY-method} \alias{colRanks} \alias{colRanks,matrix_OR_array_OR_table_OR_numeric-method} \alias{colRanks,ANY-method} \title{Calculates the rank of the elements for each row (column) of a matrix-like object} \usage{ rowRanks(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) \S4method{rowRanks}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, ties.method = c("max", "average", "first", "last", "random", "max", "min", "dense"), dim. = dim(x), ..., useNames = NA) \S4method{rowRanks}{ANY}(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) colRanks(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) \S4method{colRanks}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, ties.method = c("max", "average", "first", "last", "random", "max", "min", "dense"), dim. = dim(x), preserveShape = FALSE, ..., useNames = NA) \S4method{colRanks}{ANY}(x, rows = NULL, cols = NULL, ties.method = c("max", "average"), ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{ties.method}{A character string specifying how ties are treated. Note that the default specifies fewer options than the original matrixStats package.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} \item{preserveShape}{If \code{TRUE} the output matrix has the same shape as the input x. Note, that this is not a generic argument and not all implementation of this function have to provide it.} } \value{ a matrix of type \code{\link{integer}} is returned unless \code{ties.method = "average"}. Ithas dimensions` \code{NxJ} (\code{KxJ}) \code{\link{matrix}}, where N (K) is the number of rows (columns) of the input x. } \description{ Calculates the rank of the elements for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowRanks} / \code{matrixStats::colRanks}. The \code{matrixStats::rowRanks()} function can handle a lot of different values for the \code{ties.method} argument. Users of the generic function should however only rely on \code{max} and \code{average} because the other ones are not guaranteed to be implemented: \describe{ \item{\code{max}}{for values with identical values the maximum rank is returned} \item{\code{average}}{for values with identical values the average of the ranks they cover is returned. Note, that in this case the return value is of type \code{numeric}.} } } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowRanks(mat) colRanks(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowRanks}()} and \code{matrixStats::\link[matrixStats:rowRanks]{colRanks}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \link[base:rank]{base::rank} } } \keyword{array} \keyword{iteration} \keyword{robust} MatrixGenerics/man/rowSdDiffs.Rd0000644000175200017520000000556114136053374017651 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowSdDiffs.R \name{rowSdDiffs} \alias{rowSdDiffs} \alias{rowSdDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowSdDiffs,ANY-method} \alias{colSdDiffs} \alias{colSdDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colSdDiffs,ANY-method} \title{Calculates the standard deviation of the difference between each element of a row (column) of a matrix-like object} \usage{ rowSdDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowSdDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowSdDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) colSdDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colSdDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colSdDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{diff}{An integer specifying the order of difference.} \item{trim}{A double in [0,1/2] specifying the fraction of observations to be trimmed from each end of (sorted) x before estimation.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the standard deviation of the difference between each element of a row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowSdDiffs} / \code{matrixStats::colSdDiffs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowSdDiffs(mat) colSdDiffs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:varDiff]{rowSdDiffs}()} and \code{matrixStats::\link[matrixStats:varDiff]{colSdDiffs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item for the direct standard deviation see \code{\link[=rowSds]{rowSds()}}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowSds.Rd0000644000175200017520000000561614136053374017061 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowSds.R \name{rowSds} \alias{rowSds} \alias{rowSds,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowSds,ANY-method} \alias{colSds} \alias{colSds,matrix_OR_array_OR_table_OR_numeric-method} \alias{colSds,ANY-method} \title{Calculates the standard deviation for each row (column) of a matrix-like object} \usage{ rowSds(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) \S4method{rowSds}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowSds}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) colSds(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) \S4method{colSds}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colSds}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{center}{(optional) the center, defaults to the row means} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the standard deviation for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowSds} / \code{matrixStats::colSds}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowSds(mat) colSds(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowSds}()} and \code{matrixStats::\link[matrixStats:rowSds]{colSds}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For mean estimates, see \code{\link{rowMeans2}()} and \code{\link[base:colSums]{rowMeans}()}. \item For variance estimates, see \code{\link{rowVars}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowSums2.Rd0000644000175200017520000000533114136053374017333 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowSums2.R \name{rowSums2} \alias{rowSums2} \alias{rowSums2,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowSums2,ANY-method} \alias{colSums2} \alias{colSums2,matrix_OR_array_OR_table_OR_numeric-method} \alias{colSums2,ANY-method} \title{Calculates the sum for each row (column) of a matrix-like object} \usage{ rowSums2(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowSums2}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{rowSums2}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colSums2(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colSums2}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, dim. = dim(x), ..., useNames = NA) \S4method{colSums2}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the sum for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowSums2} / \code{matrixStats::colSums2}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowSums2(mat) colSums2(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowSums2}()} and \code{matrixStats::\link[matrixStats:rowSums2]{colSums2}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For mean estimates, see \code{\link{rowMeans2}()} and \code{\link[base:colSums]{rowMeans}()}. \item \code{base::\link{sum}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowTabulates.Rd0000644000175200017520000000502114136053374020242 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowTabulates.R \name{rowTabulates} \alias{rowTabulates} \alias{rowTabulates,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowTabulates,ANY-method} \alias{colTabulates} \alias{colTabulates,matrix_OR_array_OR_table_OR_numeric-method} \alias{colTabulates,ANY-method} \title{Tabulates the values in a matrix-like object by row (column)} \usage{ rowTabulates(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) \S4method{rowTabulates}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) \S4method{rowTabulates}{ANY}(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) colTabulates(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) \S4method{colTabulates}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) \S4method{colTabulates}{ANY}(x, rows = NULL, cols = NULL, values = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{values}{the values to search for.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ a \code{\link{numeric}} \code{NxJ} (\code{KxJ}) \code{\link{matrix}}, where N (K) is the number of rows (columns) for which the J values are calculated. } \description{ Tabulates the values in a matrix-like object by row (column). } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowTabulates} / \code{matrixStats::colTabulates}. } \examples{ mat <- matrix(rpois(15, lambda = 3), nrow = 5, ncol = 3) mat[2, 1] <- NA_integer_ mat[3, 3] <- 0L mat[4, 1] <- 0L print(mat) rowTabulates(mat) colTabulates(mat) rowTabulates(mat, values = 0) colTabulates(mat, values = 0) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowTabulates}()} and \code{matrixStats::\link[matrixStats:rowTabulates]{colTabulates}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item \code{base::\link{table}()} } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowVarDiffs.Rd0000644000175200017520000000555114136053374020032 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowVarDiffs.R \name{rowVarDiffs} \alias{rowVarDiffs} \alias{rowVarDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowVarDiffs,ANY-method} \alias{colVarDiffs} \alias{colVarDiffs,matrix_OR_array_OR_table_OR_numeric-method} \alias{colVarDiffs,ANY-method} \title{Calculates the variance of the difference between each element of a row (column) of a matrix-like object} \usage{ rowVarDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowVarDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{rowVarDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) colVarDiffs(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colVarDiffs}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) \S4method{colVarDiffs}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, diff = 1L, trim = 0, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{diff}{An integer specifying the order of difference.} \item{trim}{A double in [0,1/2] specifying the fraction of observations to be trimmed from each end of (sorted) x before estimation.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the variance of the difference between each element of a row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowVarDiffs} / \code{matrixStats::colVarDiffs}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowVarDiffs(mat) colVarDiffs(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:varDiff]{rowVarDiffs}()} and \code{matrixStats::\link[matrixStats:varDiff]{colVarDiffs}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item for the direct variance see \code{\link[=rowVars]{rowVars()}}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowVars.Rd0000644000175200017520000000570614136053374017243 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowVars.R \name{rowVars} \alias{rowVars} \alias{rowVars,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowVars,ANY-method} \alias{colVars} \alias{colVars,matrix_OR_array_OR_table_OR_numeric-method} \alias{colVars,ANY-method} \title{Calculates the variance for each row (column) of a matrix-like object} \usage{ rowVars(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) \S4method{rowVars}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA) \S4method{rowVars}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) colVars(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) \S4method{colVars}{matrix_OR_array_OR_table_OR_numeric}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, dim. = dim(x), ..., useNames = NA) \S4method{colVars}{ANY}(x, rows = NULL, cols = NULL, na.rm = FALSE, center = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{center}{(optional) the center, defaults to the row means.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} \item{dim.}{An \code{\link{integer}} \code{\link{vector}} of length two specifying the dimension of \code{x}, essential when x is a \code{\link{numeric}} vector. Note, that this is not a generic argument and not all methods need provide it.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the variance for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowVars} / \code{matrixStats::colVars}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) rowVars(mat) colVars(mat) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowVars}()} and \code{matrixStats::\link[matrixStats:rowVars]{colVars}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item For mean estimates, see \code{\link{rowMeans2}()} and \code{\link[base:colSums]{rowMeans}()}. \item For standard deviation estimates, see \code{\link{rowSds}()}. \item \code{stats::\link[stats:cor]{var}()}. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowWeightedMads.Rd0000644000175200017520000000621714136053374020673 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowWeightedMads.R \name{rowWeightedMads} \alias{rowWeightedMads} \alias{rowWeightedMads,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowWeightedMads,ANY-method} \alias{colWeightedMads} \alias{colWeightedMads,matrix_OR_array_OR_table_OR_numeric-method} \alias{colWeightedMads,ANY-method} \title{Calculates the weighted median absolute deviation for each row (column) of a matrix-like object} \usage{ rowWeightedMads(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ...) \S4method{rowWeightedMads}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA) \S4method{rowWeightedMads}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ...) colWeightedMads(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA) \S4method{colWeightedMads}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA) \S4method{colWeightedMads}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, constant = 1.4826, center = NULL, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{w}{A \code{\link{numeric}} vector of length K (N) that specifies by how much each element is weighted.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{constant}{A scale factor. See \code{stats::\link[stats]{mad}()} for details.} \item{center}{(optional) the center, defaults to the row means} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the weighted median absolute deviation for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowWeightedMads} / \code{matrixStats::colWeightedMads}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) w <- rnorm(n = 5, mean = 3) rowWeightedMads(mat, w = w[1:3]) colWeightedMads(mat, w = w) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:weightedMad]{rowWeightedMads}()} and \code{matrixStats::\link[matrixStats:weightedMad]{colWeightedMads}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \link{rowMads} for the corresponding unweighted function. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowWeightedMeans.Rd0000644000175200017520000000545414136053374021054 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowWeightedMeans.R \name{rowWeightedMeans} \alias{rowWeightedMeans} \alias{rowWeightedMeans,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowWeightedMeans,ANY-method} \alias{colWeightedMeans} \alias{colWeightedMeans,matrix_OR_array_OR_table_OR_numeric-method} \alias{colWeightedMeans,ANY-method} \title{Calculates the weighted mean for each row (column) of a matrix-like object} \usage{ rowWeightedMeans(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedMeans}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedMeans}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colWeightedMeans(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedMeans}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedMeans}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{w}{A \code{\link{numeric}} vector of length K (N) that specifies by how much each element is weighted.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the weighted mean for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowWeightedMeans} / \code{matrixStats::colWeightedMeans}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) w <- rnorm(n = 5, mean = 3) rowWeightedMeans(mat, w = w[1:3]) colWeightedMeans(mat, w = w) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowWeightedMeans}()} and \code{matrixStats::\link[matrixStats:rowWeightedMeans]{colWeightedMeans}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \link{rowMeans2} for the corresponding unweighted function. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowWeightedMedians.Rd0000644000175200017520000000553614136053374021372 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowWeightedMedians.R \name{rowWeightedMedians} \alias{rowWeightedMedians} \alias{rowWeightedMedians,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowWeightedMedians,ANY-method} \alias{colWeightedMedians} \alias{colWeightedMedians,matrix_OR_array_OR_table_OR_numeric-method} \alias{colWeightedMedians,ANY-method} \title{Calculates the weighted median for each row (column) of a matrix-like object} \usage{ rowWeightedMedians(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedMedians}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedMedians}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colWeightedMedians(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedMedians}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedMedians}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{w}{A \code{\link{numeric}} vector of length K (N) that specifies by how much each element is weighted.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the weighted median for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowWeightedMedians} / \code{matrixStats::colWeightedMedians}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) w <- rnorm(n = 5, mean = 3) rowWeightedMedians(mat, w = w[1:3]) colWeightedMedians(mat, w = w) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats]{rowWeightedMedians}()} and \code{matrixStats::\link[matrixStats:rowWeightedMedians]{colWeightedMedians}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \link{rowMedians} for the corresponding unweighted function. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowWeightedSds.Rd0000644000175200017520000000544314136053374020540 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowWeightedSds.R \name{rowWeightedSds} \alias{rowWeightedSds} \alias{rowWeightedSds,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowWeightedSds,ANY-method} \alias{colWeightedSds} \alias{colWeightedSds,matrix_OR_array_OR_table_OR_numeric-method} \alias{colWeightedSds,ANY-method} \title{Calculates the weighted standard deviation for each row (column) of a matrix-like object} \usage{ rowWeightedSds(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedSds}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedSds}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colWeightedSds(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedSds}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedSds}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{w}{A \code{\link{numeric}} vector of length K (N) that specifies by how much each element is weighted.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the weighted standard deviation for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowWeightedSds} / \code{matrixStats::colWeightedSds}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) w <- rnorm(n = 5, mean = 3) rowWeightedSds(mat, w = w[1:3]) colWeightedSds(mat, w = w) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:weightedVar]{rowWeightedSds}()} and \code{matrixStats::\link[matrixStats:weightedVar]{colWeightedSds}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \link{rowSds} for the corresponding unweighted function. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/man/rowWeightedVars.Rd0000644000175200017520000000544414136053374020723 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rowWeightedVars.R \name{rowWeightedVars} \alias{rowWeightedVars} \alias{rowWeightedVars,matrix_OR_array_OR_table_OR_numeric-method} \alias{rowWeightedVars,ANY-method} \alias{colWeightedVars} \alias{colWeightedVars,matrix_OR_array_OR_table_OR_numeric-method} \alias{colWeightedVars,ANY-method} \title{Calculates the weighted variance for each row (column) of a matrix-like object} \usage{ rowWeightedVars(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedVars}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{rowWeightedVars}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) colWeightedVars(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedVars}{matrix_OR_array_OR_table_OR_numeric}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) \S4method{colWeightedVars}{ANY}(x, w = NULL, rows = NULL, cols = NULL, na.rm = FALSE, ..., useNames = NA) } \arguments{ \item{x}{An NxK matrix-like object.} \item{w}{A \code{\link{numeric}} vector of length K (N) that specifies by how much each element is weighted.} \item{rows, cols}{A \code{\link{vector}} indicating the subset of rows (and/or columns) to operate over. If \code{\link{NULL}}, no subsetting is done.} \item{na.rm}{If \code{\link[base:logical]{TRUE}}, \code{\link{NA}}s are excluded first, otherwise not.} \item{...}{Additional arguments passed to specific methods.} \item{useNames}{If \code{\link{NA}}, the default behavior of the function about naming support is remained. If \code{\link{FALSE}}, no naming support is done. Else if \code{\link{TRUE}}, names attributes of result are set.} } \value{ Returns a \code{\link{numeric}} \code{\link{vector}} of length N (K). } \description{ Calculates the weighted variance for each row (column) of a matrix-like object. } \details{ The S4 methods for \code{x} of type \code{\link{matrix}}, \code{\link{array}}, or \code{\link{numeric}} call \code{matrixStats::rowWeightedVars} / \code{matrixStats::colWeightedVars}. } \examples{ mat <- matrix(rnorm(15), nrow = 5, ncol = 3) mat[2, 1] <- NA mat[3, 3] <- Inf mat[4, 1] <- 0 print(mat) w <- rnorm(n = 5, mean = 3) rowWeightedVars(mat, w = w[1:3]) colWeightedVars(mat, w = w) } \seealso{ \itemize{ \item \code{matrixStats::\link[matrixStats:weightedVar]{rowWeightedVars}()} and \code{matrixStats::\link[matrixStats:weightedVar]{colWeightedVars}()} which are used when the input is a \code{matrix} or \code{numeric} vector. \item See also \link{rowVars} for the corresponding unweighted function. } } \keyword{array} \keyword{iteration} \keyword{robust} \keyword{univar} MatrixGenerics/tests/0000755000175200017520000000000014136053374015670 5ustar00biocbuildbiocbuildMatrixGenerics/tests/testthat/0000755000175200017520000000000014136073637017534 5ustar00biocbuildbiocbuildMatrixGenerics/tests/testthat.R0000644000175200017520000000011014136053374017643 0ustar00biocbuildbiocbuildlibrary(testthat) library(MatrixGenerics) test_check("MatrixGenerics") MatrixGenerics/tests/testthat/test-api_compatibility.R0000644000175200017520000020515014136053374024335 0ustar00biocbuildbiocbuild# Generated by tests/testthat/generate_tests_helper_script.R # do not edit by hand # Make a matrix with different features mat <- matrix(rnorm(16 * 6), nrow = 16, ncol = 6) mat[1,1] <- 0 mat[2,3] <- NA mat[3,3] <- -Inf mat[5,4] <- NaN mat[5,1] <- Inf mat[6,2] <- 0 mat[6,5] <- 0 test_that("colAlls works ", { matrixStats_formals <- formals(matrixStats::colAlls) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colAlls) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colAlls(x = mat) ms_res_def_1 <- matrixStats::colAlls(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colAlls(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colAlls(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colAlls(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colAlls(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colAlls(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::colAlls(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("colAnyNAs works ", { matrixStats_formals <- formals(matrixStats::colAnyNAs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colAnyNAs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colAnyNAs(x = mat) ms_res_def_1 <- matrixStats::colAnyNAs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colAnyNAs(x = mat, rows = NULL, cols = NULL) ms_res_1 <- matrixStats::colAnyNAs(x = mat, rows = NULL, cols = NULL) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colAnyNAs(x = mat, rows = 1:3, cols = 2) ms_res_2 <- matrixStats::colAnyNAs(x = mat, rows = 1:3, cols = 2) expect_equal(mg_res_2, ms_res_2) }) test_that("colAnys works ", { matrixStats_formals <- formals(matrixStats::colAnys) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colAnys) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colAnys(x = mat) ms_res_def_1 <- matrixStats::colAnys(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colAnys(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colAnys(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colAnys(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colAnys(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colAnys(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::colAnys(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("colAvgsPerRowSet works ", { matrixStats_formals <- formals(matrixStats::colAvgsPerRowSet) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colAvgsPerRowSet) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) S <- matrix(1:nrow(mat), ncol = 2) mg_res_def_1 <- colAvgsPerRowSet(X = mat, S = S, FUN = colMeans) ms_res_def_1 <- matrixStats::colAvgsPerRowSet(X = mat, S = S, FUN = colMeans) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- colAvgsPerRowSet(X = mat, S = S, FUN = colVars) ms_res_def_2 <- matrixStats::colAvgsPerRowSet(X = mat, S = S, FUN = colVars) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- colAvgsPerRowSet(X = mat, W = NULL, cols = NULL, S = S, FUN = colMeans, na.rm = TRUE, tFUN = FALSE) ms_res_1 <- matrixStats::colAvgsPerRowSet(X = mat, W = NULL, cols = NULL, S = S, FUN = colMeans, na.rm = TRUE, tFUN = FALSE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colAvgsPerRowSet(X = mat, W = NULL, cols = 1:2, S = S, FUN = colVars, na.rm = FALSE, tFUN = FALSE) ms_res_2 <- matrixStats::colAvgsPerRowSet(X = mat, W = NULL, cols = 1:2, S = S, FUN = colVars, na.rm = FALSE, tFUN = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colCollapse works ", { matrixStats_formals <- formals(matrixStats::colCollapse) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCollapse) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCollapse(x = mat, idxs = 1) ms_res_def_1 <- matrixStats::colCollapse(x = mat, idxs = 1) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- colCollapse(x = mat, idxs = 2:3) ms_res_def_2 <- matrixStats::colCollapse(x = mat, idxs = 2:3) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- colCollapse(x = mat, idxs = 1, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::colCollapse(x = mat, idxs = 1, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCollapse(x = mat, idxs = 2:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCollapse(x = mat, idxs = 2:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colCounts works ", { matrixStats_formals <- formals(matrixStats::colCounts) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCounts) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCounts(x = mat) ms_res_def_1 <- matrixStats::colCounts(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colCounts(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colCounts(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCounts(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCounts(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colCounts(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::colCounts(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("colCummaxs works ", { matrixStats_formals <- formals(matrixStats::colCummaxs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCummaxs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCummaxs(x = mat) ms_res_def_1 <- matrixStats::colCummaxs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colCummaxs(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::colCummaxs(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCummaxs(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCummaxs(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colCummins works ", { matrixStats_formals <- formals(matrixStats::colCummins) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCummins) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCummins(x = mat) ms_res_def_1 <- matrixStats::colCummins(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colCummins(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::colCummins(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCummins(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCummins(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colCumprods works ", { matrixStats_formals <- formals(matrixStats::colCumprods) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCumprods) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCumprods(x = mat) ms_res_def_1 <- matrixStats::colCumprods(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colCumprods(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::colCumprods(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCumprods(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCumprods(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colCumsums works ", { matrixStats_formals <- formals(matrixStats::colCumsums) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colCumsums) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colCumsums(x = mat) ms_res_def_1 <- matrixStats::colCumsums(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colCumsums(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::colCumsums(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colCumsums(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colCumsums(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colDiffs works ", { matrixStats_formals <- formals(matrixStats::colDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colDiffs(x = mat) ms_res_def_1 <- matrixStats::colDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colDiffs(x = mat, rows = NULL, cols = NULL, lag = 1, differences = 1, dim. = dim(mat)) ms_res_1 <- matrixStats::colDiffs(x = mat, rows = NULL, cols = NULL, lag = 1, differences = 1, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colDiffs(x = mat, rows = 1:3, cols = 2, lag = 3, differences = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colDiffs(x = mat, rows = 1:3, cols = 2, lag = 3, differences = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colIQRDiffs works ", { matrixStats_formals <- formals(matrixStats::colIQRDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colIQRDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colIQRDiffs(x = mat) ms_res_def_1 <- matrixStats::colIQRDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::colIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colIQRDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::colIQRDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::colIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("colIQRs works ", { matrixStats_formals <- formals(matrixStats::colIQRs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colIQRs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colIQRs(x = mat) ms_res_def_1 <- matrixStats::colIQRs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colIQRs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::colIQRs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colIQRs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::colIQRs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colLogSumExps works ", { matrixStats_formals <- formals(matrixStats::colLogSumExps) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colLogSumExps) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colLogSumExps(lx = mat) ms_res_def_1 <- matrixStats::colLogSumExps(lx = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colLogSumExps(lx = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colLogSumExps(lx = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colLogSumExps(lx = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colLogSumExps(lx = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colMadDiffs works ", { matrixStats_formals <- formals(matrixStats::colMadDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMadDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMadDiffs(x = mat) ms_res_def_1 <- matrixStats::colMadDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::colMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMadDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::colMadDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::colMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("colMads works ", { matrixStats_formals <- formals(matrixStats::colMads) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMads) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMads(x = mat) ms_res_def_1 <- matrixStats::colMads(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMads(x = mat, rows = NULL, cols = NULL, center = colMeans2(mat, na.rm=TRUE), constant = 1.4826, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colMads(x = mat, rows = NULL, cols = NULL, center = colMeans2(mat, na.rm=TRUE), constant = 1.4826, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMads(x = mat, rows = 1:3, cols = 2, center = NULL, constant = 5, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colMads(x = mat, rows = 1:3, cols = 2, center = NULL, constant = 5, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colMaxs works ", { matrixStats_formals <- formals(matrixStats::colMaxs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMaxs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMaxs(x = mat) ms_res_def_1 <- matrixStats::colMaxs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMaxs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colMaxs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMaxs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colMaxs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colMeans2 works ", { matrixStats_formals <- formals(matrixStats::colMeans2) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMeans2) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMeans2(x = mat) ms_res_def_1 <- matrixStats::colMeans2(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMeans2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colMeans2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMeans2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colMeans2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colMedians works ", { matrixStats_formals <- formals(matrixStats::colMedians) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMedians) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMedians(x = mat) ms_res_def_1 <- matrixStats::colMedians(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMedians(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colMedians(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMedians(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colMedians(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colMins works ", { matrixStats_formals <- formals(matrixStats::colMins) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colMins) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colMins(x = mat) ms_res_def_1 <- matrixStats::colMins(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colMins(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colMins(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colMins(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colMins(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colOrderStats works ", { matrixStats_formals <- formals(matrixStats::colOrderStats) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colOrderStats) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat[is.na(mat)] <- 4.1 mg_res_def_1 <- colOrderStats(x = mat, which = 2) ms_res_def_1 <- matrixStats::colOrderStats(x = mat, which = 2) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- colOrderStats(x = mat, which = 1) ms_res_def_2 <- matrixStats::colOrderStats(x = mat, which = 1) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- colOrderStats(x = mat, rows = NULL, cols = NULL, which = 2, dim. = dim(mat)) ms_res_1 <- matrixStats::colOrderStats(x = mat, rows = NULL, cols = NULL, which = 2, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colOrderStats(x = mat, rows = 1:3, cols = 2, which = 1, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colOrderStats(x = mat, rows = 1:3, cols = 2, which = 1, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colProds works ", { matrixStats_formals <- formals(matrixStats::colProds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colProds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colProds(x = mat) ms_res_def_1 <- matrixStats::colProds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colProds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, method = 'direct') ms_res_1 <- matrixStats::colProds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, method = 'direct') expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colProds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, method = 'expSumLog') ms_res_2 <- matrixStats::colProds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, method = 'expSumLog') expect_equal(mg_res_2, ms_res_2) }) test_that("colQuantiles works ", { matrixStats_formals <- formals(matrixStats::colQuantiles) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colQuantiles) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colQuantiles(x = mat) ms_res_def_1 <- matrixStats::colQuantiles(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colQuantiles(x = mat, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = TRUE, type = 7, drop = TRUE) ms_res_1 <- matrixStats::colQuantiles(x = mat, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = TRUE, type = 7, drop = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colQuantiles(x = mat, rows = 1:3, cols = 2, probs = 0.1, na.rm = FALSE, type = 3, drop = FALSE) ms_res_2 <- matrixStats::colQuantiles(x = mat, rows = 1:3, cols = 2, probs = 0.1, na.rm = FALSE, type = 3, drop = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colRanges works ", { matrixStats_formals <- formals(matrixStats::colRanges) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colRanges) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colRanges(x = mat) ms_res_def_1 <- matrixStats::colRanges(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colRanges(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colRanges(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colRanges(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colRanges(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colRanks works ", { matrixStats_formals <- formals(matrixStats::colRanks) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colRanks) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colRanks(x = mat) ms_res_def_1 <- matrixStats::colRanks(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'max', dim. = dim(mat), preserveShape = FALSE) ms_res_1 <- matrixStats::colRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'max', dim. = dim(mat), preserveShape = FALSE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colRanks(x = mat, rows = 1:3, cols = 2, ties.method = 'first', dim. = c(12L, 8L), preserveShape = TRUE) ms_res_2 <- matrixStats::colRanks(x = mat, rows = 1:3, cols = 2, ties.method = 'first', dim. = c(12L, 8L), preserveShape = TRUE) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'dense', dim. = dim(mat), preserveShape = FALSE) ms_res_3 <- matrixStats::colRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'dense', dim. = dim(mat), preserveShape = FALSE) expect_equal(mg_res_3, ms_res_3) }) test_that("colSdDiffs works ", { matrixStats_formals <- formals(matrixStats::colSdDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colSdDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colSdDiffs(x = mat) ms_res_def_1 <- matrixStats::colSdDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::colSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colSdDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::colSdDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::colSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("colSds works ", { matrixStats_formals <- formals(matrixStats::colSds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colSds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colSds(x = mat) ms_res_def_1 <- matrixStats::colSds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colSds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = colMeans2(mat, na.rm=TRUE), dim. = dim(mat)) ms_res_1 <- matrixStats::colSds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = colMeans2(mat, na.rm=TRUE), dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colSds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colSds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colSums2 works ", { matrixStats_formals <- formals(matrixStats::colSums2) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colSums2) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colSums2(x = mat) ms_res_def_1 <- matrixStats::colSums2(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colSums2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::colSums2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colSums2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colSums2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colTabulates works ", { matrixStats_formals <- formals(matrixStats::colTabulates) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colTabulates) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(suppressWarnings(as.integer(mat)), dim(mat)) mg_res_def_1 <- colTabulates(x = mat) ms_res_def_1 <- matrixStats::colTabulates(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colTabulates(x = mat, rows = NULL, cols = NULL, values = 0) ms_res_1 <- matrixStats::colTabulates(x = mat, rows = NULL, cols = NULL, values = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colTabulates(x = mat, rows = 1:3, cols = 2, values = c(0, 1)) ms_res_2 <- matrixStats::colTabulates(x = mat, rows = 1:3, cols = 2, values = c(0, 1)) expect_equal(mg_res_2, ms_res_2) }) test_that("colVarDiffs works ", { matrixStats_formals <- formals(matrixStats::colVarDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colVarDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colVarDiffs(x = mat) ms_res_def_1 <- matrixStats::colVarDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::colVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colVarDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::colVarDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- colVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::colVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("colVars works ", { matrixStats_formals <- formals(matrixStats::colVars) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colVars) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colVars(x = mat) ms_res_def_1 <- matrixStats::colVars(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colVars(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = colMeans2(mat, na.rm=TRUE), dim. = dim(mat)) ms_res_1 <- matrixStats::colVars(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = colMeans2(mat, na.rm=TRUE), dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colVars(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::colVars(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("colWeightedMads works ", { matrixStats_formals <- formals(matrixStats::colWeightedMads) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colWeightedMads) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colWeightedMads(x = mat) ms_res_def_1 <- matrixStats::colWeightedMads(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colWeightedMads(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE, constant = 1.4826, center = colMeans2(mat, na.rm=TRUE)) ms_res_1 <- matrixStats::colWeightedMads(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE, constant = 1.4826, center = colMeans2(mat, na.rm=TRUE)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colWeightedMads(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE, constant = 5, center = rep(6, ncol(mat))) ms_res_2 <- matrixStats::colWeightedMads(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE, constant = 5, center = rep(6, ncol(mat))) expect_equal(mg_res_2, ms_res_2) }) test_that("colWeightedMeans works ", { matrixStats_formals <- formals(matrixStats::colWeightedMeans) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colWeightedMeans) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colWeightedMeans(x = mat) ms_res_def_1 <- matrixStats::colWeightedMeans(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colWeightedMeans(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::colWeightedMeans(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colWeightedMeans(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::colWeightedMeans(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colWeightedMedians works ", { matrixStats_formals <- formals(matrixStats::colWeightedMedians) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colWeightedMedians) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colWeightedMedians(x = mat) ms_res_def_1 <- matrixStats::colWeightedMedians(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colWeightedMedians(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::colWeightedMedians(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colWeightedMedians(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::colWeightedMedians(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colWeightedSds works ", { matrixStats_formals <- formals(matrixStats::colWeightedSds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colWeightedSds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colWeightedSds(x = mat) ms_res_def_1 <- matrixStats::colWeightedSds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colWeightedSds(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::colWeightedSds(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colWeightedSds(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::colWeightedSds(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("colWeightedVars works ", { matrixStats_formals <- formals(matrixStats::colWeightedVars) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_colWeightedVars) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- colWeightedVars(x = mat) ms_res_def_1 <- matrixStats::colWeightedVars(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- colWeightedVars(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::colWeightedVars(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- colWeightedVars(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::colWeightedVars(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowAlls works ", { matrixStats_formals <- formals(matrixStats::rowAlls) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowAlls) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowAlls(x = mat) ms_res_def_1 <- matrixStats::rowAlls(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowAlls(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowAlls(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowAlls(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowAlls(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowAlls(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::rowAlls(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("rowAnyNAs works ", { matrixStats_formals <- formals(matrixStats::rowAnyNAs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowAnyNAs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowAnyNAs(x = mat) ms_res_def_1 <- matrixStats::rowAnyNAs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowAnyNAs(x = mat, rows = NULL, cols = NULL) ms_res_1 <- matrixStats::rowAnyNAs(x = mat, rows = NULL, cols = NULL) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowAnyNAs(x = mat, rows = 1:3, cols = 2) ms_res_2 <- matrixStats::rowAnyNAs(x = mat, rows = 1:3, cols = 2) expect_equal(mg_res_2, ms_res_2) }) test_that("rowAnys works ", { matrixStats_formals <- formals(matrixStats::rowAnys) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowAnys) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowAnys(x = mat) ms_res_def_1 <- matrixStats::rowAnys(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowAnys(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowAnys(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowAnys(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowAnys(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowAnys(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::rowAnys(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("rowAvgsPerColSet works ", { matrixStats_formals <- formals(matrixStats::rowAvgsPerColSet) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowAvgsPerColSet) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) S <- matrix(1:ncol(mat), ncol = 2) mg_res_def_1 <- rowAvgsPerColSet(X = mat, S = S, FUN = rowMeans) ms_res_def_1 <- matrixStats::rowAvgsPerColSet(X = mat, S = S, FUN = rowMeans) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- rowAvgsPerColSet(X = mat, S = S, FUN = rowVars) ms_res_def_2 <- matrixStats::rowAvgsPerColSet(X = mat, S = S, FUN = rowVars) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- rowAvgsPerColSet(X = mat, W = NULL, rows = NULL, S = S, FUN = rowMeans, na.rm = TRUE, tFUN = FALSE) ms_res_1 <- matrixStats::rowAvgsPerColSet(X = mat, W = NULL, rows = NULL, S = S, FUN = rowMeans, na.rm = TRUE, tFUN = FALSE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowAvgsPerColSet(X = mat, W = NULL, rows = 1:3, S = S, FUN = rowVars, na.rm = FALSE, tFUN = FALSE) ms_res_2 <- matrixStats::rowAvgsPerColSet(X = mat, W = NULL, rows = 1:3, S = S, FUN = rowVars, na.rm = FALSE, tFUN = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowCollapse works ", { matrixStats_formals <- formals(matrixStats::rowCollapse) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCollapse) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCollapse(x = mat, idxs = 1) ms_res_def_1 <- matrixStats::rowCollapse(x = mat, idxs = 1) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- rowCollapse(x = mat, idxs = 2:3) ms_res_def_2 <- matrixStats::rowCollapse(x = mat, idxs = 2:3) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- rowCollapse(x = mat, idxs = 1, rows = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCollapse(x = mat, idxs = 1, rows = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCollapse(x = mat, idxs = 2:3, rows = 1:3, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCollapse(x = mat, idxs = 2:3, rows = 1:3, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowCounts works ", { matrixStats_formals <- formals(matrixStats::rowCounts) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCounts) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCounts(x = mat) ms_res_def_1 <- matrixStats::rowCounts(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowCounts(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCounts(x = mat, rows = NULL, cols = NULL, value = TRUE, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCounts(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCounts(x = mat, rows = 1:3, cols = 2, value = FALSE, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowCounts(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) ms_res_3 <- matrixStats::rowCounts(x = mat, rows = NULL, cols = NULL, value = 0, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("rowCummaxs works ", { matrixStats_formals <- formals(matrixStats::rowCummaxs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCummaxs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCummaxs(x = mat) ms_res_def_1 <- matrixStats::rowCummaxs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowCummaxs(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCummaxs(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCummaxs(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCummaxs(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowCummins works ", { matrixStats_formals <- formals(matrixStats::rowCummins) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCummins) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCummins(x = mat) ms_res_def_1 <- matrixStats::rowCummins(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowCummins(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCummins(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCummins(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCummins(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowCumprods works ", { matrixStats_formals <- formals(matrixStats::rowCumprods) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCumprods) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCumprods(x = mat) ms_res_def_1 <- matrixStats::rowCumprods(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowCumprods(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCumprods(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCumprods(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCumprods(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowCumsums works ", { matrixStats_formals <- formals(matrixStats::rowCumsums) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowCumsums) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowCumsums(x = mat) ms_res_def_1 <- matrixStats::rowCumsums(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowCumsums(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) ms_res_1 <- matrixStats::rowCumsums(x = mat, rows = NULL, cols = NULL, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowCumsums(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowCumsums(x = mat, rows = 1:3, cols = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowDiffs works ", { matrixStats_formals <- formals(matrixStats::rowDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowDiffs(x = mat) ms_res_def_1 <- matrixStats::rowDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowDiffs(x = mat, rows = NULL, cols = NULL, lag = 1, differences = 1, dim. = dim(mat)) ms_res_1 <- matrixStats::rowDiffs(x = mat, rows = NULL, cols = NULL, lag = 1, differences = 1, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowDiffs(x = mat, rows = 1:3, cols = 2, lag = 3, differences = 2, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowDiffs(x = mat, rows = 1:3, cols = 2, lag = 3, differences = 2, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowIQRDiffs works ", { matrixStats_formals <- formals(matrixStats::rowIQRDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowIQRDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowIQRDiffs(x = mat) ms_res_def_1 <- matrixStats::rowIQRDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::rowIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowIQRDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::rowIQRDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::rowIQRDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("rowIQRs works ", { matrixStats_formals <- formals(matrixStats::rowIQRs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowIQRs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowIQRs(x = mat) ms_res_def_1 <- matrixStats::rowIQRs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowIQRs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::rowIQRs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowIQRs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::rowIQRs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowLogSumExps works ", { matrixStats_formals <- formals(matrixStats::rowLogSumExps) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowLogSumExps) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowLogSumExps(lx = mat) ms_res_def_1 <- matrixStats::rowLogSumExps(lx = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowLogSumExps(lx = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowLogSumExps(lx = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowLogSumExps(lx = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowLogSumExps(lx = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowMadDiffs works ", { matrixStats_formals <- formals(matrixStats::rowMadDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMadDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMadDiffs(x = mat) ms_res_def_1 <- matrixStats::rowMadDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::rowMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMadDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::rowMadDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::rowMadDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("rowMads works ", { matrixStats_formals <- formals(matrixStats::rowMads) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMads) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMads(x = mat) ms_res_def_1 <- matrixStats::rowMads(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMads(x = mat, rows = NULL, cols = NULL, center = rowMeans2(mat, na.rm=TRUE), constant = 1.4826, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowMads(x = mat, rows = NULL, cols = NULL, center = rowMeans2(mat, na.rm=TRUE), constant = 1.4826, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMads(x = mat, rows = 1:3, cols = 2, center = NULL, constant = 5, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowMads(x = mat, rows = 1:3, cols = 2, center = NULL, constant = 5, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowMaxs works ", { matrixStats_formals <- formals(matrixStats::rowMaxs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMaxs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMaxs(x = mat) ms_res_def_1 <- matrixStats::rowMaxs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMaxs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowMaxs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMaxs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowMaxs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowMeans2 works ", { matrixStats_formals <- formals(matrixStats::rowMeans2) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMeans2) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMeans2(x = mat) ms_res_def_1 <- matrixStats::rowMeans2(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMeans2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowMeans2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMeans2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowMeans2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowMedians works ", { matrixStats_formals <- formals(matrixStats::rowMedians) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMedians) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMedians(x = mat) ms_res_def_1 <- matrixStats::rowMedians(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMedians(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowMedians(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMedians(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowMedians(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowMins works ", { matrixStats_formals <- formals(matrixStats::rowMins) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowMins) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowMins(x = mat) ms_res_def_1 <- matrixStats::rowMins(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowMins(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowMins(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowMins(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowMins(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowOrderStats works ", { matrixStats_formals <- formals(matrixStats::rowOrderStats) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowOrderStats) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat[is.na(mat)] <- 4.1 mg_res_def_1 <- rowOrderStats(x = mat, which = 2) ms_res_def_1 <- matrixStats::rowOrderStats(x = mat, which = 2) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_def_2 <- rowOrderStats(x = mat, which = 1) ms_res_def_2 <- matrixStats::rowOrderStats(x = mat, which = 1) expect_equal(mg_res_def_2, ms_res_def_2) mg_res_1 <- rowOrderStats(x = mat, rows = NULL, cols = NULL, which = 2, dim. = dim(mat)) ms_res_1 <- matrixStats::rowOrderStats(x = mat, rows = NULL, cols = NULL, which = 2, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowOrderStats(x = mat, rows = 1:3, cols = 2, which = 1, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowOrderStats(x = mat, rows = 1:3, cols = 2, which = 1, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowProds works ", { matrixStats_formals <- formals(matrixStats::rowProds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowProds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowProds(x = mat) ms_res_def_1 <- matrixStats::rowProds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowProds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, method = 'direct') ms_res_1 <- matrixStats::rowProds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, method = 'direct') expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowProds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, method = 'expSumLog') ms_res_2 <- matrixStats::rowProds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, method = 'expSumLog') expect_equal(mg_res_2, ms_res_2) }) test_that("rowQuantiles works ", { matrixStats_formals <- formals(matrixStats::rowQuantiles) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowQuantiles) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowQuantiles(x = mat) ms_res_def_1 <- matrixStats::rowQuantiles(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowQuantiles(x = mat, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = TRUE, type = 7, drop = TRUE) ms_res_1 <- matrixStats::rowQuantiles(x = mat, rows = NULL, cols = NULL, probs = seq(from = 0, to = 1, by = 0.25), na.rm = TRUE, type = 7, drop = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowQuantiles(x = mat, rows = 1:3, cols = 2, probs = 0.1, na.rm = FALSE, type = 3, drop = FALSE) ms_res_2 <- matrixStats::rowQuantiles(x = mat, rows = 1:3, cols = 2, probs = 0.1, na.rm = FALSE, type = 3, drop = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowRanges works ", { matrixStats_formals <- formals(matrixStats::rowRanges) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowRanges) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowRanges(x = mat) ms_res_def_1 <- matrixStats::rowRanges(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowRanges(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowRanges(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowRanges(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowRanges(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowRanks works ", { matrixStats_formals <- formals(matrixStats::rowRanks) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowRanks) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowRanks(x = mat) ms_res_def_1 <- matrixStats::rowRanks(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'max', dim. = dim(mat)) ms_res_1 <- matrixStats::rowRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'max', dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowRanks(x = mat, rows = 1:3, cols = 2, ties.method = 'first', dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowRanks(x = mat, rows = 1:3, cols = 2, ties.method = 'first', dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'dense', dim. = dim(mat)) ms_res_3 <- matrixStats::rowRanks(x = mat, rows = NULL, cols = NULL, ties.method = 'dense', dim. = dim(mat)) expect_equal(mg_res_3, ms_res_3) }) test_that("rowSdDiffs works ", { matrixStats_formals <- formals(matrixStats::rowSdDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowSdDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowSdDiffs(x = mat) ms_res_def_1 <- matrixStats::rowSdDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::rowSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowSdDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::rowSdDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::rowSdDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("rowSds works ", { matrixStats_formals <- formals(matrixStats::rowSds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowSds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowSds(x = mat) ms_res_def_1 <- matrixStats::rowSds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowSds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = rowMeans2(mat, na.rm=TRUE), dim. = dim(mat)) ms_res_1 <- matrixStats::rowSds(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = rowMeans2(mat, na.rm=TRUE), dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowSds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowSds(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowSums2 works ", { matrixStats_formals <- formals(matrixStats::rowSums2) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowSums2) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowSums2(x = mat) ms_res_def_1 <- matrixStats::rowSums2(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowSums2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) ms_res_1 <- matrixStats::rowSums2(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowSums2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowSums2(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowTabulates works ", { matrixStats_formals <- formals(matrixStats::rowTabulates) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowTabulates) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(suppressWarnings(as.integer(mat)), dim(mat)) mg_res_def_1 <- rowTabulates(x = mat) ms_res_def_1 <- matrixStats::rowTabulates(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowTabulates(x = mat, rows = NULL, cols = NULL, values = 0) ms_res_1 <- matrixStats::rowTabulates(x = mat, rows = NULL, cols = NULL, values = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowTabulates(x = mat, rows = 1:3, cols = 2, values = c(0, 1)) ms_res_2 <- matrixStats::rowTabulates(x = mat, rows = 1:3, cols = 2, values = c(0, 1)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowVarDiffs works ", { matrixStats_formals <- formals(matrixStats::rowVarDiffs) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowVarDiffs) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowVarDiffs(x = mat) ms_res_def_1 <- matrixStats::rowVarDiffs(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) ms_res_1 <- matrixStats::rowVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowVarDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) ms_res_2 <- matrixStats::rowVarDiffs(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, diff = 2, trim = 0.333333333333333) expect_equal(mg_res_2, ms_res_2) mg_res_3 <- rowVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) ms_res_3 <- matrixStats::rowVarDiffs(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, diff = 1, trim = 0.5) expect_equal(mg_res_3, ms_res_3) }) test_that("rowVars works ", { matrixStats_formals <- formals(matrixStats::rowVars) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowVars) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mg_res_def_1 <- rowVars(x = mat) ms_res_def_1 <- matrixStats::rowVars(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowVars(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = rowMeans2(mat, na.rm=TRUE), dim. = dim(mat)) ms_res_1 <- matrixStats::rowVars(x = mat, rows = NULL, cols = NULL, na.rm = TRUE, center = rowMeans2(mat, na.rm=TRUE), dim. = dim(mat)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowVars(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) ms_res_2 <- matrixStats::rowVars(x = mat, rows = 1:3, cols = 2, na.rm = FALSE, center = NULL, dim. = c(12L, 8L)) expect_equal(mg_res_2, ms_res_2) }) test_that("rowWeightedMads works ", { matrixStats_formals <- formals(matrixStats::rowWeightedMads) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowWeightedMads) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(mat, dim(t(mat))) mg_res_def_1 <- rowWeightedMads(x = mat) ms_res_def_1 <- matrixStats::rowWeightedMads(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowWeightedMads(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE, constant = 1.4826, center = rowMeans2(mat, na.rm=TRUE)) ms_res_1 <- matrixStats::rowWeightedMads(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE, constant = 1.4826, center = rowMeans2(mat, na.rm=TRUE)) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowWeightedMads(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE, constant = 5, center = rep(6, nrow(mat))) ms_res_2 <- matrixStats::rowWeightedMads(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE, constant = 5, center = rep(6, nrow(mat))) expect_equal(mg_res_2, ms_res_2) }) test_that("rowWeightedMeans works ", { matrixStats_formals <- formals(matrixStats::rowWeightedMeans) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowWeightedMeans) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(mat, dim(t(mat))) mg_res_def_1 <- rowWeightedMeans(x = mat) ms_res_def_1 <- matrixStats::rowWeightedMeans(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowWeightedMeans(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::rowWeightedMeans(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowWeightedMeans(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::rowWeightedMeans(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowWeightedMedians works ", { matrixStats_formals <- formals(matrixStats::rowWeightedMedians) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowWeightedMedians) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(mat, dim(t(mat))) mg_res_def_1 <- rowWeightedMedians(x = mat) ms_res_def_1 <- matrixStats::rowWeightedMedians(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowWeightedMedians(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::rowWeightedMedians(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowWeightedMedians(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::rowWeightedMedians(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowWeightedSds works ", { matrixStats_formals <- formals(matrixStats::rowWeightedSds) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowWeightedSds) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(mat, dim(t(mat))) mg_res_def_1 <- rowWeightedSds(x = mat) ms_res_def_1 <- matrixStats::rowWeightedSds(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowWeightedSds(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::rowWeightedSds(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowWeightedSds(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::rowWeightedSds(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) }) test_that("rowWeightedVars works ", { matrixStats_formals <- formals(matrixStats::rowWeightedVars) MatrixGenerics_default_method_formals <- formals(MatrixGenerics:::.matrixStats_rowWeightedVars) expect_identical(matrixStats_formals, MatrixGenerics_default_method_formals) mat <- array(mat, dim(t(mat))) mg_res_def_1 <- rowWeightedVars(x = mat) ms_res_def_1 <- matrixStats::rowWeightedVars(x = mat) expect_equal(mg_res_def_1, ms_res_def_1) mg_res_1 <- rowWeightedVars(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) ms_res_1 <- matrixStats::rowWeightedVars(x = mat, w = 1:16, rows = NULL, cols = NULL, na.rm = TRUE) expect_equal(mg_res_1, ms_res_1) mg_res_2 <- rowWeightedVars(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) ms_res_2 <- matrixStats::rowWeightedVars(x = mat, w = NULL, rows = 1:3, cols = 2, na.rm = FALSE) expect_equal(mg_res_2, ms_res_2) })