P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 23:41:55 +02:00
Code Releases Activity

(v2.1.1.9095) Python support

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2024-10-15 17:12:55 +02:00
parent 94501371cd
commit 5c4d8fcd2a
18 changed files with 513 additions and 435 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
R/aa_helper_functions.R
View File

@ -822,7 +822,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
is_positive = NULL,
is_positive_or_zero = NULL,
is_finite = NULL,
contains_column_class = NULL,
allow_NULL = FALSE,
allow_NA = FALSE,
ignore.case = FALSE,
@ -851,6 +850,11 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
stop_if(allow_NA == FALSE, "argument `", obj_name, "` must not be NA", call = call_depth)
return(invisible())
}
if (identical(class(object), "list") && !"list" %in% allow_class) {
# coming from Python, possibly - turn lists (not data.frame) to the underlying data type
object <- unlist(object)
}
if (!is.null(allow_class) && !(suppressWarnings(all(is.na(object))) && allow_NA == TRUE)) {
stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
@ -937,21 +941,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
call = call_depth
)
}
if (!is.null(contains_column_class)) {
stop_ifnot(
any(vapply(
FUN.VALUE = logical(1),
object,
function(col, columns_class = contains_column_class) {
inherits(col, columns_class)
}
), na.rm = TRUE),
"the data provided in argument `", obj_name,
"` must contain at least one column of class '", contains_column_class[1L], "'. ",
"See `?as.", contains_column_class[1L], "`.",
call = call_depth
)
}
if (!is.null(allow_arguments_from) && !is.null(names(object))) {
args_given <- names(object)
if (is.function(allow_arguments_from)) {
@ -973,6 +962,20 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
return(invisible())
}
ascertain_sir_classes <- function(x, obj_name) {
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
if (!any(sirs, na.rm = TRUE)) {
warning_("the data provided in argument `", obj_name,
"` should contain at least one column of class 'sir'. Eligible SIR column were now guessed. ",
"See `?as.sir`.")
sirs_eligible <- is_sir_eligible(x)
for (col in colnames(x)[sirs_eligible]) {
x[[col]] <- as.sir(x[[col]])
}
}
x
}
get_current_data <- function(arg_name, call) {
valid_df <- function(x) {
!is.null(x) && is.data.frame(x)