-
Notifications
You must be signed in to change notification settings - Fork 1
/
Helper.R
95 lines (80 loc) · 2.93 KB
/
Helper.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
#' @include Options.R
#' @title
#' Package Helpers
#'
#' @description
#' This class contains static helper methods.
#'
#' @format
#' \describe{
#' \item{\code{Helper$get_class_name(object)}}{Helper for getting the class of a given object.}
#' \item{\code{Helper$is_of_class(object, class)}}{Check if an object is of a certain class.}
#' \item{\code{Helper$get_option(option)}}{Get package option, or corresponding default value.}
#' \item{\code{Helper$set_option(option, value)}}{Set package option.}
#' \item{\code{Helper$check_object_type(object, expected_type)}}{Check the type of a given object.}
#' \item{\code{Helper$check_array_margins(margins, dimensions)}}{Helper to check array margins for the `Service$apply` operation.}
#' }
#'
#' @export
Helper <- R6::R6Class("Helper",
cloneable = FALSE
)
# Helper for getting the class of a given instance.
Helper$get_class_name <- function(object) {
return(class(object)[1])
}
# Helper to check if object is of certain class.
Helper$is_of_class <- function(object, class) {
return(class(object)[1] == class)
}
# Get package option, or corresponding default value.
Helper$get_option <- function(option) {
# Get the `Options` instance from the global options, or create a new one.
options <- getOption("parabar", default = Options$new())
# If the requested option is unknown.
if (!option %in% ls(options)) {
# Throw an error.
Exception$unknown_package_option(option)
}
# Return the value.
return(options[[option]])
}
# Set package option.
Helper$set_option <- function(option, value) {
# Get the `Options` instance from the global options, or create a new one.
options <- getOption("parabar", default = Options$new())
# If the requested option is unknown.
if (!option %in% ls(options)) {
# Throw an error.
Exception$unknown_package_option(option)
}
# Set the value.
options[[option]] <- value
# Set the `Options` instance in the global options.
options(parabar = options)
}
# Helper for performing a type check on a given object.
Helper$check_object_type <- function(object, expected_type) {
# Get object class name.
type <- Helper$get_class_name(object)
# If the object does not inherit from the expected type.
if (!inherits(object, expected_type)) {
# Throw incorrect type error.
Exception$type_not_assignable(type, expected_type)
}
}
# Helper for checking the array margins provided for the `apply` operation.
Helper$check_array_margins <- function(margins, dimensions) {
# Conditions to ensure the margins are valid.
violations <- c(
# Ensure all margins are unique.
duplicated(margins),
# Ensure all margins are within the array dimensions.
margins > length(dimensions)
)
# If any violations are found.
if (any(violations)) {
# Throw an error.
Exception$array_margins_not_compatible(margins, dimensions)
}
}