/
define_theme.R
133 lines (123 loc) · 5.2 KB
/
define_theme.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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
#' @title Provides a simple wrapper for themes
#'
#' @description
#' `r lifecycle::badge("experimental")`
#' This function collects several lists if they are present. If absent, reasonable defaults are used.
#' When strata are not defined in the theme, they default to grey50 and will not be presented in the legend.
#' @param strata named list containing the different strata and name:colour value pairs
#' @param fontsizes named list containing the font sizes for different options
#' @param fontfamily string with the name of a supported font
#' @param grid boolean that specifies whether the major and minor grid should be drawn. The drawing of major and minor
#' gridlines can be manipulated separately by using a boolean indicator in a named `list` with elements `major`
#' and `minor`.
#' @param bg string defining the colour for the background of the plot
#' @param legend_position string defining the legend position. Valid options are NULL, 'top' 'bottom' 'right' 'left'
#'
#' @return Nested list with styling preferences for a ggplot object
#'
#' @examples
#'
#' theme <- visR::define_theme(
#' strata = list("SEX" = list(
#' "F" = "red",
#' "M" = "blue"
#' )),
#' fontsizes = list(
#' "axis" = 12,
#' "ticks" = 10,
#' "legend_title" = 10,
#' "legend_text" = 8
#' ),
#' fontfamily = "Helvetica",
#' grid = list(
#' "major" = FALSE,
#' "minor" = FALSE
#' ),
#' bg = "transparent",
#' legend_position = "top"
#' )
#'
#' @export
define_theme <- function(strata = NULL,
fontsizes = NULL,
fontfamily = "Helvetica",
grid = FALSE,
bg = "transparent",
legend_position = NULL) {
theme <- list()
if (!base::is.null(strata)) {
if (base::is.list(strata)) {
if (base::length(base::names(strata)) > 0) {
theme[["strata"]] <- strata
} else {
base::warning("Invalid argument for `strata`. Please provide a named list as described in the documentation. Setting strata to `NULL` (which results in no specific theming for stratification).")
theme[["strata"]] <- NULL
}
}
}
if (!base::is.null(fontsizes)) {
if (base::is.list(fontsizes)) {
if (base::length(base::names(fontsizes)) > 0) {
theme[["fontsizes"]] <- fontsizes
} else {
base::warning("Invalid argument for `fontsizes`. Please provide a named list for the individual plot elements as described in the documentation. Setting fontsizes to `NULL`.")
theme[["fontsizes"]] <- NULL
}
} else if (base::is.numeric(fontsizes)) {
base::message("Setting all fontsizes to the provided numeric value. It is recommended to use a named list as described in the documentation.")
theme[["fontsizes"]] <- fontsizes
} else {
base::warning("Invalid argument for `fontsizes`. Please provide a named list as described in the documentation. Setting fontsizes to `NULL`.")
theme[["fontsizes"]] <- NULL
}
}
if (!base::is.character(fontfamily)) {
base::warning("Invalid argument for `fontfamily`. Please provide the name of a valid font family as a string. Setting to default `Helvetica`.")
theme[["fontfamily"]] <- "Helvetica"
} else if (base::is.character(fontfamily) & (base::length(fontfamily) > 1)) {
base::warning(paste0("Invalid amount of arguments for `fontfamily`. Using the first one: ", fontfamily[[1]]))
theme[["fontfamily"]] <- fontfamily[[1]]
} else if (base::is.character(fontfamily) &
(base::length(fontfamily) == 1) &
(base::nchar(fontfamily) == 0)) {
base::warning("Invalid argument for `fontfamily`. Please provide the name of a valid font family as a string. Setting to default `Helvetica`.")
theme[["fontfamily"]] <- "Helvetica"
} else {
theme[["fontfamily"]] <- fontfamily
}
if (base::is.logical(grid)) {
if (grid == TRUE) {
theme[["grid"]] <- list(
"major" = TRUE,
"minor" = FALSE
)
} else {
theme[["grid"]] <- grid
}
} else if (is.list(grid)) {
if (("major" %in% names(grid)) | ("minor" %in% names(grid))) {
theme[["grid"]] <- grid
} else {
base::warning("Invalid argument for `grid`. Please use a boolean or a list to indicate whether you want a background grid. Setting to default `FALSE`.")
theme[["grid"]] <- FALSE
}
} else {
base::warning("Invalid argument for `grid`. Please use a boolean or a list to indicate whether you want a background grid. Setting to default `FALSE`.")
theme[["grid"]] <- FALSE
}
if (!base::is.character(bg)) {
base::warning("Invalid argument for `bg`. Please provide the name of a valid colour as a string. Setting to default `transparent`.")
theme[["bg"]] <- "transparent"
} else {
theme[["bg"]] <- bg
}
if (base::is.null(legend_position) | isTRUE(legend_position %in% c("top", "right", "left", "bottom"))) {
theme[["legend_position"]] <- legend_position
} else {
base::warning("Invalid argument for `legend_position`. Setting it to default \"right\".")
theme[["legend_position"]] <- "right"
}
base::class(theme) <- c("visR_theme", class(theme))
return(theme)
}
# END OF CODE -------------------------------------------------------------