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
|
string_starts_with <- function(pattern, x) {
pattern <- paste0("^\\Q", pattern, "\\E")
grep(pattern, x, perl = TRUE)
}
string_contains <- function(pattern, x) {
pattern <- paste0("\\Q", pattern, "\\E")
grep(pattern, x, perl = TRUE)
}
string_ends_with <- function(pattern, x) {
pattern <- paste0("\\Q", pattern, "\\E$")
grep(pattern, x, perl = TRUE)
}
#' @importFrom purrr map
string_one_of <- function(pattern, x) {
m <- unlist(purrr::map(pattern, ~ grep(., x, fixed = TRUE, useBytes = TRUE)))
x[m]
}
rownames_as_column <- function(x, var = "rowname", rownames = NULL) {
if (is.null(rownames)) {
rn <- rownames(x)
} else {
rn <- rownames
}
rn <- data.frame(rn = rn, stringsAsFactors = FALSE)
x <- cbind(rn, x)
colnames(x)[1] <- var
rownames(x) <- NULL
x
}
obj_has_name <- function(x, name) {
name %in% names(x)
}
obj_has_rownames <- function(x) {
!identical(as.character(1:nrow(x)), rownames(x))
}
#' @importFrom stats reshape
#' @keywords internal
.gather <- function(x, names_to = "key", values_to = "value", columns = colnames(x)) {
if (is.numeric(columns)) columns <- colnames(x)[columns]
dat <- stats::reshape(
x,
idvar = "id",
ids = row.names(x),
times = columns,
timevar = names_to,
v.names = values_to,
varying = list(columns),
direction = "long"
)
if (is.factor(dat[[values_to]]))
dat[[values_to]] <- as.character(dat[[values_to]])
dat[, 1:(ncol(dat) - 1), drop = FALSE]
}
|
