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
|
#============== Name setting functions ==============#
# set the names attribute of res depending on useNames. If `useNames = NA`, use the value from `default`.
# This method is specifically designed for the colXXX methods were the main argument is
# usually called `x`. Instead of explicitly passing this information, I use a bit of reflection
# to get the colnames of x
set_result_names <- function(res, useNames, default = FALSE, names = colnames(parent.frame()$x)){
if(is.na(useNames)){
useNames <- default
}
if (useNames) {
if (!is.null(names)) {
# Zero-length attribute? Keep behavior same as base R function
if (length(names) == 0L) names <- NULL
names(res) <- names
}
} else {
names(res) <- NULL
}
res
}
# same as `set_result_names()` but set the rownames of res
set_result_rownames <- function(res, useNames, default = FALSE, names = colnames(parent.frame()$x)){
if(is.na(useNames)){
useNames <- default
}
if (useNames) {
if (!is.null(names)) {
# Zero-length attribute? Keep behavior same as base R function
if (length(names) == 0L) names <- NULL
rownames(res) <- names
}
} else {
rownames(res) <- NULL
}
res
}
# same as `set_result_names()` but set the colnames of res
set_result_colnames <- function(res, useNames, default = FALSE, names = colnames(parent.frame()$x)){
if(is.na(useNames)){
useNames <- default
}
if (useNames) {
if (!is.null(names)) {
# Zero-length attribute? Keep behavior same as base R function
if (length(names) == 0L) names <- NULL
colnames(res) <- names
}
} else {
colnames(res) <- NULL
}
res
}
# same as `set_result_names()` but use names = rownames(x) as default
set_result_names_t <- function(res, useNames, default = FALSE, names = rownames(parent.frame()$x)){
if(is.na(useNames)){
useNames <- default
}
if (useNames) {
if (!is.null(names)) {
# Zero-length attribute? Keep behavior same as base R function
if (length(names) == 0L) names <- NULL
names(res) <- names
}
} else {
names(res) <- NULL
}
res
}
|
