tests/testthat/test-tf-ggplot-visual.R

In tidyfun: Tidy Functional Data Wrangling and Visualization

# Visual tests for tf_ggplot functionality
# These tests create actual plots that can be inspected visually during development

# Set up visual testing environment
setup_visual_tests <- function() {
  # Create a temporary directory for test plots if it doesn't exist
  test_dir <- file.path(getwd(), "test-plots")
  if (!dir.exists(test_dir)) {
    dir.create(test_dir, recursive = TRUE)
  }
  return(test_dir)
}

# Helper function to save and optionally display plots
save_test_plot <- function(
  plot,
  filename,
  width = 8,
  height = 6,
  display = interactive(),
  save_plot = TRUE
) {
  if (save_plot) {
    test_dir <- setup_visual_tests()
    full_path <- file.path(test_dir, paste0(filename, ".png"))

    tryCatch(
      {
        ggsave(full_path, plot, width = width, height = height, dpi = 150)
        # cat("Plot saved to:", full_path, "\n")
      },
      error = function(e) {
        warning("Could not save plot: ", e$message)
      }
    )
  }

  if (display) {
    print(plot)
  }

  invisible(plot)
}

test_that("basic tf_ggplot line plots look sensible", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create test data with recognizable patterns
  set.seed(123)
  data <- data.frame(
    id = 1:4,
    group = factor(c("Sine", "Cosine", "Linear", "Quadratic"))
  )

  # Create functions with different patterns for visual verification
  arg_vals <- seq(0, 2 * pi, length.out = 51)
  data$func <- tfd(
    list(
      sin(arg_vals), # Sine wave
      cos(arg_vals), # Cosine wave
      arg_vals / pi, # Linear function
      (arg_vals - pi)^2 / pi^2 # Quadratic function
    ),
    arg = arg_vals
  )

  # Test both aesthetic specification methods
  p1 <- tf_ggplot(data, aes(tf = func, color = group)) +
    geom_line(linewidth = 1) +
    labs(
      title = "tf_ggplot: Basic Line Plot (Constructor Aesthetics)",
      subtitle = "Should show: sine, cosine, linear, and quadratic functions"
    ) +
    theme_minimal()

  p2 <- tf_ggplot(data) +
    geom_line(aes(tf = func, color = group), linewidth = 1) +
    labs(
      title = "tf_ggplot: Basic Line Plot (Geom Aesthetics)",
      subtitle = "Should be identical to constructor version"
    ) +
    theme_minimal()

  # Save plots for visual inspection
  save_test_plot(p1, "01_basic_line_constructor")
  save_test_plot(p2, "02_basic_line_geom")

  # Basic validation that plots were created
  expect_s3_class(p1, "ggplot")
  expect_s3_class(p2, "ggplot")

  # Verify they have the expected structure
  expect_equal(count_plot_groups(p1), 4)
  expect_equal(count_plot_groups(p2), 4)
})

test_that("tf_ggplot with points and lines looks correct", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create sparse irregular data to test points + lines
  set.seed(456)
  data <- data.frame(
    subject = 1:3,
    treatment = factor(c("Control", "Treatment A", "Treatment B"))
  )

  # Create irregular functions (sparse data)
  arg_vals <- sort(runif(15, 0, 10)) # Irregular time points
  data$func <- tfd(
    list(
      exp(-arg_vals / 5) + rnorm(15, 0, 0.1), # Decay + noise
      2 * exp(-arg_vals / 3) + rnorm(15, 0, 0.15), # Different decay
      1.5 * exp(-arg_vals / 4) + rnorm(15, 0, 0.12) # Third decay
    ),
    arg = list(arg_vals, arg_vals, arg_vals)
  )

  p <- tf_ggplot(data, aes(tf = func, color = treatment)) +
    geom_line(alpha = 0.7, linewidth = 1) +
    geom_point(size = 2) +
    labs(
      title = "tf_ggplot: Lines + Points with Irregular Data",
      subtitle = "Should show: 3 decay curves with visible data points"
    ) +
    theme_minimal()

  save_test_plot(p, "03_lines_points_irregular")

  expect_s3_class(p, "ggplot")
  expect_equal(count_plot_groups(p), 3)
})

