/
ts_median_excess_plt.R
134 lines (117 loc) · 4.26 KB
/
ts_median_excess_plt.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
#' Create a plot showing the excess of the median value
#'
#' @description
#' Plot out the excess +/- of the median value grouped by certain time parameters.
#'
#' @param .data The data that is being analyzed, data must be a tibble/data.frame.
#' @param .date_col The column of the tibble that holds the date.
#' @param .value_col The column that holds the value of interest.
#' @param .x_axis What is the be the x-axis, day, week, etc.
#' @param .ggplot_group_var The variable to group the ggplot on.
#' @param .years_back How many yeas back do you want to go in order to compute
#' the median value.
#'
#' @details
#' - Supply data that you want to view and you will see the excess +/- of the median values
#' over a specified time series tibble.
#'
#' @examples
#'
#' suppressPackageStartupMessages(library(timetk))
#'
#' ts_signature_tbl(
#' .data = m4_daily
#' , .date_col = date
#' ) %>%
#' ts_median_excess_plt(
#' .date_col = date
#' , .value_col = value
#' , .x_axis = month
#' , .ggplot_group_var = year
#' , .years_back = 1
#' )
#'
#' @return
#' A `ggplot2` plot
#'
#' @export
#'
ts_median_excess_plt <- function(
.data
, .date_col
, .value_col
, .x_axis
, .ggplot_group_var
, .years_back
) {
# * Tidayeval ----
date_var_expr <- rlang::enquo(.date_col)
value_var_expr <- rlang::enquo(.value_col)
value_var_name <- rlang::quo_name(value_var_expr)
x_axis_var_expr <- rlang::enquo(.x_axis)
x_axis_var_name <- rlang::quo_name(x_axis_var_expr)
ggplot_group_expr <- rlang::enquo(.ggplot_group_var)
years_back_expr <- rlang::enquo(.years_back)
# * Checks ----
if(!is.data.frame(.data)) {
stop(call. = FALSE, "(data) is not a data-frame or tibble. Please supply.")
}
if (rlang::quo_is_missing(date_var_expr)) {
stop(call. = FALSE, "(date_var_expr) is missing. Please supply.")
}
if (rlang::quo_is_missing(value_var_expr)) {
stop(call. = FALSE, "(value_var_expr) is missing. Please supply.")
}
if (rlang::quo_is_missing(x_axis_var_expr)) {
stop(call. = FALSE, "(x_axis_var_expr) is missing. Please supply.")
}
if (rlang::quo_is_missing(years_back_expr)) {
stop(call. = FALSE, "(years_back_expr) is missing. Please supply.")
}
# Get .end_date
.end_date <- .data %>%
dplyr::select({{date_var_expr}}) %>%
dplyr::pull({{date_var_expr}}) %>%
base::max()
# * Manipulate ----
df_grp_tbl <- tibble::as_tibble(.data) %>%
dplyr::filter(lubridate::year({{date_var_expr}}) >= lubridate::year(.end_date) - {{years_back_expr}}) %>%
dplyr::filter(lubridate::year({{date_var_expr}}) <= lubridate::year(.end_date) - 1) %>%
dplyr::select(- {{date_var_expr}} ) %>%
dplyr::group_by( {{ggplot_group_expr}}, {{x_axis_var_expr}} ) %>%
dplyr::summarise(value = sum({{value_var_expr}})) %>%
dplyr::ungroup() %>%
dplyr::group_by({{x_axis_var_expr}}) %>%
dplyr::summarise(median_value = stats::median(value)) %>%
dplyr::ungroup()
df_excess_tbl <- tibble::as_tibble(.data) %>%
dplyr::select(- {{date_var_expr}} ) %>%
dplyr::group_by( {{ggplot_group_expr}}, {{x_axis_var_expr}} ) %>%
dplyr::summarise(value = sum( {{value_var_expr}} )) %>%
dplyr::ungroup() %>%
dplyr::group_by( {{x_axis_var_expr}} ) %>%
dplyr::left_join(df_grp_tbl) %>%
dplyr::mutate(excess = value - median_value) %>%
dplyr::ungroup() %>%
dplyr::select(-value, -median_value)
# * Plot ----
g <- df_excess_tbl %>%
dplyr::mutate(last_flag = (df_excess_tbl[[1]] == max(df_excess_tbl[[1]]))) %>%
ggplot2::ggplot(
mapping = ggplot2::aes(
x = df_excess_tbl[[2]]
, y = excess
, group = df_excess_tbl[[1]]
)
) +
ggplot2::geom_hline(yintercept = 0, col='gray') +
ggplot2::geom_line(ggplot2::aes(col=last_flag, y = excess)) +
ggplot2::scale_color_manual(values = c("FALSE"='gray',"TRUE"='red')) +
ggplot2::guides(col = FALSE) +
ggplot2::theme_minimal() +
ggplot2::labs(
x = ""
)
# * Return ----
return(g)
}