-
Notifications
You must be signed in to change notification settings - Fork 1
/
table_custom.R
122 lines (120 loc) · 4.37 KB
/
table_custom.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#' Create custom tables
#'
#' Define requests against the /table endpoint by providing
#' URIs to databases, measures and fields.
#' The URIs can be obtained using [sc_schema_db()].
#' 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. 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")
#'
#' sc_table_custom(
#' "str:database:detouextregsai",
#' dimensions = "str:field:detouextregsai:F-DATA1:C-SDB_TIT-0"
#' )
#'
#' sc_table_custom(
#' db = "str:database:detouextregsai",
#' measures = c(
#' "str:statfn:detouextregsai:F-DATA1:F-ANK:SUM",
#' "str:measure:detouextregsai:F-DATA1:F-UEB"
#' ),
#' dimensions = c(
#' "str:field:detouextregsai:F-DATA1:C-SDB_TIT-0",
#' "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, 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")
}