Skip to content

Commit 12ff28e

Browse files
MoohanMoohan
committed
Refactor the qtr functions
There was a lot of duplication in the code that made it quite complicated / confusing. This PR refactors the duplicated code into a single internal function
1 parent b0dd488 commit 12ff28e

File tree

2 files changed

+80
-181
lines changed

2 files changed

+80
-181
lines changed

‎R/qtr.R‎

Lines changed: 75 additions & 176 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
#' @title Assign a date to a quarter
22
#'
33
#' @description
4-
#'
54
#' The qtr functions take a date input and calculate the relevant
65
#' quarter-related value from it. They all return the year as part of this
76
#' value.
@@ -33,216 +32,116 @@
3332
#' @return A character vector of financial quarters in the specified format.
3433
#'
3534
#' @examples
36-
#' x <- lubridate::dmy(c(26032012, 04052012, 23092012))
37-
#' qtr(x)
38-
#' qtr_end(x, format = "short")
39-
#' qtr_next(x)
40-
#' qtr_prev(x, format = "short")
35+
#' dates <- lubridate::dmy(c(26032012, 04052012, 23092012))
36+
#' qtr(dates)
37+
#' qtr_end(dates, format = "short")
38+
#' qtr_next(dates)
39+
#' qtr_prev(dates, format = "short")
4140
#'
41+
#' @name qtr
4242
#' @export
4343
#' @rdname qtr
44-
qtr <- function(date, format = c("long", "short")) {
45-
format <- match.arg(format)
46-
47-
if (!inherits(date, c("Date", "POSIXct"))) {
48-
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
49-
}
44+
NULL
5045

46+
#' @noRd
47+
format_quarter_internal <- function(
48+
date,
49+
format,
50+
type = c("current", "end", "next", "prev")
51+
) {
5152
quarter_num <- lubridate::quarter(date)
53+
year <- lubridate::year(date)
5254

53-
if (format == "long") {
54-
return(dplyr::case_when(
55-
quarter_num == 1 ~ paste0(
56-
"January to March ",
57-
lubridate::year(date)
58-
),
59-
quarter_num == 2 ~ paste0(
60-
"April to June ",
61-
lubridate::year(date)
62-
),
63-
quarter_num == 3 ~ paste0(
64-
"July to September ",
65-
lubridate::year(date)
66-
),
67-
quarter_num == 4 ~ paste0(
68-
"October to December ",
69-
lubridate::year(date)
70-
)
71-
))
55+
# Adjust quarter number and year based on type
56+
if (type == "next") {
57+
# Vectorized calculation for next quarter number and year
58+
# (quarter_num %% 4L) + 1L handles 1->2, 2->3, 3->4, 4->1
59+
year_change <- (quarter_num == 4L)
60+
quarter_num <- (quarter_num %% 4L) + 1L
61+
year <- year + year_change
62+
} else if (type == "prev") {
63+
# Vectorized calculation for previous quarter number and year
64+
# ((quarter_num + 2L) %% 4L) + 1L handles 1->4, 2->1, 3->2, 4->3
65+
year_change <- (quarter_num == 1L)
66+
quarter_num <- ((quarter_num + 2L) %% 4L) + 1L
67+
year <- year - year_change
68+
}
69+
70+
# Select appropriate labels based on type and format
71+
if (type == "end") {
72+
labels <- if (format == "long") {
73+
c("March", "June", "September", "December")
74+
} else {
75+
c("Mar", "Jun", "Sep", "Dec")
76+
}
7277
} else {
73-
return(dplyr::case_when(
74-
quarter_num == 1 ~ paste0(
75-
"Jan-Mar ",
76-
lubridate::year(date)
77-
),
78-
quarter_num == 2 ~ paste0(
79-
"Apr-Jun ",
80-
lubridate::year(date)
81-
),
82-
quarter_num == 3 ~ paste0(
83-
"Jul-Sep ",
84-
lubridate::year(date)
85-
),
86-
quarter_num == 4 ~ paste0(
87-
"Oct-Dec ",
88-
lubridate::year(date)
78+
labels <- if (format == "long") {
79+
c(
80+
"January to March",
81+
"April to June",
82+
"July to September",
83+
"October to December"
8984
)
90-
))
85+
} else {
86+
c("Jan-Mar", "Apr-Jun", "Jul-Sep", "Oct-Dec")
87+
}
9188
}
89+
90+
paste(labels[quarter_num], year)
9291
}
9392

9493
#' @export
9594
#' @rdname qtr
96-
qtr_end <- function(date, format = c("long", "short")) {
97-
format <- match.arg(format)
95+
qtr <- function(date, format = c("long", "short")) {
96+
format <- rlang::arg_match(format)
9897

9998
if (!inherits(date, c("Date", "POSIXct"))) {
100-
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
99+
cli::cli_abort(
100+
"{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector."
101+
)
101102
}
102103

103-
quarter_num <- lubridate::quarter(date)
104+
format_quarter_internal(date, format, type = "current")
105+
}
104106

105-
if (format == "long") {
106-
return(dplyr::case_when(
107-
quarter_num == 1 ~ paste0(
108-
"March ",
109-
lubridate::year(date)
110-
),
111-
quarter_num == 2 ~ paste0(
112-
"June ",
113-
lubridate::year(date)
114-
),
115-
quarter_num == 3 ~ paste0(
116-
"September ",
117-
lubridate::year(date)
118-
),
119-
quarter_num == 4 ~ paste0(
120-
"December ",
121-
lubridate::year(date)
122-
)
123-
))
124-
} else {
125-
return(dplyr::case_when(
126-
quarter_num == 1 ~ paste0(
127-
"Mar ",
128-
lubridate::year(date)
129-
),
130-
quarter_num == 2 ~ paste0(
131-
"Jun ",
132-
lubridate::year(date)
133-
),
134-
quarter_num == 3 ~ paste0(
135-
"Sep ",
136-
lubridate::year(date)
137-
),
138-
quarter_num == 4 ~ paste0(
139-
"Dec ",
140-
lubridate::year(date)
141-
)
142-
))
107+
#' @export
108+
#' @rdname qtr
109+
qtr_end <- function(date, format = c("long", "short")) {
110+
format <- rlang::arg_match(format)
111+
112+
if (!inherits(date, c("Date", "POSIXct"))) {
113+
cli::cli_abort(
114+
"{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector."
115+
)
143116
}
117+
118+
format_quarter_internal(date, format, type = "end")
144119
}
145120

146121
#' @export
147122
#' @rdname qtr
148123
qtr_next <- function(date, format = c("long", "short")) {
149-
format <- match.arg(format)
124+
format <- rlang::arg_match(format)
150125

151126
if (!inherits(date, c("Date", "POSIXct"))) {
152-
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
127+
cli::cli_abort(
128+
"{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector."
129+
)
153130
}
154131

155-
quarter_num <- lubridate::quarter(date)
156-
157-
if (format == "long") {
158-
return(dplyr::case_when(
159-
quarter_num == 1 ~ paste0(
160-
"April to June ",
161-
lubridate::year(date)
162-
),
163-
quarter_num == 2 ~ paste0(
164-
"July to September ",
165-
lubridate::year(date)
166-
),
167-
quarter_num == 3 ~ paste0(
168-
"October to December ",
169-
lubridate::year(date)
170-
),
171-
quarter_num == 4 ~ paste0(
172-
"January to March ",
173-
lubridate::year(date) + 1
174-
)
175-
))
176-
} else {
177-
return(dplyr::case_when(
178-
quarter_num == 1 ~ paste0(
179-
"Apr-Jun ",
180-
lubridate::year(date)
181-
),
182-
quarter_num == 2 ~ paste0(
183-
"Jul-Sep ",
184-
lubridate::year(date)
185-
),
186-
quarter_num == 3 ~ paste0(
187-
"Oct-Dec ",
188-
lubridate::year(date)
189-
),
190-
quarter_num == 4 ~ paste0(
191-
"Jan-Mar ",
192-
lubridate::year(date) + 1
193-
)
194-
))
195-
}
132+
format_quarter_internal(date, format, type = "next")
196133
}
197134

198135
#' @export
199136
#' @rdname qtr
200137
qtr_prev <- function(date, format = c("long", "short")) {
201-
format <- match.arg(format)
138+
format <- rlang::arg_match(format)
202139

203140
if (!inherits(date, c("Date", "POSIXct"))) {
204-
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
141+
cli::cli_abort(
142+
"{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector."
143+
)
205144
}
206145

207-
quarter_num <- lubridate::quarter(date)
208-
209-
if (format == "long") {
210-
return(dplyr::case_when(
211-
quarter_num == 1 ~ paste0(
212-
"October to December ",
213-
lubridate::year(date) - 1
214-
),
215-
quarter_num == 2 ~ paste0(
216-
"January to March ",
217-
lubridate::year(date)
218-
),
219-
quarter_num == 3 ~ paste0(
220-
"April to June ",
221-
lubridate::year(date)
222-
),
223-
quarter_num == 4 ~ paste0(
224-
"July to September ",
225-
lubridate::year(date)
226-
)
227-
))
228-
} else {
229-
return(dplyr::case_when(
230-
quarter_num == 1 ~ paste0(
231-
"Oct-Dec ",
232-
lubridate::year(date) - 1
233-
),
234-
quarter_num == 2 ~ paste0(
235-
"Jan-Mar ",
236-
lubridate::year(date)
237-
),
238-
quarter_num == 3 ~ paste0(
239-
"Apr-Jun ",
240-
lubridate::year(date)
241-
),
242-
quarter_num == 4 ~ paste0(
243-
"Jul-Sep ",
244-
lubridate::year(date)
245-
)
246-
))
247-
}
146+
format_quarter_internal(date, format, type = "prev")
248147
}

‎man/qtr.Rd‎

Lines changed: 5 additions & 5 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)