Experiment
compute_group_date_in_month <- function(data, scales){
data %>%
dplyr::mutate(num_day_of_week = lubridate::wday(.data$date)) %>%
dplyr::mutate(day_of_week = lubridate::wday(.data$date, label = TRUE, abbr = TRUE)) %>%
dplyr::mutate(week_of_month = (- lubridate::wday(.data$date) + lubridate::day(.data$date)) %/% 7 + 1 +
ifelse(lubridate::wday(lubridate::floor_date(lubridate::as_date(.data$date), "month")) == 1, -1, 0)
) %>%
dplyr::mutate(date_of_month = lubridate::day(.data$date)) %>%
dplyr::mutate(which_year = lubridate::year(.data$date) - 2018) %>%
dplyr::mutate(month = lubridate::month(.data$date, abbr = TRUE, label = TRUE)) %>%
dplyr::mutate(hour = lubridate::hour(.data$date)) %>%
dplyr::mutate(academic_year = lubridate::year(.data$date) +
ifelse(lubridate::month(date) >
6, 1, 0)) %>%
dplyr::mutate(academic_month = .data$month %>%
factor(levels = c("Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
"Jan", "Feb", "Mar", "Apr", "May", "Jun"))) |>
dplyr::mutate(x = as.numeric(day_of_week) ) |>
dplyr::mutate(y = week_of_month)
}
ggtemp:::create_layer_temp(fun_name = "stat_calendar",
compute_group = compute_group_date_in_month,
required_aes = "date",
default_aes = aes(label = after_stat(date_of_month)))
ggcalendar:::return_dates_month("2022-02") |>
head() |>
compute_group_date_in_month()
## date num_day_of_week day_of_week week_of_month date_of_month which_year
## 1 2022-02-01 3 Tue 0 1 4
## 2 2022-02-02 4 Wed 0 2 4
## 3 2022-02-03 5 Thu 0 3 4
## 4 2022-02-04 6 Fri 0 4 4
## 5 2022-02-05 7 Sat 0 5 4
## 6 2022-02-06 1 Sun 1 6 4
## month hour academic_year academic_month x y
## 1 Feb 0 2022 Feb 3 0
## 2 Feb 0 2022 Feb 4 0
## 3 Feb 0 2022 Feb 5 0
## 4 Feb 0 2022 Feb 6 0
## 5 Feb 0 2022 Feb 7 0
## 6 Feb 0 2022 Feb 1 1
ggplot(ggcalendar:::return_dates_month("2022-02")) +
aes(date = date) +
stat_calendar(geom = "text") +
coord_trans(y = "reverse")
coord_equal
## function (ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE,
## clip = "on")
## {
## check_coord_limits(xlim)
## check_coord_limits(ylim)
## ggproto(NULL, CoordFixed, limits = list(x = xlim, y = ylim),
## ratio = ratio, expand = expand, clip = clip)
## }
## <bytecode: 0x7f97c31ef8a8>
## <environment: namespace:ggplot2>
waldo::compare(CoordTrans, CoordFixed)
## `class(old)`: "CoordTrans" "Coord" "ggproto" "gg"
## `class(new)`: "CoordFixed" "CoordCartesian" "Coord" "ggproto" "gg"
##
## `old` is length 10
## `new` is length 3
##
## names(old) | names(new)
## [1] "backtransform_range" - "aspect" [1]
## [2] "distance" - "is_free" [2]
## [3] "is_free" - "super" [3]
## [4] "range" -
## [5] "render_axis_h" -
## [6] "render_axis_v" -
## [7] "render_bg" -
## [8] "setup_panel_params" -
## [9] "super" -
## [10] "transform" -
##
## `old$backtransform_range` is a function
## `new$backtransform_range` is absent
##
## `old$distance` is a function
## `new$distance` is absent
##
## `body(old$is_free)`: `{` ` TRUE` `}`
## `body(new$is_free)`: `{` ` FALSE` `}`
##
## `old$range` is a function
## `new$range` is absent
##
## `old$render_axis_h` is a function
## `new$render_axis_h` is absent
##
## `old$render_axis_v` is a function
## `new$render_axis_v` is absent
##
## `old$render_bg` is a function
## `new$render_bg` is absent
##
## And 54 more differences ...
#
# CoordPoster <- ggproto(`_class` = "CoordPoster",
# `_inherit` = CoordFixed)
#
# CoordPoster$range <- function (panel_params)
# {
# list(x = panel_params$x$dimension(), y = rev(panel_params$y$dimension()))
# }
#
#
#
# CoordPoster$setup_panel_params <- function (self, scale_x, scale_y, params = list()) {
# c(ggplot2:::view_scales_from_scale(scale_x, self$limits$x, self$expand),
# ggplot2:::view_scales_from_scale(scale_y, self$limits$y, self$expand))
# }
#
# CoordPoster$setup_panel_params <- function (self, scale_x, scale_y, params = list()) {
# c(ggplot2:::view_scales_from_scale(scale_x, self$limits$x, self$expand),
# ggplot2:::view_scales_from_scale(scale_y, self$limits$y, self$expand))
# }
#
# CoordPoster$transform <- function (data, panel_params)
# {
# data <- transform_position(data, panel_params$x$rescale,
# panel_params$y$rescale)
#
# transform_position(data, squish_infinite, squish_infinite)
# }
#
# CoordRadial
#
# coord_poster <- function (ratio = 1, xlim = NULL, ylim = NULL, expand = TRUE,
# clip = "on")
# {
# ggplot2:::check_coord_limits(xlim)
# ggplot2:::check_coord_limits(ylim)
# ggproto(NULL, CoordPoster, limits = list(x = xlim, y = ylim),
# ratio = ratio, expand = expand, clip = clip)
# }
#
# coord_fixed(ratio = -1)
#
#
#
# CoordPoster$range
births <- "https://raw.githubusercontent.com/EvaMaeRey/tableau/9e91c2b5ee803bfef10d35646cf4ce6675b92b55/tidytuesday_data/2018-10-02-us_births_2000-2014.csv"
readr::read_csv(births) %>%
mutate(month = str_pad(month, 2, pad = "0"),
date_of_month = str_pad(date_of_month, 2, pad = "0")) %>%
mutate(date = paste(year, month, date_of_month, sep = "-") %>% as_date()) %>%
filter(year == 2012)
## Rows: 5479 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (5): year, month, date_of_month, day_of_week, births
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## # A tibble: 366 × 6
## year month date_of_month day_of_week births date
## <dbl> <chr> <chr> <dbl> <dbl> <date>
## 1 2012 01 01 7 6629 2012-01-01
## 2 2012 01 02 1 7821 2012-01-02
## 3 2012 01 03 2 11324 2012-01-03
## 4 2012 01 04 3 12075 2012-01-04
## 5 2012 01 05 4 12171 2012-01-05
## 6 2012 01 06 5 11920 2012-01-06
## 7 2012 01 07 6 7783 2012-01-07
## 8 2012 01 08 7 6887 2012-01-08
## 9 2012 01 09 1 11248 2012-01-09
## 10 2012 01 10 2 11939 2012-01-10
## # ℹ 356 more rows
readr::read_csv(births) |>
count(year)
## Rows: 5479 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (5): year, month, date_of_month, day_of_week, births
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## # A tibble: 15 × 2
## year n
## <dbl> <int>
## 1 2000 366
## 2 2001 365
## 3 2002 365
## 4 2003 365
## 5 2004 366
## 6 2005 365
## 7 2006 365
## 8 2007 365
## 9 2008 366
## 10 2009 365
## 11 2010 365
## 12 2011 365
## 13 2012 366
## 14 2013 365
## 15 2014 365