allow recodes in sc_table_custom()

first attempt to resolve #33. Recodes
can now be defined with an additional
parameter. However, type-checking is
very minimal.

TODO:
- better error handling when the
  request is constructed. This way
  users get quick and useful error
  messages - at least for semantic
  errors such as invalid usage of
  parameters
- with this implementation, users will
  have to make sure that the parameters
  "recodes" and "dimensions" are
  consistent. Maybe simplify the usage
- The naming sc_recode is almost
  conflicting with the class
  sc_recoder. Possibly rename this
  function
- extend the custom tables article to
  showcase some usecases for recodes
  and add a short discussion about
  usage limits
- maybe add sc_filter which only allows
  filter-type recodes and performs
  stricter type-checks?

NAMESPACE

@@ -57,6 +57,7 @@ export(sc_last_error_parsed)
 export(sc_rate_limit_schema)
 export(sc_rate_limit_table)
 export(sc_rate_limits)
+export(sc_recode)
 export(sc_schema)
 export(sc_schema_catalogue)
 export(sc_schema_db)

R/table_custom.R

@@ -6,13 +6,24 @@
 #' See the [Custom tables article](https://statistikat.github.io/STATcubeR/articles/sc_table_custom.html)
 #' for more details.
 #'
-#' @param db The uid of a database
+#' @param db The uid of a database. Must be of type `DATASET`
 #' @param measures A character vector of uids for measures. Each entry must be
 #' of type `MEASURE`, `STAT_FUNCTION` or `COUNT`.
 #' @param dimensions A character vector of dimensions for the cube. Can be
 #' either of type `FIELD` or type `VALUESET`. Those entries are referred to
 #' as `fields` in the parsed API response
+#' @param add_totals Should totals be added for each classification field in
+#' the json request? Ignored if `recodes` is used.
+#' @param recodes One or more recodes that were generated via [sc_recode()].
+#' If more than one recode is supplied, recodes should be concatinated with
+#' [c()].
+#' @param language The language to be used for labeling. "en"
+#' (the default) will use english. "de" uses german.
 #' @inheritParams sc_table
+#' @section Schema objects in parameters:
+#' it is possible to pass `sc_schema` objects (usually generated by
+#' [sc_schema_db()]) instead of ids in [sc_table_custom()] and [sc_recode()].
+#' If provided, the schema objects will be converted into ids via `$id`.
 #' @examples
 #' sc_table_custom("str:database:detouextregsai")
 #'
@@ -32,12 +43,80 @@
 #' "str:valueset:detouextregsai:F-DATA1:C-C93-2:C-C93SUM-0"
 #' )
 #' )
+#'
+#' schema <- sc_schema_db("detouextregsai")
+#' region <- schema$`Other Classifications`$`Tourism commune [ABO]`$
+#' `Regionale Gliederung (Ebene +1)`
+#' month <- schema$`Mandatory fields`$`Season/Tourism Month`
+#'
+#' x <- sc_table_custom(
+#' schema,
+#' schema$Facts$Arrivals,
+#' list(month, region),
+#' recodes = c(
+#' sc_recode(region, total = FALSE, map = list(
+#' region$Achensee,
+#' list(region$Arlberg, region$`Ausseerland-Salzkammergut`)
+#' )),
+#' sc_recode(month, total = FALSE)
+#' )
+#' )
+#' x$tabulate()
 #' @export
-sc_table_custom <- function(db, measures = c(), dimensions = c(), language = c("en", "de"),
- add_totals = TRUE, key = NULL) {
- json_list <- list(database = db, measures = as.list(measures),
- dimensions = lapply(dimensions, list))
+sc_table_custom <- function(db, measures = c(), dimensions = c(),
+ language = c("en", "de"),
+ add_totals = TRUE, key = NULL, recodes = NULL) {
+ json_list <- list(database = as_id(db), measures = as.list(as_id(measures, TRUE)),
+ dimensions = lapply(as_id(dimensions, TRUE), list))
+ if (!is.null(recodes)) {
+ json_list$recodes <- recodes
+ add_totals <- FALSE
+ }
+ #return(jsonlite::toJSON(json_list, auto_unbox = TRUE, pretty = TRUE))
  json <- jsonlite::toJSON(json_list, auto_unbox = TRUE, pretty = TRUE)
+ #return(json)
  response <- sc_table_json_post(json, language, add_totals, key)
  sc_table_class$new(response, toString(json))
 }
+
+#' @describeIn sc_table_custom creates a recode object which can be used
+#' for the `recode` parameter of [sc_table_custom()]
+#' @param field An uid of a classification field to be recoded. The provided
+#' uid should also be passed in the `dimensions` parameter of
+#' [sc_table_custom()].
+#' @param map A list of ids for values (type `VALUE`) This can also be a nested
+#' list if items should be grouped. See examples
+#' @param total Add totals to the field? If `map` is provided, the totals
+#' will correspond to the filtered data.
+#' @export
+sc_recode <- function(field, map = NULL, total = FALSE) {
+ if (is.null(map))
+ return(stats::setNames(list(list(total = total)), as_id(field)))
+ if (inherits(map, "sc_schema"))
+ map <- list(map)
+ stats::setNames(
+ list(list(
+ map = lapply(map, function(value) {
+ I(as_id(value, TRUE))
+ }),
+ total = total
+ )),
+ as_id(field)
+ )
+}
+
+as_id <- function(x, multiple = FALSE) {
+ if (length(x) == 0)
+ return(c())
+ if (inherits(x, "sc_schema"))
+ return(x$id)
+ if (is.character(x) && length(x) == 1)
+ return(x)
+ if (!multiple)
+ stop("invalid id")
+ if (is.character(x))
+ return(x)
+ if (is.list(x))
+ return(sapply(x, as_id))
+ stop("invalid ids")
+}