untracked: Allow user to specify more aggregation functions, include …

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipAPI
 Type: Package
 Title: Web APIs tools
-Version: 1.5.4
+Version: 1.5.5
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions to extract data and interact with web APIs.
@@ -33,6 +33,7 @@ Imports:
     odbc,
     RMySQL,
     RPostgres,
+    zeallot,
     zip
 Remotes: Displayr/flipTransformations,
     Tatvic/RGoogleAnalytics,

NAMESPACE

@@ -21,6 +21,7 @@ export(UpdateFactbaseRatioFormula)
 export(UploadMetricToFactbase)
 export(UploadRelationshipToFactbase)
 export(UploadTableToFactbase)
+import(zeallot)
 importFrom(DBI,dbConnect)
 importFrom(DBI,dbDisconnect)
 importFrom(DBI,dbGetQuery)
@@ -56,6 +57,7 @@ importFrom(openxlsx,write.xlsx)
 importFrom(readxl,read_excel)
 importFrom(rgeolocate,maxmind)
 importFrom(stats,setNames)
+importFrom(stringr,str_match)
 importFrom(tools,file_ext)
 importFrom(tools,file_path_as_absolute)
 importFrom(tools,file_path_sans_ext)

R/Factbase.R

@@ -23,7 +23,9 @@
 #'   be used.
 #' @param mode (optional) One of "replace_all", "append" or "append_or_update" See comments for
 #'   FactPostUpdateType.
-#' @param aggregation (optional) One of "none", "minimum", "maximum", "sum", "average", "first", "last".
+#' @param aggregation (optional) One of "none", "minimum", "maximum", "sum", "average", "first", "last",
+#'   "median", "percentile90", "percentile95", "countdistinct(<dimensionname>)" (where <dimensionname>
+#'   is one of the label dimensions in data).
 #' @param time_aggregation (optional) One of "minimum", "maximum", "sum", "average", "first", "last".
 #'   If supplied then this operation will be used when aggregating data in different periods,
 #'   and `aggregation` will only be used to aggregate data in different label dimensions.
@@ -49,14 +51,14 @@
 #'
 #' @importFrom RJSONIO toJSON
 #' @importFrom flipTime AsDateTime
+#' @import zeallot
 #' @export
 UploadMetricToFactbase <- function(data, token, name=NULL, mode="replace_all", aggregation="sum",
         time_aggregation=NULL, definition=NULL, hyperlink=NULL, owner=NULL,
         period_type=NULL, update_key=NULL,
         test=list()) {
     validate_dataframe(data, min_columns=1)
-    if (!(aggregation %in% c("none", "minimum", "maximum", "sum", "average", "first", "last")))
-        stop(paste("Unknown 'aggregation':", aggregation))
+    c(aggregation, distinct_by) %<-% validate_aggregation(aggregation, data)
     if (!is.null(time_aggregation) && !(time_aggregation %in% c("none", "minimum", "maximum", "sum", "average", "first", "last")))
         stop(paste("Unknown 'time_aggregation':", time_aggregation))
     if (!is.null(period_type) && !(period_type %in% c("day", "week", "month", "quarter", "year")))
@@ -110,13 +112,14 @@ UploadMetricToFactbase <- function(data, token, name=NULL, mode="replace_all", a
 
     observations <- dataframe_to_json_ready_observations(data)
 
-    # Make HTTP request
+    # Make HTTP request.  `metric` is a FactPostBody 
     metric <- list(
         name=metric_name,
         valueType="real",
         aggregation=aggregation,
         timeAggregation=time_aggregation
     )
+    metric$distinctBy <- distinct_by  # does nothing if distinct_by is NULL
     metric <- add_definition_etc(metric, definition, hyperlink, owner)
     body <- toJSON(list(
         metric=metric,
@@ -138,6 +141,21 @@ validate_dataframe <- function(df, min_columns) {
         stop("There must be at least", min_columns, "column(s) in 'data'")
 }
 
+#' @importFrom stringr str_match
+validate_aggregation <- function(aggregation, data) {
+    if (!is.character(aggregation) || length(aggregation) != 1)
+        stop("'aggregation' must be a character vector of length 1")
+    if (aggregation %in% c("none", "minimum", "maximum", "sum", "average", "first", "last", "median", "percentile90", "percentile95"))
+        return (list(aggregation = aggregation, distinct_by=NULL))
+    distinct_by <- str_match(aggregation, 'countdistinct\\(([^)]+)\\)')[1, 2]
+    if (is.character(distinct_by)) {
+        if (!(distinct_by %in% names(data)))
+            stop(paste0("Column '", distinct_by, "' is referred to in 'aggregation' but does not exist in 'data'"))
+        return (list(aggregation = 'count', distinct_by = distinct_by))
+    }
+    stop(paste("Unknown 'aggregation':", aggregation))
+}
+
 is_when_column <- function(column_name) {
     tolower(column_name) %in% c("_when", "when")  # `_when` retained for compatibility with old callers
 }

tests/testthat/test-factbase-api.R

@@ -372,3 +372,16 @@ test_that("truncate_too_large_data*() can truncate", {
     truncated <- truncate_too_large_data(df, 5)
     expect_equal(truncated, data.frame(dog=1:2, cat=2:3))
 })
+
+test_that("validate_aggregation() works in a simple case", {
+    c(aggregation, distinct_by) %<-% validate_aggregation('sum', data.frame())
+    expect_equal(aggregation, 'sum')
+    expect_null(distinct_by)
+})
+
+test_that("validate_aggregation() works with distinct_by", {
+    c(aggregation, distinct_by) %<-% validate_aggregation('countdistinct(bob)', data.frame(a=1, bob=2))
+    expect_equal(aggregation, 'count')
+    expect_equal(distinct_by, 'bob')
+})
+