P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 17:01:57 +02:00
Code Releases Activity

(v1.4.0.9041) updates based on review

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-12-17 16:22:25 +01:00
parent 1faa816090
commit 81af41da3a
74 changed files with 710 additions and 627 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
R/aa_helper_pm_functions.R
View File

@ -388,29 +388,29 @@ pm_group_size <- function(x) {
pm_n_groups <- function(x) {
nrow(pm_group_data(x))
}
pm_group_split <- function(.data, ..., .keep = TRUE) {
dots_len <- ...length() > 0L
if (pm_has_groups(.data) && isTRUE(dots_len)) {
warning("... is ignored in pm_group_split(<grouped_df>), please use pm_group_by(..., .add = TRUE) %pm>% pm_group_split()")
}
if (!pm_has_groups(.data) && isTRUE(dots_len)) {
.data <- pm_group_by(.data, ...)
}
if (!pm_has_groups(.data) && isFALSE(dots_len)) {
return(list(.data))
}
pm_context$setup(.data)
on.exit(pm_context$clean(), add = TRUE)
pm_groups <- pm_get_groups(.data)
attr(pm_context$.data, "pm_groups") <- NULL
res <- pm_split_into_groups(pm_context$.data, pm_groups)
names(res) <- NULL
if (isFALSE(.keep)) {
res <- lapply(res, function(x) x[, !colnames(x) %in% pm_groups])
}
any_empty <- unlist(lapply(res, function(x) !(nrow(x) == 0L)))
res[any_empty]
}
# pm_group_split <- function(.data, ..., .keep = TRUE) {
# dots_len <- ...length() > 0L
# if (pm_has_groups(.data) && isTRUE(dots_len)) {
# warning("... is ignored in pm_group_split(<grouped_df>), please use pm_group_by(..., .add = TRUE) %pm>% pm_group_split()")
# }
# if (!pm_has_groups(.data) && isTRUE(dots_len)) {
# .data <- pm_group_by(.data, ...)
# }
# if (!pm_has_groups(.data) && isFALSE(dots_len)) {
# return(list(.data))
# }
# pm_context$setup(.data)
# on.exit(pm_context$clean(), add = TRUE)
# pm_groups <- pm_get_groups(.data)
# attr(pm_context$.data, "pm_groups") <- NULL
# res <- pm_split_into_groups(pm_context$.data, pm_groups)
# names(res) <- NULL
# if (isFALSE(.keep)) {
# res <- lapply(res, function(x) x[, !colnames(x) %in% pm_groups])
# }
# any_empty <- unlist(lapply(res, function(x) !(nrow(x) == 0L)))
# res[any_empty]
# }
pm_group_keys <- function(.data) {
pm_groups <- pm_get_groups(.data)