-
Notifications
You must be signed in to change notification settings - Fork 1
/
star_schema_as_multistar.R
74 lines (65 loc) · 1.95 KB
/
star_schema_as_multistar.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
#' Export a star schema as a `multistar`
#'
#' Once we have refined the format or content of facts and dimensions, we can
#' obtain a `multistar`. A `multistar` only distinguishes between general and
#' conformed dimensions, each dimension has its own data. It can contain
#' multiple fact tables.
#'
#' @param st A `star_schema` object.
#'
#' @return A `multistar` object.
#'
#' @family results export functions
#'
#' @examples
#'
#' ms <- st_mrs_age |>
#' star_schema_as_multistar()
#'
#' @export
star_schema_as_multistar <- function(st) {
UseMethod("star_schema_as_multistar")
}
#' @rdname star_schema_as_multistar
#' @export
star_schema_as_multistar.star_schema <- function(st) {
star_schema_as_mst(st)
}
# Star schema as multistar export (common) --------------------------------
#' Star schema as `multistar` export (common)
#'
#' @param st A `star_schema` object.
#' @param fl A list of `fact_table` objects.
#' @param dl A list of `dimension_table` objects.
#' @param commondim A list of dimension names already included.
#'
#' @return A `multistar` object.
#' @keywords internal
star_schema_as_mst <- function(st,
fl = NULL,
dl = NULL,
commondim = NULL) {
UseMethod("star_schema_as_mst")
}
#' @rdname star_schema_as_mst
#' @export
#' @keywords internal
star_schema_as_mst.star_schema <- function(st,
fl = NULL,
dl = NULL,
commondim = NULL) {
fl_names <- names(fl)
fl <- c(fl, list(st$fact[[1]]))
names(fl) <- c(fl_names, attr(st$fact[[1]], "name"))
dim <- get_all_dimensions(st)
dl_names <- names(dl)
for (d in seq_along(dim)) {
name_dim <- attr(dim[[d]], "name")
if (!(name_dim %in% commondim)) {
dl <- c(dl, list(dim[[d]]))
dl_names <- c(dl_names, name_dim)
}
}
names(dl) <- dl_names
new_multistar(fl, dl)
}