test_that("tf_ggplot ribbon plots look sensible", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create confidence band data
  set.seed(789)
  data <- data.frame(method = c("Method A", "Method B"))

  arg_vals <- seq(0, 5, length.out = 26)

  # Create mean functions
  mean_vals1 <- 2 * exp(-arg_vals / 2) * cos(arg_vals)
  mean_vals2 <- 1.5 * exp(-arg_vals / 3) * sin(arg_vals * 1.2)

  # Create confidence bands
  sd1 <- 0.2 + 0.1 * arg_vals / 5 # Increasing uncertainty
  sd2 <- 0.15 + 0.05 * arg_vals / 5

  data$mean_func <- tfd(list(mean_vals1, mean_vals2), arg = arg_vals)
  data$lower_func <- tfd(
    list(mean_vals1 - 1.96 * sd1, mean_vals2 - 1.96 * sd2),
    arg = arg_vals
  )
  data$upper_func <- tfd(
    list(mean_vals1 + 1.96 * sd1, mean_vals2 + 1.96 * sd2),
    arg = arg_vals
  )

  p <- tf_ggplot(data, aes(color = method, fill = method)) +
    geom_ribbon(
      aes(tf_ymin = lower_func, tf_ymax = upper_func),
      alpha = 0.3
    ) +
    geom_line(aes(tf = mean_func), linewidth = 1) +
    labs(
      title = "tf_ggplot: Confidence Bands",
      subtitle = "Should show: 2 oscillating functions with confidence ribbons"
    ) +
    theme_minimal()

  save_test_plot(p, "04_confidence_ribbons")

  expect_s3_class(p, "ggplot")
  expect_equal(count_plot_groups(p), 2) # Should have 2 methods
})

test_that("tf_ggplot faceting looks correct", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create data for faceted plot
  set.seed(101112)
  data <- expand.grid(
    subject = 1:4,
    condition = c("Baseline", "Treatment"),
    session = c("Pre", "Post")
  )

  # Create different function patterns for each condition
  arg_vals <- seq(0, 10, length.out = 21)
  n_funcs <- nrow(data)

  func_vals <- map(1:n_funcs, function(i) {
    baseline <- sin(arg_vals * 0.5) + rnorm(21, 0, 0.1)
    if (data$condition[i] == "Treatment") {
      # Treatment effect: amplify and shift
      baseline <- baseline * 1.5 + 0.5
    }
    if (data$session[i] == "Post") {
      # Post effect: add upward trend
      baseline <- baseline + arg_vals * 0.05
    }
    baseline
  })

  data$func <- tfd(func_vals, arg = arg_vals)

  p <- tf_ggplot(data, aes(tf = func, color = condition)) +
    geom_line(alpha = 0.7) +
    facet_grid(session ~ condition) +
    labs(
      title = "tf_ggplot: Faceted Plot",
      subtitle = "Should show: Treatment effects across Pre/Post sessions"
    ) +
    theme_minimal()

  save_test_plot(p, "05_faceted_plot", width = 10, height = 8)

  expect_s3_class(p, "ggplot")

  # Check faceting structure
  built <- ggplot_build(p)
  expect_equal(length(unique(built$layout$layout$PANEL)), 4) # 2×2 facets
})

test_that("tf_ggplot with multiple aesthetics looks good", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create data with multiple grouping variables
  set.seed(131415)
  data <- expand.grid(
    method = c("A", "B", "C"),
    replicate = 1:3
  )
  data$difficulty <- factor(rep(c("Easy", "Medium", "Hard"), 3))
  data$performance <- runif(9, 0.5, 1.0)

  # Create performance curves over time
  arg_vals <- seq(0, 12, length.out = 25)
  func_vals <- map(1:nrow(data), function(i) {
    # Base learning curve
    base <- data$performance[i] * (1 - exp(-arg_vals / 3))

    # Method effects
    if (data$method[i] == "B") base <- base * 1.1
    if (data$method[i] == "C") base <- base * 0.9

    # Difficulty effects
    if (data$difficulty[i] == "Medium") base <- base * 0.8
    if (data$difficulty[i] == "Hard") base <- base * 0.6

    # Add noise
    base + rnorm(25, 0, 0.05)
  })

  data$learning_curve <- tfd(func_vals, arg = arg_vals)

  p <- tf_ggplot(
    data,
    aes(
      tf = learning_curve,
      color = method,
      linetype = difficulty,
      alpha = performance
    )
  ) +
    geom_line(linewidth = 1) +
    scale_alpha_continuous(range = c(0.4, 1.0)) +
    labs(
      title = "tf_ggplot: Multiple Aesthetics",
      subtitle = "Should show: Learning curves by method, difficulty, and performance"
    ) +
    theme_minimal() +
    theme(legend.position = "bottom")

  save_test_plot(p, "06_multiple_aesthetics", width = 10, height = 8)

  expect_s3_class(p, "ggplot")
  expect_equal(count_plot_groups(p), 9) # 3 methods × 3 replicates
})

