Generalize aggregate (#106)

Generalize aggregate

NAMESPACE

@@ -21,3 +21,4 @@ importFrom(stats,mad)
 importFrom(stats,median)
 importFrom(stats,sd)
 importFrom(stats,setNames)
+importFrom(utils,find)

R/aggregate.R

@@ -5,7 +5,7 @@
 #' @param population tbl with grouping (metadata) and observation variables.
 #' @param variables character vector specifying observation variables.
 #' @param strata character vector specifying grouping variables for aggregation.
-#' @param operation optional character string specifying method for aggregation. This must be one of the strings \code{"mean"}, \code{"median"}, \code{"mean+sd"}.
+#' @param operation optional character string specifying method for aggregation, e.g. \code{"mean"}, \code{"median"}, \code{"mean+sd"}.
 #' @param ... optional arguments passed to aggregation operation
 #'
 #' @return aggregated data of the same class as \code{population}.
@@ -21,25 +21,34 @@
 #' strata <- c("Metadata_group", "Metadata_batch")
 #' aggregate(population, variables, strata, operation = "mean")
 #'
+#' @importFrom utils find
 #' @importFrom magrittr %>%
 #' @importFrom magrittr %<>%
 #' @export
 aggregate <- function(population, variables, strata, operation="mean", ...) {
 
-  if (operation == "mean") {
-    aggregating_function <- dplyr::funs(mean)
-  } else if (operation == "median") {
-    aggregating_function <- dplyr::funs(median)
-  } else if (operation == "mean+sd") {
-    aggregating_function <- c(dplyr::funs(mean), dplyr::funs(sd))
-  } else {
+  # check whether `operation` is a function, or a sequence of functions
+  # separated by `+`
+  if (stringr::str_split(operation, "\\+")[[1]] %>%
+      purrr::map_lgl(function(f)
+        length(utils::find(f, mode = "function")) == 0) %>%
+      any()
+      ) {
     error <- paste0("undefined operation `", operation, "'")
 
     futile.logger::flog.error(msg = error)
 
     stop(error)
+
   }
 
+  # construct aggregation_function
+  aggregating_function <-
+    stringr::str_split(operation, "\\+")[[1]] %>%
+    sapply(function(f) dplyr::funs(!!f) ) %>%
+    as.vector() %>%
+    unname()
+
   population %>%
     dplyr::group_by_(.dots = strata) %>%
     dplyr::summarise_at(.funs = aggregating_function, .vars = variables) %>%

README.md

@@ -1,6 +1,4 @@
-
-<!-- README.md is generated from README.Rmd. Please edit that file -->
-[![Build Status](https://travis-ci.org/cytomining/cytominer.png?branch=master)](https://travis-ci.org/cytomining/cytominer) [![Coverage Status](https://img.shields.io/codecov/c/github/cytomining/cytominer/master.svg)](https://codecov.io/github/cytomining/cytominer?branch=master) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/cytominer)](http://cran.r-project.org/package=cytominer)
+[![Build Status](https://travis-ci.org/cytomining/cytominer.png?branch=master)](https://travis-ci.org/cytomining/cytominer) [![Coverage Status](https://img.shields.io/codecov/c/github/cytomining/cytominer/master.svg)](https://codecov.io/github/cytomining/cytominer?branch=master) [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/cytominer)](https://cran.r-project.org/package=cytominer)
 
 cytominer
 =========