/
tools.R
103 lines (89 loc) · 2.47 KB
/
tools.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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#' Highlight some rows in a data frame
#'
#' Highlight some rows in a data frame
#'
#' Uses [print.colorDF()] to highlight selected rows in a data frame.
#'
#' @param x data frame like object
#' @param sel logical vector of length equal to number of rows in the data frame.
#' @examples
#' highlight(mtcars, mtcars$cyl == 6)
#' @export
highlight <- function(x, sel) {
print.colorDF(x, highlight=sel)
}
#' Strip the colorDF class and style
#'
#' Strip the colorDF class and style
#' @param x colorful data frame
#' @return the original data frame like object
uncolor <- function(x) {
attr(x, ".style") <- NULL
attr(x, ".coltp") <- NULL
class(x) <- setdiff(class(x), "colorDF")
return(x)
}
#' Test whether an object has the class of colorDF
#'
#' Test whether an object has the class of colorDF
#' @param x a data frame like object
#' @return TRUE if the object is of colorDF class
#' @export
is.colorDF <- function(x) {
return("colorDF" %in% class(x))
}
#' Search and highlight occurences of a pattern
#'
#' Search and highlight occurences of a pattern in a data frame
#'
#' df_search is for highlighting cells matching a specific pattern.
#' @param x a data frame
#' @param pattern a pattern; if NULL, the search results will be removed
#' @param cols which columns to search for (if NULL, all columns will be searched)
#' @return a color data frame object with the search pattern set for the given columns (or reset, if the pattern was NULL)
#' @examples
#' options(colorDF_tibble_style=TRUE)
#' if(require(dplyr)) {
#'
#' # Search for "blue" in any column
#' starwars %>% df_search("blue")
#'
#' # Search in a specific column
#' starwars %>% df_search("(Human|Wookie)", "species")
#'
#' # save the search pattern in a new object
#' saved <- starwars %>% df_search("blue")
#'
#' # remove the search patterns
#' saved <- df_search(saved)
#' }
#' @export
df_search <- function(x, pattern=NULL, cols=NULL) {
if(!is.colorDF(x)) {
x <- as.colorDF(x)
}
if(is.null(cn <- colnames(x))) {
cn <- paste0("X.", 1:length(x))
}
if(!is.null(cols)) {
if(is.numeric(cols)) {
cols <- paste0("X.", cols)
}
sel <- cn %in% cols
} else {
sel <- TRUE
}
cty <- "match"
cn <- cn[sel]
## if pattern is NULL, remove matches
if(is.null(pattern)) {
ctypes <- col_type(x)
cn <- names(ctypes)[ unlist(ctypes) == "match" ]
cty <- NULL
}
for(i in cn) {
col_type(x, i) <- cty
}
df_style(x)$type.styles$match$pattern <- pattern
return(x)
}