/
add_level.R
111 lines (79 loc) · 2.85 KB
/
add_level.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
#' @importFrom rlang quos get_expr quo_text enquo
#'
#' @rdname fabricate
#' @export
add_level <- function(N = NULL, ..., nest = TRUE) {
fun <- if(nest && can_nest(...)) nest_level_internal else add_top_level_internal
do_internal(enquo(N), ..., FUN=fun, from="add_level")
}
can_nest <- function(...){
pred <- function(N, ID_label, workspace, data_arguments)
is.character(attr(workspace, "active_df"))
do_internal(N=NULL, ..., FUN=pred)
}
#' @importFrom rlang eval_tidy
add_top_level_internal <- function(N = NULL, ID_label = NULL,
workspace = NULL,
data_arguments = NULL) {
# check_add_level_args(data_arguments, ID_label)
# Check to make sure the N here is sane
N <- handle_n(N, add_level = TRUE, workspace)
# If the user already has a working data frame, we need to shelf it before
# we move on.
working_data_list <- list()
# Staple in an ID column onto the data list.
# It's actually not possible the working data frame already has an ID label
# since we forcibly shelved it earlier -- so let's just plough along.
# First, add the column to the working data frame
working_data_list[[ID_label]] <- generate_id_pad(N)
# check_variables_named(data_arguments)
# Loop through each of the variable generating arguments
for (i in seq_along(data_arguments)) {
nm <- names(data_arguments)[i]
# Explicity mask N
dm <- as_data_mask(working_data_list)
dm$N <- N
# Evaluate the formula in an environment consisting of:
# 1) The current working data list
# 2) A list that tells everyone what N means in this context.
tmp <- expand_or_error(eval_tidy(
data_arguments[[i]],
dm
), N, i, data_arguments[[i]])
if(names(data_arguments)[i] != "") {
working_data_list[[nm]] <- tmp
} else {
for(j in seq_along(tmp)) {
working_data_list[[names(tmp)[j]]] <- tmp[[j]]
}
}
# Nuke the current data argument -- if we have the same variable name
# created twice, this is OK, because it'll only nuke the current one.
# data_arguments[[i]] <- NULL
}
# Before handing back data, ensure it's actually rectangular
working_data_list <- check_rectangular(working_data_list, N)
# Coerce our working data list into a working data frame
workspace[[ID_label]] <- data.frame(
working_data_list,
stringsAsFactors = FALSE,
row.names = NULL
)
attr(workspace, "active_df") <- ID_label
workspace
}
check_add_level_args <- function(data_arguments, ID_label) {
if(any(names(data_arguments) == "")) {
stop("All variables inside an add_level call must be named.")
}
if(is.null(ID_label) || is.na(ID_label)) {
stop("Please specify a name for the level call you are creating.")
}
}
# make_list <- function(x, nm) {
# if(!is.list(x)){
# x <- list(x)
# names(x) <- nm
# }
# x
# }