diff --git a/R/rain_db.R b/R/rain_db.R index 8a261b7..8de9fea 100644 --- a/R/rain_db.R +++ b/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] diff --git a/tests/testthat/test-rain-db.R b/tests/testthat/test-rain-db.R index 8e4e88e..8d717af 100644 --- a/tests/testthat/test-rain-db.R +++ b/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))) +})