# R/weighted.R In Bioconductor-mirror/BioCor: Functional similarities

#### Documented in weighted.prodweighted.sum

```# weighted ####
#' Weighted operations
#'
#' Calculates the weighted sum or product of \code{x}. Each values should have
#' its weight, otherwise it will throw an error.
#'
#' This functions are thought to be used with \code{similarities}. As some
#' similarities might be positive and others negative the argument \code{abs}
#' is provided for \code{weighted.sum}, assuming that only one similarity will
#' be negative (usually the one comming from exprresion correlation).
#' @inheritParams stats::weighted.mean
#' @param x an object containing the values whose weighted operations is to be
#' computed
#' @param abs If any \code{x} is negative you want the result negative too?
#' @return \code{weighted.sum} returns the sum of the product of x*weights
#' removing all \code{NA} values. See parameter \code{abs} if there are any
#' negative values.
#' @aliases weighted
#' @rdname weighted
#' @name weighted
#' @aliases weighted
#' @author Lluís Revilla
#' @seealso
#' @export
#' @examples
#' expr <- c(-0.2, 0.3, 0.5, 0.8, 0.1)
#' weighted.sum(expr, c(0.5, 0.2, 0.1, 0.1, 0.1))
#' weighted.sum(expr, c(0.5, 0.2, 0.1, 0.2, 0.1), FALSE)
#' weighted.sum(expr, c(0.4, 0.2, 0.1, 0.2, 0.1))
#' weighted.sum(expr, c(0.4, 0.2, 0.1, 0.2, 0.1), FALSE)
#' weighted.sum(expr, c(0.4, 0.2, 0, 0.2, 0.1))
#' weighted.sum(expr, c(0.5, 0.2, 0, 0.2, 0.1))
weighted.sum <- function(x, w, abs = TRUE) {
if (length(x) != length(w)) {
stop("Weights and data don't match the length: ", length(x), " != ",
length(w))
}

if (!is.numeric(x) | !is.numeric(w)) {
stop("weights and x should be numeric")
}
if (!all(w >= 0L)) {
warning("There are negative weights, should they be positive?")
}
if (sum(w, na.rm = TRUE) > 1L) {
warning("The sum of the weights is above 1")
}
if (abs) {
if (any(sign(x[!is.na(x)]) < 0)) {
-sum(abs(x)*w, na.rm = TRUE)
} else {
sum(x*w, na.rm = TRUE)
}
} else {
sum(x*w, na.rm = TRUE)
}
}

#' @return \code{weighted.prod} returns the product of product of x*weights
#'  removing all \code{NA} values.
#' @rdname weighted
#' @export
#' @examples
#' # Compared to weighted.prod:
#' weighted.prod(expr, c(0.5, 0.2, 0.1, 0.1, 0.1))
#' weighted.prod(expr, c(0.4, 0.2, 0.1, 0.2, 0.1))
#' weighted.prod(expr, c(0.4, 0.2, 0, 0.2, 0.1))
#' weighted.prod(expr, c(0.5, 0.2, 0, 0.2, 0.1))
weighted.prod <- function(x, w) {
if (length(x) != length(w)) {
stop("Weights and data don't match the length: ", length(x), " != ",
length(w))
}

if (!is.numeric(x) | !is.numeric(w)) {
stop("weights and x should be numeric")
}

if (sum(w, na.rm = TRUE) > 1L) {
warning("The sum of the weights is above 1")
}

prod(x*w, na.rm = TRUE)
}
```
Bioconductor-mirror/BioCor documentation built on May 29, 2017, 12:07 a.m.