test_that("tf_ggplot comparison with current geom_spaghetti", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create comparison data
  set.seed(161718)
  data <- data.frame(
    id = 1:6,
    group = factor(rep(c("Group A", "Group B"), each = 3))
  )
  data$func <- tf_rgp(6, arg = seq(0, 1, length.out = 31))

  # Current approach with geom_spaghetti
  p_current <- ggplot(data, aes(y = func, color = group)) +
    geom_spaghetti(alpha = 0.7) +
    labs(
      title = "Current: geom_spaghetti",
      subtitle = "6 random Gaussian process functions"
    ) +
    theme_minimal()

  # New approach with tf_ggplot
  p_new <- tf_ggplot(data, aes(tf = func, color = group)) +
    geom_line(alpha = 0.7) +
    labs(
      title = "New: tf_ggplot + geom_line",
      subtitle = "Same data, should look identical"
    ) +
    theme_minimal()

  save_test_plot(p_current, "07_current_spaghetti")
  save_test_plot(p_new, "08_new_tf_ggplot")

  # Both should work
  expect_s3_class(p_current, "ggplot")
  expect_s3_class(p_new, "ggplot")

  # Should have same number of groups
  expect_equal(count_plot_groups(p_current), count_plot_groups(p_new))
})

test_that("tf_ggplot with different geom types", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Create test data with distinctive patterns
  set.seed(192021)
  data <- data.frame(id = 1:2)

  arg_vals <- seq(0, 4 * pi, length.out = 41)
  data$func <- tfd(
    list(
      sin(arg_vals) + 0.1 * arg_vals, # Sine with trend
      cos(arg_vals) - 0.1 * arg_vals # Cosine with trend
    ),
    arg = arg_vals
  )

  # Test different geom types
  p_line <- tf_ggplot(data) +
    geom_line(aes(tf = func), color = "blue", linewidth = 1) +
    labs(title = "geom_line", subtitle = "Smooth continuous lines") +
    theme_minimal()

  p_point <- tf_ggplot(data) +
    geom_point(
      aes(tf = func),
      color = "red",
      size = 1.5,
      alpha = 0.7
    ) +
    labs(title = "geom_point", subtitle = "Individual evaluation points") +
    theme_minimal()

  p_step <- tf_ggplot(data, arg = seq(0, 4 * pi, length.out = 21)) +
    geom_step(
      aes(tf = func),
      color = "green",
      linewidth = 1
    ) +
    labs(title = "geom_step", subtitle = "Step function approximation") +
    theme_minimal()

  p_area <- tf_ggplot(data) +
    geom_area(aes(tf = func), fill = "purple", alpha = 0.5) +
    labs(title = "geom_area", subtitle = "Filled area under curves") +
    theme_minimal()

  # Combined plot
  p_combined <- tf_ggplot(data, aes(tf = func, color = factor(id))) +
    geom_line(linewidth = 1, alpha = 0.8) +
    geom_point(size = 2) +
    labs(
      title = "Combined: Lines + Points",
      subtitle = "Should show both continuous lines and data points",
      color = "Function"
    ) +
    theme_minimal()

  save_test_plot(p_line, "09_geom_line")
  save_test_plot(p_point, "10_geom_point")
  save_test_plot(p_step, "11_geom_step")
  save_test_plot(p_area, "12_geom_area")
  save_test_plot(p_combined, "13_combined_geoms")

  # All should build successfully
  expect_s3_class(p_line, "ggplot")
  expect_s3_class(p_point, "ggplot")
  expect_s3_class(p_step, "ggplot")
  expect_s3_class(p_area, "ggplot")
  expect_s3_class(p_combined, "ggplot")
})

