-
Notifications
You must be signed in to change notification settings - Fork 1
/
table_as_data_frame.R
76 lines (71 loc) · 2.08 KB
/
table_as_data_frame.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
unlist_n <- function(x, times) {
if (times <= 0)
return(x)
x <- unlist(x, recursive = FALSE)
if (times == 1)
return(x)
unlist_n(x, times - 1)
}
get_annotations <- function(content, i = 1) {
cube <- content$cubes[[i]]$annotations
if (is.null(cube)) {
n_values <- content$cubes[[i]]$values %>% unlist() %>% length()
return(rep(list(NULL), n_values))
}
dims <- content$fields %>%
lapply(function(x) x$items) %>%
sapply(length)
unlist_n(cube, length(dims) - 1) %>%
sapply(unlist)
}
sc_model_matrix <- function(dims) {
times <- 1
each <- prod(dims)
out <- list()
for (i in seq_along(dims)) {
each <- each / dims[i]
out[[paste0("FIELD_", i)]] <- seq_len(dims[i]) %>%
rep(times = times, each = each)
times <- times * dims[i]
}
vctrs::new_data_frame(out)
}
sc_table_create_data <- function(content) {
dims_fields <- content$fields %>%
lapply(function(x) x$items) %>%
sapply(length)
df <- sc_model_matrix(dims_fields)
# labeling of fields
for (i in seq_along(content$fields)) {
field <- content$fields[[i]]
codes <- sc_field_codes(field, split_minus = FALSE)
df[[i]] <- factor(df[[i]], labels = codes)
names(df)[i] <- get_var_code(field$uri)
}
# add measures
for (i in seq_along(content$measures)) {
measure <- content$measures[[i]]
label <- get_var_code(measure$measure)
values <- unlist(content$cubes[[i]]$values)
annotations <- get_annotations(content, i)
df[[label]] <- values
attr(df[[label]], "annotations") <- annotations
}
df
}
#' @export
as.data.frame.sc_data <- function(x, ...) {
od_label_data(x, ...)
}
sc_table_modify_totals <- function(data, meta, meta_fields) {
ind <- which(meta$fields$type != "Category")
for (i in ind) {
mf <- meta_fields[[i]]
ind_total <- which(mf$code == "SC_TOTAL")
ind_latest <- which(mf$parsed == max(mf$parsed, na.rm = TRUE))
numeric_columns <- seq(length(meta_fields) + 1, ncol(data))
data[as.numeric(data[[i]]) == ind_total, numeric_columns] <-
data[as.numeric(data[[i]]) == ind_latest, numeric_columns]
}
data
}