Improve plot time axis readability

R/rain_db.R

@@ -1459,6 +1459,121 @@ get_metric_plot_y_label <- function(
 }
 
 
+build_metric_plot_time_axis <- function(
+  values,
+  view = c("raw", "daily", "weekly", "monthly")
+) {
+  view <- match.arg(view)
+
+  if (identical(view, "raw")) {
+    values <- as.POSIXct(values, tz = "UTC")
+    values <- values[!is.na(values)]
+
+    if (!length(values)) {
+      return(list(at = values, labels = character(), las = 1, cex.axis = 0.8))
+    }
+
+    span_days <- max(1, as.numeric(difftime(max(values), min(values), units = "days")))
+    tick_count <- min(14L, max(6L, ceiling(span_days * 2)))
+    axis_at <- as.POSIXct(
+      pretty(as.numeric(values), n = tick_count),
+      origin = "1970-01-01",
+      tz = "UTC"
+    )
+    axis_at <- axis_at[axis_at >= min(values) & axis_at <= max(values)]
+    if (length(axis_at) < min(6L, tick_count)) {
+      axis_at <- seq(
+        from = min(values),
+        to = max(values),
+        length.out = tick_count
+      )
+    }
+
+    return(list(
+      at = axis_at,
+      labels = format(axis_at, "%d %b\n%H:%M", tz = "UTC"),
+      las = 1,
+      cex.axis = 0.8
+    ))
+  }
+
+  values <- as.Date(values)
+  values <- values[!is.na(values)]
+
+  if (!length(values)) {
+    return(list(at = values, labels = character(), las = 1, cex.axis = 0.85))
+  }
+
+  span_days <- max(1, as.integer(max(values) - min(values)))
+  tick_count <- switch(
+    view,
+    daily = min(14L, max(6L, span_days + 1L)),
+    weekly = min(12L, max(6L, ceiling(span_days / 7))),
+    monthly = min(12L, max(6L, ceiling(span_days / 30))),
+    8L
+  )
+  label_format <- switch(
+    view,
+    daily = "%d %b",
+    weekly = "%d %b",
+    monthly = "%b\n%Y"
+  )
+
+  axis_at <- as.Date(
+    pretty(as.numeric(values), n = tick_count),
+    origin = "1970-01-01"
+  )
+  axis_at <- sort(unique(axis_at[axis_at >= min(values) & axis_at <= max(values)]))
+  if (length(axis_at) < min(6L, tick_count)) {
+    axis_at <- sort(unique(as.Date(seq(
+      from = min(values),
+      to = max(values),
+      length.out = tick_count
+    ))))
+  }
+
+  list(
+    at = axis_at,
+    labels = format(axis_at, label_format),
+    las = 1,
+    cex.axis = 0.85
+  )
+}
+
+
+draw_metric_plot_time_axis <- function(
+  values,
+  view = c("raw", "daily", "weekly", "monthly")
+) {
+  view <- match.arg(view)
+  axis_spec <- build_metric_plot_time_axis(values = values, view = view)
+
+  if (!length(axis_spec$at)) {
+    return(invisible(NULL))
+  }
+
+  if (identical(view, "raw")) {
+    axis.POSIXct(
+      side = 1,
+      at = axis_spec$at,
+      labels = axis_spec$labels,
+      las = axis_spec$las,
+      cex.axis = axis_spec$cex.axis
+    )
+  } else {
+    axis.Date(
+      side = 1,
+      at = axis_spec$at,
+      labels = axis_spec$labels,
+      las = axis_spec$las,
+      cex.axis = axis_spec$cex.axis
+    )
+  }
+
+  invisible(axis_spec)
+}
+
+
 plot_cached_metric <- function(
   metric_data,
   metric_id,
@@ -1467,6 +1582,9 @@ plot_cached_metric <- function(
 ) {
   view <- match.arg(view)
   metric <- get_weather_metric(metric_id)
+  old_par <- graphics::par(no.readonly = TRUE)
+  on.exit(graphics::par(old_par), add = TRUE)
+  graphics::par(mar = c(6.5, 4.5, 4, 1) + 0.1)
 
   if (is.null(metric_data) || !nrow(metric_data)) {
     stop(sprintf("No cached %s data available.", tolower(metric$label)))
@@ -1486,10 +1604,13 @@ plot_cached_metric <- function(
       range(metric_data$observed_day, na.rm = TRUE),
       y_limits,
       type = "n",
+      xaxt = "n",
+      xaxs = "i",
       xlab = "",
       ylab = y_label,
       main = main
     )
+    draw_metric_plot_time_axis(metric_data$observed_day, view = view)
 
     for (station_name in station_names) {
       station_data <- metric_data[metric_data$station_name == station_name, , drop = FALSE]
@@ -1509,10 +1630,13 @@ plot_cached_metric <- function(
       range(metric_data$observed_at, na.rm = TRUE),
       y_limits,
       type = "n",
+      xaxt = "n",
+      xaxs = "i",
       xlab = "",
       ylab = y_label,
       main = main
     )
+    draw_metric_plot_time_axis(metric_data$observed_at, view = view)
 
     for (station_name in station_names) {
       station_data <- metric_data[metric_data$station_name == station_name, , drop = FALSE]

tests/testthat/test-rain-db.R

@@ -236,3 +236,26 @@ test_that("rain plot labels reflect grouped totals", {
   expect_equal(get_metric_plot_y_label("rain_6m", "monthly"), "Monthly rain total (mm)")
   expect_equal(get_metric_plot_y_label("air_temperature", "weekly"), "Temperature (C)")
 })
+
+
+test_that("plot time axis builder creates denser horizontal labels", {
+  raw_axis <- build_metric_plot_time_axis(
+    as.POSIXct(
+      c("2024-01-01 00:00:00", "2024-01-03 12:00:00"),
+      tz = "UTC"
+    ),
+    view = "raw"
+  )
+  monthly_axis <- build_metric_plot_time_axis(
+    as.Date(c("2024-01-01", "2024-12-31")),
+    view = "monthly"
+  )
+
+  expect_equal(raw_axis$las, 1)
+  expect_gte(length(raw_axis$at), 6)
+  expect_true(all(grepl("\n", raw_axis$labels)))
+
+  expect_equal(monthly_axis$las, 1)
+  expect_gte(length(monthly_axis$at), 6)
+  expect_true(all(grepl("\n", monthly_axis$labels)))
+})