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
|
#' Convenience function to set slot values
#'
#' @aliases replaceSlots
#'
#' @description
#' Given the current object, the function `setSlots` will take name-value
#' pair inputs either as named arguments or a `list` and replace the values of
#' the specified slots. This is a convenient function for updating slots in
#' an S4 class object.
#'
#' @param object An S4 object with slots to replace
#'
#' @param ... Slot name and value pairs either as named arguments
#' or a named list, e.g., `slotName = value`.
#'
#' @param check logical(1L) Whether to run validObject after the slot
#' replacement
#'
#' @return The object input with updated slot data
#'
#' @importFrom methods slot<- validObject
#'
#' @author H. Pagès
#'
#' @examples
#'
#' setClass("A", representation = representation(slotA = "character"))
#'
#' aclass <- new("A", slotA = "A")
#'
#' setSlots(aclass, slotA = "B")
#'
#' @export
setSlots <- function (object, ..., check = TRUE)
{
if (!isTRUEorFALSE(check))
stop("'check' must be TRUE or FALSE")
object <- unsafe_replaceSlots(object, ...)
if (check)
validObject(object)
object
}
unsafe_replaceSlots <- function (object, ..., .slotList = list())
{
slots <- c(list(...), .slotList)
slots_names <- names(slots)
for (i in seq_along(slots)) {
slot_name <- slots_names[[i]]
if (identical(slot_name, "mcols"))
slot_name <- "elementMetadata"
slot_val <- slots[[i]]
slot(object, slot_name, check = FALSE) <- slot_val
}
object
}
|
