-
Notifications
You must be signed in to change notification settings - Fork 0
/
line_chart_dense.R
256 lines (241 loc) · 9.06 KB
/
line_chart_dense.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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
#podaje sie liste dataframow, wektor x kolejno odpowiednio, wektor y i cat
#data frame jest taki że s kolumny:
#x - procentowo w obrebie jednej kategorii gdzie ma być w punkt
#y - normlanie wartosc
#cat - categorie, z czego tu sie powatarzaja
#---
#musi byc osobny data frame dla kazdej serii
add_category_complex <- function(shift, data, cat, x, k, interval){ #cat jest calym wektorem
left_margin <- get_margins()$left
top_margin <- get_margins()$top
cat_width <- get_interval_width(interval)$category_width
return(paste(
#linia
draw_line(x - cat_width/2, x + cat_width/2, top_margin+200, top_margin+200),
#label with the value
add_label(x, top_margin+218.4 + shift, cat[k]),
#asisting line
draw_line(x - cat_width/2, x - cat_width/2, top_margin, top_margin+200 + shift, "black", 0.1),
sep="\n"
))
}
#----
draw_lines_complex <- function(svg_string, list, vector_x, vector_y, vector_cat, series_labels, interval,df_numbers, point_cords){ #x,y,cat to string z nazwa kolumny
left_margin <- get_margins()$left
top_margin <- get_margins()$top
maxes<-c()
neg<-c()
labels<-""
cat_width <- get_interval_width(interval)$category_width
for(k in 1:length(list)){
maxes <- c(maxes, max(abs(list[[k]][,vector_y[k]])))
neg <- c(neg,list[[k]][,vector_y[k]][list[[k]][,vector_y[k]]<0] )
}
height_of_one <- 200/max(maxes)
#calculating the shift
if(length(neg) == 0){shift <- 0}
else{shift <- height_of_one*abs(min(neg))}
lines<-""
x_start <- left_margin
x_to_connect <- left_margin
for(k in 1:length(list)) {
#---
data <- list[[k]]
x <- vector_x[k]
y <- vector_y[k]
cat <- vector_cat[k]
#color <- colors[k]
color <- get_color_stacked(k)$bar_color
#labelka z nazwa serii
labels <- paste(labels,
add_label(left_margin-4.8, top_margin+200- height_of_one*data[,y][1] + 6, series_labels[k], anchor="end"),
sep='\n')
#---
x_start <- left_margin
categories <- unique(data[cat])
for(i in 1:length(categories[,cat])){ #going through categories/ time series
category <- categories[,cat][i]
filtered <- data[data[cat] == category,]
#lines between two categories
if( i!= 1){
lines <- paste(
lines,
draw_line(x_to_connect, x_start + cat_width*filtered[,x][1]/100, y_to_connect, top_margin+200-(height_of_one*filtered[,y][1]), color),
sep='\n')
}
for(j in 1:(length(filtered[,x])-1)){ #going through points in one category/ time series
lines <- paste(lines,
#linia
draw_line(x_start + cat_width*filtered[,x][j]/100, x_start + cat_width*filtered[,x][j+1]/100, top_margin+200-(height_of_one*filtered[,y][j]), top_margin+200-(height_of_one*filtered[,y][j+1]), color),
sep='\n')
}
lines <- paste(lines, add_category_complex(shift ,data, categories[,cat], x_start + cat_width/2, i, interval),sep='\n')
x_to_connect <- x_start + cat_width*filtered[,x][j+1]/100
x_start <- x_start + cat_width
y_to_connect <- top_margin+200-(height_of_one*filtered[,y][j+1])
}
}
#adding last assisting line
lines <- paste(lines,
draw_line(left_margin + cat_width*length(categories[,cat]), left_margin + cat_width*length(categories[,cat]), top_margin, top_margin+200+shift, "black", 0.1),
sep='\n')
chosen_points <- draw_chosen_points_complex(list, vector_x, vector_y, vector_cat, interval, df_numbers, height_of_one, point_cords, categories)
return(paste(svg_string, lines, labels, chosen_points ,sep='\n'))
}
#---
draw_chosen_points_complex <- function(list, vector_x, vector_y, vector_cat, interval,df_numbers, height_of_one, point_cords,categories){
chosen_points <- ""
left_margin <- get_margins()$left
top_margin <- get_margins()$top
cat_width <- get_interval_width(interval)$category_width
if(is.null(df_numbers)==FALSE){
for(i in 1:length(df_numbers)){ #going through all chosen points
k <- df_numbers[i] #index of data frame on the list
data <- list[[k]]
x <- vector_x[k]
y <- vector_y[k]
cat <- vector_cat[k]
#color <- colors[k]
color <- get_color_stacked(k)$bar_color
#calculating x coordinate
p_cat <- data[,cat][point_cords[i]]
cat_index <- match(p_cat, categories[,vector_cat[length(list)]])[1] #which category it is
x_start <- left_margin + cat_width*(cat_index-1)
x_cir <- x_start + cat_width*data[,x][point_cords[i]]/100
y_cir <- top_margin+200 - height_of_one*data[, y][point_cords[i]]
circle_color <- color
chosen_points <- paste(chosen_points,
draw_circle(x_cir, y_cir, circle_color, 2.4),
#label
add_label(x_cir, y_cir - 4.8 - 2.4, data[,y][point_cords[i]], "black"),
sep='\n')
}}
return(chosen_points)
}
#----
#' More customizable version of `line_chart_dense`. User can choose the points to highlight.
#'
#' @param list list of data frames, each representing one series. Data frame should consist of columns:
#' * containing numeric values from 0 to 100 defining the percentage of distance in one time interval of the point (x - coordinates of the point)
#' * containing the value of a point (y - coordinates of the point)
#' * containing the time interval of the value
#' @param vector_x vector containing the names of columns with x - coordinates of the point in the data frames
#' @param vector_y vector containing the names of columns with y - coordinates of the point in the data frames
#' @param vector_cat vector containing the names of columns with time interval of the point in the data frames
#' @param series_labels vector containing names of series to be shown on the plot
#' @param df_numbers vector containing index of data frame in the list of a value to be marked
#' @param point_cords vector of the same length as df_numbers containing numerical values of indexes in data frame of values to be marked
#' @inheritParams column_chart
#'
#' @inherit bar_chart return
#' @export
#'
#' @examples
#'
#' #preparing data frames
#' data <- data.frame(
#' xdata = c(1, 60,90, 30, 60, 90, 30, 60, 90, 45,95,45, 95),
#' ydata = c(5, -10, -15, 11, 16, 18, 25, 22, 18, 10, 8, 23, 28),
#' catdata = c("Jan","Jan", "Jan", "Feb","Feb", "Feb", "Mar",
#' "Mar", "Mar", "Apr", "Apr", "May", "May")
#' )
#'
#' df <- data.frame(
#' xdf = c(1,60,90, 30, 60, 90, 30, 60, 90, 45,95,45, 95),
#' ydf = c(25, 22,20, 18, 28, 35,33, 29, 30, 38,31,26, 22),
#' catdf = c("Jan","Jan", "Jan", "Feb","Feb", "Feb", "Mar",
#' "Mar", "Mar", "Apr", "Apr", "May", "May")
#')
#'
#' #defining the rest of the arguments
#' list <- list(data, df)
#' vector_x <- c("xdata", "xdf")
#' vector_y <- c("ydata", "ydf")
#' vector_cat <-c("catdata", "catdf")
#' df_numbers <- c(1,2,2, 1)
#' point_cords <- c(1, 3, 4, 10)
#'
#' #generating the svg string
#' plot<- line_chart_dense_custom(
#' list,
#' vector_x = c("xdata", "xdf"),
#' vector_y = c("ydata", "ydf"),
#' vector_cat = c("catdata", "catdf"),
#' series_labels = c("Gamma inc.", "Delta inc."),
#' df_numbers = df_numbers,
#' point_cords = point_cords)
#'
#' #showing the plot
#' plot
#'
#'
line_chart_dense_custom <-
function(list,
vector_x,
vector_y,
vector_cat,
series_labels,
df_numbers = NULL,
point_cords = NULL,
interval = "months") {
svg_string <- initialize() %>%
draw_lines_complex(
list,
vector_x,
vector_y,
vector_cat,
series_labels,
interval,
df_numbers,
point_cords
) %>%
finalize()
class(svg_string) <- c('tidychart', 'character')
return(svg_string)
}
#' Line chart with more points then categories on x-axis.
#'
#'
#' @param data Data frame in wide format.
#' @param dates Name of column in `data` which contains dates or vector of dates.
#' @param series Vector of column names in `data` with values of time series.
#' @param interval Granularity of x axis. One of c('weeks', 'months', 'quarters', 'years'). Default value is 'months'.
#'
#' @inherit bar_chart return
#' @export
#'
#' @examples
#'
#' df <- data.frame(
#' x = seq.Date(as.Date('2021-01-01'), as.Date('2021-07-01'), length.out = 200),
#' 'Company_sin' = 5 * sin(seq(
#' from = 0,
#' to = 2 * pi,
#' length.out = 200
#' )) + rnorm(200, mean = 5, sd = 0.5),
#' 'Company_cos' = 5 * cos(seq(
#' from = 0,
#' to = 2 * pi,
#' length.out = 200
#' )) + rnorm(200, mean = 5, sd = 0.5))
#'
#' df <- head(df, n = 199)
#'
#' line_chart_dense(
#' df,
#' dates = 'x',
#' series = c('Company_sin', 'Company_cos'))
#'
line_chart_dense <- function(data, dates, series, interval = 'months'){
stopifnot(interval %in% c('weeks', 'months', 'quarters', 'years'))
parse_time_series(data, dates, series, interval) %>%
line_chart_dense_custom(
vector_x = rep('x', length(series)),
vector_y = rep('y', length(series)),
vector_cat = rep('cat', length(series)),
series_labels = series,
df_numbers = 1,
point_cords = NULL,
interval = interval
)
}