-
Notifications
You must be signed in to change notification settings - Fork 25
/
Copy pathchart_data_color.R
148 lines (122 loc) · 5.94 KB
/
chart_data_color.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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
#' @export
#' @title Modify fill colour
#' @description Specify mappings from levels in the data to displayed fill colours.
#' @param x chart object
#' @param values `character(num of series|1)`: a set of colours values to map data values to.
#' It is a named vector, the values will be matched based on the names.
#' If it contains only one colour, this colour will be associated to all existing series.
#' @examples
#' my_scatter <- ms_scatterchart(data = iris, x = "Sepal.Length",
#' y = "Sepal.Width", group = "Species")
#' my_scatter <- chart_data_fill(my_scatter,
#' values = c(virginica = "#6FA2FF", versicolor = "#FF6161", setosa = "#81FF5B") )
#' @seealso \code{\link{chart_data_stroke}}, \code{\link{chart_data_symbol}}, \code{\link{chart_data_size}}
chart_data_fill <- function(x, values){
valid_cols <- is_valid_color(values)
if( any(!valid_cols) )
stop("invalid color(s) in argument values")
serie_names <- names(x$series_settings$fill)
if( length(values) == 1 ){
values <- rep(values, length(serie_names))
names(values) <- serie_names
}
if( !all(names(values) %in% serie_names ) )
stop( "values's names do not match series' names: ", paste0(shQuote(serie_names), collapse = ", "))
x$series_settings$fill[names(values)] <- values
x
}
#' @export
#' @title Modify stroke colour
#' @description Specify mappings from levels in the data to displayed stroke colours.
#' @param x chart object
#' @param values `character(num of series)`: a set of colours values to map data values to.
#' It is a named vector, the values will be matched based on the names.
#' If it contains only one colour, this colour will be associated to all existing series.
#' @examples
#' my_scatter <- ms_scatterchart(data = iris, x = "Sepal.Length",
#' y = "Sepal.Width", group = "Species")
#' my_scatter <- chart_data_fill(my_scatter,
#' values = c(virginica = "#6FA2FF", versicolor = "#FF6161", setosa = "#81FF5B") )
#' my_scatter <- chart_data_stroke(my_scatter,
#' values = c(virginica = "black", versicolor = "black", setosa = "black") )
#' @seealso \code{\link{chart_data_fill}}, \code{\link{chart_data_symbol}}, \code{\link{chart_data_size}}
chart_data_stroke <- function(x, values){
valid_cols <- is_valid_color(values)
if( any(!valid_cols) )
stop("invalid color(s) in argument values")
serie_names <- names(x$series_settings$colour)
if( length(values) == 1 ){
values <- rep(values, length(serie_names))
names(values) <- serie_names
}
if( !all(names(values) %in% serie_names ) )
stop( "values's names do not match series' names: ", paste0(shQuote(serie_names), collapse = ", "))
x$series_settings$colour[names(values)] <- values
x
}
#' @export
#' @title Modify symbol
#' @description Specify mappings from levels in the data to displayed symbols.
#' @param x chart object
#' @param values `character(num of series)`: a set of symbol values to map data values to.
#' It is a named vector, the values will be matched based on the names.
#' Possible values are: \Sexpr[stage=render, results=rd]{mschart:::choices_rd(mschart:::st_markerstyle)}.
#' If it contains only one symbol, this symbol will be associated to all existing series.
#' @examples
#' my_scatter <- ms_scatterchart(data = iris, x = "Sepal.Length",
#' y = "Sepal.Width", group = "Species")
#' my_scatter <- chart_data_fill(my_scatter,
#' values = c(virginica = "#6FA2FF", versicolor = "#FF6161", setosa = "#81FF5B") )
#' my_scatter <- chart_data_stroke(my_scatter,
#' values = c(virginica = "black", versicolor = "black", setosa = "black") )
#' my_scatter <- chart_data_symbol(my_scatter,
#' values = c(virginica = "circle", versicolor = "diamond", setosa = "circle") )
#' @seealso \code{\link{chart_data_fill}}, \code{\link{chart_data_stroke}}, \code{\link{chart_data_size}}
chart_data_symbol <- function(x, values){
if( !all(values %in% st_markerstyle) ){
stop("values should have values matching ", paste0(shQuote(st_markerstyle), collapse = ", " ))
}
serie_names <- names(x$series_settings$symbol)
if( length(values) == 1 ){
values <- rep(values, length(serie_names))
names(values) <- serie_names
}
if( !all(names(values) %in% serie_names ) )
stop( "values's names do not match series' names: ", paste0(shQuote(serie_names), collapse = ", "))
x$series_settings$symbol[names(values)] <- values
x
}
#' @export
#' @title Modify symbol size
#' @description Specify mappings from levels in the data to displayed size of symbols.
#' @param x chart object
#' @param values `double(num of series)`: a set of size values to map data values to.
#' It is a named vector, the values will be matched based on the names.
#' If it contains only one size, this size will be associated to all existing series.
#' @examples
#' my_scatter <- ms_scatterchart(data = iris, x = "Sepal.Length",
#' y = "Sepal.Width", group = "Species")
#' my_scatter <- chart_data_fill(my_scatter,
#' values = c(virginica = "#6FA2FF", versicolor = "#FF6161", setosa = "#81FF5B") )
#' my_scatter <- chart_data_stroke(my_scatter,
#' values = c(virginica = "black", versicolor = "black", setosa = "black") )
#' my_scatter <- chart_data_symbol(my_scatter,
#' values = c(virginica = "circle", versicolor = "diamond", setosa = "circle") )
#' my_scatter <- chart_data_size(my_scatter,
#' values = c(virginica = 20, versicolor = 16, setosa = 20) )
#' @seealso \code{\link{chart_data_fill}}, \code{\link{chart_data_stroke}}, \code{\link{chart_data_symbol}}
chart_data_size <- function(x, values){
if( !is.numeric(values) )
stop("values should be numeric values")
if( any( sign(values) < 0 ) )
stop("values should not contain negative values")
serie_names <- names(x$series_settings$size)
if( length(values) == 1 ){
values <- rep(values, length(serie_names))
names(values) <- serie_names
}
if( !all(names(values) %in% serie_names ) )
stop( "values's names do not match series' names: ", paste0(shQuote(serie_names), collapse = ", "))
x$series_settings$size[names(values)] <- values
x
}