/
delete.R
69 lines (59 loc) · 1.49 KB
/
delete.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
#' Delete Container Elements Safely
#'
#' Search and remove elements from an object. If the element is not found,
#' an error is signaled.
#' @param .x any `R` object.
#' @param ... elements to be deleted.
#' @export
delete <- function(.x, ...) UseMethod("delete")
#' @rdname delete
#' @export
ref_delete <- function(.x, ...) UseMethod("ref_delete")
#' @rdname delete
#' @return For `Container`, an object of class `Container` (or one of the
#' respective derived classes).
#' @examples
#'
#' s = setnew("a", 1:3, iris)
#' print(s)
#' delete(s, 1:3, "a")
#' delete(s, iris)
#' try({
#' delete(s, "b") # "b" is not in Set
#' })
#' @export
delete.Container <- function(.x, ...)
{
(ref_delete(.x$clone(deep = TRUE), ...))
}
#' @name ContainerS3
#' @rdname ContainerS3
#' @details
#' * `delete(.x, ...)` and `ref_delete(.x, ...)` find and remove elements.
#' If one or more elements don't exist, an error is signaled.
#' @examples
#'
#' co = container("a", 1:3, iris)
#' print(co)
#' delete(co, 1:3, "a")
#' delete(co, iris)
#' try({
#' delete(co, "b") # "b" is not in Container
#' })
NULL
#' @rdname delete
#' @export
ref_delete.Container <- function(.x, ...)
{
elems = list(...)
if (!length(elems))
return(.x)
hasElements = sapply(elems, function(e) .x$has(e))
if (any(!hasElements)) {
# Throw error by trying to delete first missing element
element = elems[!hasElements][[1]]
.x$delete(element)
}
lapply(elems, function(e) .x$delete(e))
invisible(.x)
}