diff options
| -rw-r--r-- | pkg/NAMESPACE | 1 | ||||
| -rw-r--r-- | pkg/R/geomean.R | 38 | ||||
| -rw-r--r-- | pkg/man/geomean.Rd | 31 | ||||
| -rw-r--r-- | pkg/tests/testthat/test_geomean.R | 11 |
4 files changed, 81 insertions, 0 deletions
diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index dd140d0..86b85da 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -3,5 +3,6 @@ S3method(plot,TOXSWA_cwa) export(PEC_soil) export(TOXSWA_cwa) +export(geomean) export(read.TOXSWA_cwa) importFrom(R6,R6Class) diff --git a/pkg/R/geomean.R b/pkg/R/geomean.R new file mode 100644 index 0000000..626829b --- /dev/null +++ b/pkg/R/geomean.R @@ -0,0 +1,38 @@ +# Copyright (C) 2015 Johannes Ranke +# Contact: jranke@uni-bremen.de +# This file is part of the R package pfm + +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see <http://www.gnu.org/licenses/> + +#' Calculate the geometric mean +#' +#' Based on some posts in a thread on Stackoverflow +#' \url{http://stackoverflow.com/questions/2602583/geometric-mean-is-there-a-built-in} +#' This function checks for negative values, removes NA values per default and +#' returns 0 if at least one element of the vector is 0. +#' +#' @param x Vector of numbers +#' @param na.rm Should NA values be omitted? +#' @return The geometric mean +#' @export +#' @author Johannes Ranke +#' @examples +#' geomean(c(1, 3, 9)) +#' geomean(c(1, 3, NA, 9)) +#' \dontrun{geomean(c(1, -3, 9)) # returns an error} +geomean = function(x, na.rm = TRUE){ + if (any(is.na(x)) & na.rm == FALSE) stop("Removal of NA values was not requested") + if (any(x < 0, na.rm = na.rm)) stop("Only defined for positive numbers") + exp(mean(log(x), na.rm = na.rm)) +} diff --git a/pkg/man/geomean.Rd b/pkg/man/geomean.Rd new file mode 100644 index 0000000..42a30c4 --- /dev/null +++ b/pkg/man/geomean.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2 (4.1.0.9001): do not edit by hand +% Please edit documentation in R/geomean.R +\name{geomean} +\alias{geomean} +\title{Calculate the geometric mean} +\usage{ +geomean(x, na.rm = TRUE) +} +\arguments{ +\item{x}{Vector of numbers} + +\item{na.rm}{Should NA values be omitted?} +} +\value{ +The geometric mean +} +\description{ +Based on some posts in a thread on Stackoverflow +\url{http://stackoverflow.com/questions/2602583/geometric-mean-is-there-a-built-in} +This function checks for negative values, removes NA values per default and +returns 0 if at least one element of the vector is 0. +} +\examples{ +geomean(c(1, 3, 9)) +geomean(c(1, 3, NA, 9)) +\dontrun{geomean(c(1, -3, 9)) # returns an error} +} +\author{ +Johannes Ranke +} + diff --git a/pkg/tests/testthat/test_geomean.R b/pkg/tests/testthat/test_geomean.R new file mode 100644 index 0000000..0cc3416 --- /dev/null +++ b/pkg/tests/testthat/test_geomean.R @@ -0,0 +1,11 @@ +library(pfm) +context("Geometric mean calculation") + +test_that("The geometric mean is correctly calculated", { + expect_equal(geomean(c(1, 3, 9)), 3) + expect_equal(geomean(c(0, 3, 9)), 0) + expect_error(geomean(c(1, 3, NA, 9), na.rm = FALSE), "NA") + expect_equal(geomean(c(1, 3, NA, 9), na.rm = TRUE), 3) + expect_error(geomean(c(1, -3, 9)), "positive") + expect_error(geomean(c(1, -3, NA, 9)), "positive") +}) |