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
|
##
set_selected <- function(x, pos = NULL, curve = NULL) {
if (!is.list(x))
stop("\n[set_selected] 'x' must be a list.", call. = FALSE)
if (is.list(curve))
if (length(pos) != length(curve))
stop("\n[set_selected] 'x' and 'curve' must be of same length.", call. = FALSE)
# Set everything to false
for (i in 1:length(x)) {
x[[i]]@info$selected <- FALSE
for (j in 1:length(x[[i]]@records))
x[[i]]@records[[j]]@info$selected <- FALSE
}
# Case 3: set selected curves
if (!is.null(pos)) {
for (i in 1:length(pos)) {
x[[pos[i]]]@info$selected <- TRUE
if (!is.null(curve)) {
for (j in curve[[i]]) {
if (is.na(j))
next
if (j == 0)
next
x[[pos[i]]]@records[[j]]@info$selected <- TRUE
}
} else {
for (j in 1:length(x[[pos[i]]]@records))
x[[pos[i]]]@records[[j]]@info$selected <- TRUE
}
}
}
return(x)
}
get_selected <- function(x) {
# selected aliquots
sel_al <- sapply(x, function(x) x@info$selected)
is_null <- which(sapply(sel_al, is.null))
if (length(is_null) != 0)
sel_al[is_null] <- FALSE
if (is.list(sel_al))
sel_al <- unlist(sel_al)
x <- x[sel_al]
# selected curves
for (i in 1:length(x)) {
is_selected <- sapply(x[[i]], function(y) y@info$selected)
x[[i]]@records <- x[[i]]@records[is_selected]
if (length(x[[i]]@records) == 0)
x[[i]] <- NULL
}
return(x)
}
|