test_that("tf_ggplot edge cases render properly", {
  skip_if_not_installed("ggplot2")
  skip_if_no_tf_ggplot()

  # Test various edge cases
  set.seed(222324)

  # 1. Single function
  data1 <- data.frame(id = 1)
  data1$func <- tf_rgp(1, arg = seq(0, 1, length.out = 21))

  p1 <- tf_ggplot(data1, aes(tf = func)) +
    geom_line(color = "blue", linewidth = 1) +
    labs(title = "Edge Case: Single Function") +
    theme_minimal()

  # 2. Very sparse data (few evaluation points)
  data2 <- data.frame(id = 1:3)
  data2$func <- tf_rgp(3, arg = c(0, 0.5, 1)) # Only 3 points

  p2 <- tf_ggplot(data2, aes(tf = func, color = factor(id))) +
    geom_line(linewidth = 1) +
    geom_point(size = 3) +
    labs(title = "Edge Case: Very Sparse Data (3 points)", color = "Function") +
    theme_minimal()

  # 3. Many functions (visual clutter test)
  data3 <- data.frame(id = 1:20)
  data3$group <- factor(rep(c("A", "B"), each = 10))
  data3$func <- tf_rgp(20, arg = seq(0, 1, length.out = 51))

  p3 <- tf_ggplot(data3, aes(tf = func, color = group)) +
    geom_line(alpha = 0.3, linewidth = 0.5) +
    labs(
      title = "Edge Case: Many Functions (20)",
      subtitle = "Should be readable with transparency"
    ) +
    theme_minimal()

  # 4. Wide evaluation range
  wide_arg <- seq(-10, 10, length.out = 101)
  data4 <- data.frame(id = 1:2)
  data4$func <- tfd(
    list(
      exp(-wide_arg^2 / 10), # Gaussian
      sin(wide_arg) * exp(-abs(wide_arg) / 5) # Damped oscillation
    ),
    arg = wide_arg
  )

  p4 <- tf_ggplot(data4, aes(tf = func, color = factor(id))) +
    geom_line(linewidth = 1) +
    labs(
      title = "Edge Case: Wide Evaluation Range (-10 to 10)",
      color = "Function"
    ) +
    theme_minimal()

  save_test_plot(p1, "14_single_function")
  save_test_plot(p2, "15_sparse_data")
  save_test_plot(p3, "16_many_functions")
  save_test_plot(p4, "17_wide_range")

  # All should render without errors
  expect_s3_class(p1, "ggplot")
  expect_s3_class(p2, "ggplot")
  expect_s3_class(p3, "ggplot")
  expect_s3_class(p4, "ggplot")
})

# Helper function to run all visual tests at once
run_visual_tests <- function(display = interactive(), save_plots = TRUE) {
  cat("Running visual tests for tf_ggplot...\n")
  cat("Plots will be saved to:", setup_visual_tests(), "\n")

  # Set global options for this test run
  old_display <- getOption("tf_ggplot_test_display", interactive())
  old_save <- getOption("tf_ggplot_test_save", TRUE)

  options(tf_ggplot_test_display = display)
  options(tf_ggplot_test_save = save_plots)

  tryCatch(
    {
      # Run the visual tests
      test_file("test-tf-ggplot-visual.R")
      cat("Visual tests completed successfully!\n")
    },
    error = function(e) {
      cat("Error in visual tests:", e$message, "\n")
    },
    finally = {
      # Restore options
      options(tf_ggplot_test_display = old_display)
      options(tf_ggplot_test_save = old_save)
    }
  )
}

# Print helper message
if (interactive()) {
  cat("Visual testing functions available:\n")
  cat("- run_visual_tests()  # Run all visual tests\n")
  cat("- Test plots saved to: test-plots/\n")
  cat("- Set display=TRUE to show plots interactively\n")
}