utils::globalVariables(c("x", "y", "legend_id"))

esplot <- function(data,  # time, ATT, CI.lower, CI.upper, count, ...
                   Period = NULL,
                   Estimate = "ATT",
                   SE = NULL,
                   CI.lower = "CI.lower", # Default name to look for
                   CI.upper = "CI.upper", # Default name to look for
                   Count = NULL,

                   proportion = 0.3,
                   est.lwidth = NULL,  # line thickness
                   est.pointsize = NULL,    # point size if show.points=TRUE
                   show.points = TRUE,   # show points at integer times
                   fill.gap = TRUE,      # fill missing times with 0
                   start0 = FALSE,       # if TRUE => vertical dashed line at x=-0.5
                   only.pre = FALSE,
                   only.post = FALSE,
                   show.count = TRUE,    # whether to show count bars
                   stats = NULL,         # numeric p-values
                   stats.labs = NULL,    # labels for each p-value

                   highlight.periods = NULL,  # numeric vector of times to highlight
                   highlight.colors  = NULL,    # color for each highlight time
                   highlight.shapes  = NULL,    # integer shape for each highlight time (17=triangle, 18=diamond, etc.)
                   highlight.fill    = FALSE,   # if TRUE, draw a lightened-tone background rectangle behind each highlighted period

                   lcolor = NULL,
                   lwidth = NULL,
                   ltype = NULL,
                   connected = FALSE,    # if TRUE => line + ribbon
                   ci.outline = FALSE,
                   main      = NULL,
                   xlim      = NULL,
                   ylim      = NULL,
                   xlab      = NULL,
                   ylab      = NULL,
                   gridOff   = FALSE,
                   stats.pos = NULL,
                   theme.bw  = TRUE,
                   legacy.style = FALSE,
                   cex.main  = NULL,
                   cex.axis  = NULL,
                   cex.lab   = NULL,
                   cex.text  = NULL,
                   axis.adjust = FALSE,
                   color       = "#000000",
                   pre.color   = NULL,
                   post.color  = NULL,
                   count.color = "gray70",
                   count.alpha = 0.4,
                   count.outline.color = "grey69",
                   xangle    = NULL,
                   yangle    = NULL,
                   xbreaks   = NULL,
                   ybreaks   = NULL,
                   legendOff = FALSE,
                   cex.legend = NULL,
                   pre.label  = "Pre-treatment",
                   post.label = "Post-treatment"
)
{
  ## Three visual modes:
  ##  - modern    (theme.bw = TRUE,  legacy.style = FALSE): 2.3.1 default
  ##  - classic   (theme.bw = TRUE,  legacy.style = TRUE):  pre-2.3.1 white-panel default
  ##  - gray      (theme.bw = FALSE):                       legacy gray-panel look
  use_modern_recipe <- isTRUE(theme.bw) && !isTRUE(legacy.style)

  ## Default ltype: modern uses dashed vline at treatment onset; legacy uses solid.
  if (is.null(ltype)) {
    ltype <- if (use_modern_recipe) c("solid", "dashed") else c("solid", "solid")
  }

  if (is.null(est.lwidth) || is.null(est.pointsize)) {
    default_est_lwidth <- .8
    default_est_pointsize <- 3

    if (!connected) {
      default_est_lwidth <- 0.6
      default_est_pointsize <- 2
    } else {
      if (show.points) {
        default_est_lwidth <- 0.7
        default_est_pointsize <- 1.2
      } else {
        default_est_lwidth <- 1.2
        default_est_pointsize <- 3
      }
    }
    if(is.null(est.lwidth)) est.lwidth <- default_est_lwidth
    if(is.null(est.pointsize)) est.pointsize <- default_est_pointsize
  }

  all_integer_like <- function(x) {
    x_chr <- if (is.factor(x)) as.character(x) else x
    all(grepl("^[-+]?[0-9]+$", x_chr))
  }
  # If input is a fect object, extract the event-study data
  if (inherits(data, "fect")) {
    if (is.null(data$est.att)) {
      stop("The fect object does not contain 'est.att'. Run fect() with se = TRUE.")
    }
    fect_att <- as.data.frame(data$est.att)
    fect_att$Period <- as.numeric(rownames(fect_att))
    if (is.null(Period)) Period <- "Period"
    if (is.null(Count) && "count" %in% names(fect_att)) Count <- "count"
    if (is.null(Count) && "count.on" %in% names(fect_att)) {
      Count <- "count.on"
    }
    data <- fect_att
  } else if (inherits(data, "did_wrapper")) {
    data <- data$est.att
    if (is.null(Count) && "count" %in% names(data)) Count <- "count"
    if (is.null(Count) && "count.on" %in% names(data)) Count <- "count.on"
  }
  data <- as.data.frame(data)

  ## Resolve pre/post colors. Both modern and legacy keep a lightness contrast
  ## (pre = "grey50", post = color) so pre-treatment and post-treatment points
  ## are visually distinguishable. fect convention: with start0 = FALSE
  ## (default), period 0 is the LAST pre-treatment period; first post is t=1.
  ##
  ## Exception: estimand() with test = "placebo" / "carryover" attaches a
  ## "fect_test" attribute to the returned data frame; in those modes ALL
  ## event-times are special (no pre-vs-post contrast to convey), so we
  ## use a single uniform color (= `color`) across all points and skip the
  ## gray pre-treatment shade.
  fect_test <- attr(data, "fect_test")
  if (is.null(post.color)) post.color <- color
  if (is.null(pre.color)) {
    pre.color <- if (!is.null(fect_test) &&
                     fect_test %in% c("placebo", "carryover")) {
      color
    } else {
      "gray50"
    }
  }

  # Identify time/period column
  if (is.null(Period)) {
    common_period_names <- c("time", "Time", "period", "Period", "event.time", "event_time", "rel_time")
    found_period <- common_period_names[common_period_names %in% names(data)]
    if (length(found_period) > 0) {
      Period <- found_period[1]
    } else if (all_integer_like(rownames(data))) {
      data$Period_generated <- as.numeric(rownames(data))
      Period <- "Period_generated"
    } else {
      stop("Period column not specified and could not be inferred. Please specify the 'Period' argument.")
    }
  }
  if (!(Period %in% names(data))) stop(paste0("Period column '", Period, "' not found in data."))


  # Ensure Estimate column exists and is numeric
  if (!(Estimate %in% names(data))) stop(paste("Estimate column '", Estimate, "' not found in data."))
  data[[Estimate]] <- as.numeric(data[[Estimate]])

  # Ensure SE column is numeric if it exists and is specified
  if (!is.null(SE) && SE %in% names(data)) {
    data[[SE]] <- as.numeric(data[[SE]])
  }

  # --- START: Centralized CI calculation from SE ---
  # Check for CI.lower. If not present, try to calculate from SE.
  # CI.lower is the parameter name (e.g., "CI.lower" by default).
  if (!(CI.lower %in% names(data))) {
    if (!is.null(SE) && SE %in% names(data)) {
      calculated_ci_lower <- data[[Estimate]] - 1.96 * data[[SE]]
      if (any(!is.na(calculated_ci_lower))) {
        message(paste0("Column '", CI.lower, "' not found in input data. Calculating values for '", CI.lower, "' using '", Estimate, "' and '", SE, "'."))
      }
      data[[CI.lower]] <- calculated_ci_lower
    } else {
      data[[CI.lower]] <- NA_real_ # Create the column with NAs
    }
  } else { # CI.lower column exists in input data
    data[[CI.lower]] <- as.numeric(data[[CI.lower]]) # Ensure it's numeric
  }

  # Check for CI.upper. If not present, try to calculate from SE.
  if (!(CI.upper %in% names(data))) {
    if (!is.null(SE) && SE %in% names(data)) {
      calculated_ci_upper <- data[[Estimate]] + 1.96 * data[[SE]]
      if (any(!is.na(calculated_ci_upper))) {
        message(paste0("Column '", CI.upper, "' not found in input data. Calculating values for '", CI.upper, "' using '", Estimate, "' and '", SE, "'."))
      }
      data[[CI.upper]] <- calculated_ci_upper
    } else {
      data[[CI.upper]] <- NA_real_
    }
  } else { # CI.upper column exists in input data
    data[[CI.upper]] <- as.numeric(data[[CI.upper]]) # Ensure it's numeric
  }
  # --- END: Centralized CI calculation from SE ---
  # Now, 'data' is guaranteed to have columns named by CI.lower and CI.upper parameters,
  # containing original CIs, CIs from SE, or NAs. These columns are also numeric.

  # Possibly build an interpolated dataset if connected=TRUE
  if (connected) {
    min_period_val <- min(data[[Period]], na.rm = TRUE)
    max_period_val <- max(data[[Period]], na.rm = TRUE)

    if (!is.finite(min_period_val) || !is.finite(max_period_val)) {
      stop("Cannot interpolate with non-finite Period values.")
    }

    new_periods <- seq(
      from = min_period_val,
      to   = max_period_val,
      by   = 0.5
    )

    # SE for interpolation: use data[[SE]] if SE column exists, otherwise NA
    # data[[SE]] is already numeric or NA due to upfront logic.
    se_for_interp <- if (!is.null(SE) && SE %in% names(data)) {
      data[[SE]]
    } else {
      rep(NA_real_, nrow(data))
    }

    # CI columns are guaranteed to exist in 'data' and be numeric (or NA_real_).
    ci_lower_for_interp <- data[[CI.lower]]
    ci_upper_for_interp <- data[[CI.upper]]

    count_for_interp <- if (!is.null(Count) && Count %in% names(data)) {
      data[[Count]]
    } else {
      rep(NA_real_, nrow(data))
    }

    temp_data_for_interp <- data.frame(
      Period_val = data[[Period]],
      Estimate_val = data[[Estimate]],      # Already numeric
      SE_val = se_for_interp,              # Numeric or NA
      CI.lower_val = ci_lower_for_interp,  # Numeric or NA
      CI.upper_val = ci_upper_for_interp,  # Numeric or NA
      Count_val = count_for_interp
    )

    interp_col_safe <- function(y_vals) {
      if (all(is.na(y_vals))) return(rep(NA_real_, length(new_periods)))
      idx_valid_approx <- !is.na(temp_data_for_interp$Period_val) & !is.na(y_vals)
      if(sum(idx_valid_approx) < 2) return(rep(NA_real_, length(new_periods)))
      stats::approx(x = temp_data_for_interp$Period_val[idx_valid_approx],
                    y = y_vals[idx_valid_approx],
                    xout = new_periods, rule = 2)$y
    }

    df_interp <- data.frame(Period_placeholder = new_periods)
    df_interp[[Estimate]] <- interp_col_safe(temp_data_for_interp$Estimate_val)

    # Interpolate SE if SE parameter was provided
    if (!is.null(SE)) {
      # temp_data_for_interp$SE_val contains original SEs or NAs if SE column didn't exist/was all NA.
      # interp_col_safe will handle all-NA y_vals correctly.
      df_interp[[SE]] <- interp_col_safe(temp_data_for_interp$SE_val)
    }

    # Interpolate CIs. CI.lower and CI.upper are the names of the columns.
    df_interp[[CI.lower]] <- interp_col_safe(temp_data_for_interp$CI.lower_val)
    df_interp[[CI.upper]] <- interp_col_safe(temp_data_for_interp$CI.upper_val)


    if (!is.null(Count)) {
      df_interp[[Count]] <- NA_real_
      orig_t <- temp_data_for_interp$Period_val
      orig_c <- temp_data_for_interp$Count_val
      for (i in seq_len(nrow(df_interp))) {
        pval <- df_interp$Period_placeholder[i]
        if (abs(pval - round(pval)) < 1e-8) {
          idx_match <- which(abs(orig_t - pval) < 1e-8 & !is.na(orig_c))
          if (length(idx_match) >= 1) {
            df_interp[[Count]][i] <- orig_c[idx_match[1]]
          }
        }
      }
    }
    names(df_interp)[names(df_interp) == "Period_placeholder"] <- Period
    data <- df_interp
  } # End of if(connected)

  # Ensure relevant columns are numeric after potential interpolation.
  # Upfront logic and interpolation should handle this, but this is a safeguard.
  if (!is.null(SE) && SE %in% names(data)) data[[SE]] <- as.numeric(data[[SE]])
  # CI.lower and CI.upper columns are guaranteed to exist by upfront logic.
  data[[CI.lower]] <- as.numeric(data[[CI.lower]])
  data[[CI.upper]] <- as.numeric(data[[CI.upper]])


  # Check "show.count": default TRUE only if count data is available
  if (isTRUE(show.count) && (is.null(Count) || !(Count %in% names(data)))) {
    show.count <- FALSE
  }
  if (is.null(show.count)) {
    show.count <- (!is.null(Count) && Count %in% names(data))
  }
  if (!is.logical(show.count) && !is.numeric(show.count)) {
    stop("\"show.count\" must be TRUE/FALSE or NULL.")
  }
  if (show.count && is.null(Count)) {
    stop("\"Count\" column name is not specified via 'Count' parameter, but show.count is TRUE.")
  }
  if (show.count && !(Count %in% names(data))) {
    stop(paste0("Specified \"Count\" column '", Count, "' is not in the data, but show.count is TRUE."))
  }

  # Check other logical flags
  if (!is.logical(gridOff) && !gridOff %in% c(0, 1)) {
    stop("\"gridOff\" must be TRUE/FALSE.")
  }
  if (!is.logical(fill.gap) && !fill.gap %in% c(0, 1)) {
    stop("\"fill.gap\" must be TRUE/FALSE.")
  }
  if (!is.logical(axis.adjust) && !axis.adjust %in% c(0, 1)) {
    stop("\"axis.adjust\" must be TRUE/FALSE.")
  }

  # Title & label sizing (values are in pt; defaults match plot.fect)
  if (!is.null(main)) {
    if (!is.character(main)) stop("\"main\" is not a string.")
    main <- main[1]
  }
  if (!is.null(cex.main)) {
    if (!is.numeric(cex.main)) stop("\"cex.main\" must be numeric.")
  } else {
    cex.main <- if (use_modern_recipe) 11 else 16
  }

  if (!is.null(xlab) && !is.character(xlab)) stop("\"xlab\" is not a string.")
  if (!is.null(ylab) && !is.character(ylab)) stop("\"ylab\" is not a string.")

  if (!is.null(cex.lab)) {
    if (!is.numeric(cex.lab)) stop("\"cex.lab\" must be numeric.")
  } else {
    cex.lab <- if (use_modern_recipe) 10 else 15
  }

  if (!is.null(cex.axis)) {
    if (!is.numeric(cex.axis)) stop("\"cex.axis\" must be numeric.")
  } else {
    cex.axis <- if (use_modern_recipe) 9 else 15
  }

  if (!is.null(cex.text)) {
    if (!is.numeric(cex.text)) stop("\"cex.text\" must be numeric.")
  } else {
    cex.text <- if (use_modern_recipe) 3.0 else 5
  }

  # Stats
  if (!is.null(stats)) {
    stats <- c(stats)
    if (!is.numeric(stats)) {
      stop("The \"stats\" option must be numeric. Calling function should extract numeric values.")
    }
    stats_display <- formatC(stats, digits = 3, format = "f", flag = "#") # Keep as is

    n.stats <- length(stats_display)
    if (is.null(stats.labs)) {
      stats.labs <- rep("", n.stats)
    } else if (length(stats.labs) != n.stats) {
      stop("The \"stats.labs\" option should have the same length as \"stats\".")
    }
  }
  # Validation for stats.pos (already present and correct)
  if (!is.null(stats.pos)) {
    if (length(stats.pos) != 2) {
      stop("\"stats.pos\" must be of length 2.")
    }
    if (!is.numeric(stats.pos[1]) || !is.numeric(stats.pos[2])) {
      stop("Elements of \"stats.pos\" must be numeric.")
    }
  }


  # Axis rotation
  if (axis.adjust) {
    angle <- 45
    x.v <- 1 # vjust for x-axis text
    x.h <- 1 # hjust for x-axis text
  } else {
    angle <- 0
    x.v <- 0.5
    x.h <- 0.5
  }

  # xlim, ylim checks (user-provided)
  user_xlim <- xlim
  user_ylim <- ylim
  if (!is.null(user_xlim)) {
    if (!is.numeric(user_xlim) || length(user_xlim) != 2) {
      stop("\"xlim\" must be a numeric vector of length 2.")
    }
    if(user_xlim[1] > user_xlim[2]) user_xlim <- rev(user_xlim) # Ensure min < max
  }
  if (!is.null(user_ylim)) {
    if (!is.numeric(user_ylim) || length(user_ylim) != 2) {
      stop("\"ylim\" must be a numeric vector of length 2.")
    }
    if(user_ylim[1] > user_ylim[2]) user_ylim <- rev(user_ylim) # Ensure min < max
  }

  # Default axis labels
  if (is.null(xlab)) {
    xlab <- "Time Relative to Treatment"
  } else if (xlab == "") {
    xlab <- NULL # ggplot prefers NULL for no label
  }
  if (is.null(ylab)) {
    ylab <- "Effect on Y"
  } else if (ylab == "") {
    ylab <- NULL
  }

  if (is.null(lcolor)) {
    if (use_modern_recipe) {
      lcolor <- "grey75"
    } else if (isTRUE(theme.bw)) {
      lcolor <- "#AAAAAA70"  # pre-2.3.1 default for theme.bw=TRUE (classic mode)
    } else {
      lcolor <- "white" # This might be invisible on a white background if not theme_bw
    }
  }

  if (length(as.vector(lcolor)) == 1) {
    lcolor <- rep(lcolor, 2)
  } else if (length(as.vector(lcolor)) != 2) {
    stop("\"lcolor\" must be a numeric vector of length 1 or 2.")
  }
  if (is.null(lwidth)) {
    if (use_modern_recipe) {
      lwidth <- 0.4
    } else if (isTRUE(theme.bw)) {
      lwidth <- 1.5  # pre-2.3.1 default for theme.bw=TRUE (classic mode)
    } else {
      lwidth <- 2
    }
  }
  if (length(as.vector(lwidth)) == 1) {
    lwidth <- rep(lwidth, 2)
  } else if (length(as.vector(lwidth)) != 2) {
    stop("\"lwidth\" must be a numeric vector of length 1 or 2.")
  }

  # Prepare data vectors for plotting logic
  current_time_vec <- data[[Period]]
  current_att_vec  <- data[[Estimate]]

  # CI.lower and CI.upper columns are now guaranteed to exist in 'data'
  # and be numeric (or NA_real_). Their names are given by the CI.lower and CI.upper parameters.
  CI.lower.val <- data[[CI.lower]]
  CI.upper.val <- data[[CI.upper]]

  current_count_vec <- if (!is.null(Count) && Count %in% names(data)) {
    data[[Count]]
  } else {
    rep(NA_real_, length(current_time_vec))
  }

  # Determine initial final_xlim for plotting
  final_xlim <- user_xlim
  if (is.null(final_xlim)) {
    if (show.count && !is.null(Count) && Count %in% names(data) && any(!is.na(data[[Count]]))) {
      finite_counts <- data[[Count]][is.finite(data[[Count]])]
      if (length(finite_counts) > 0) {
        maxC <- max(finite_counts, na.rm = TRUE)
        if (is.finite(maxC) && maxC > 0) {
          threshold <- maxC * proportion
          idx_valid_count_times <- data[[Count]] >= threshold & !is.na(data[[Count]]) & is.finite(data[[Period]])
          valid_times <- data[[Period]][idx_valid_count_times]

          if (length(valid_times) > 0) {
            final_xlim <- range(valid_times, na.rm = TRUE)
          } else {
            idx_finite_period <- is.finite(data[[Period]])
            final_xlim <- range(data[[Period]][idx_finite_period], na.rm = TRUE)
          }
        } else {
          idx_finite_period <- is.finite(data[[Period]])
          final_xlim <- range(data[[Period]][idx_finite_period], na.rm = TRUE)
        }
      } else {
        idx_finite_period <- is.finite(data[[Period]])
        final_xlim <- range(data[[Period]][idx_finite_period], na.rm = TRUE)
      }
    } else {
      idx_finite_period <- is.finite(data[[Period]])
      final_xlim <- range(data[[Period]][idx_finite_period], na.rm = TRUE)
    }
    if (any(!is.finite(final_xlim))) {
      idx_finite_period <- is.finite(data[[Period]])
      valid_times <- data[[Period]][idx_finite_period]
      if(length(valid_times) > 0) final_xlim <- range(valid_times) else final_xlim <- c(0,1)
    }
    if (final_xlim[1] == final_xlim[2]) final_xlim <- final_xlim + c(-0.5, 0.5)
  }


  # fill.gap logic
  time_vec_for_fillgap <- current_time_vec
  att_vec_for_fillgap  <- current_att_vec
  ci_l_vec_for_fillgap <- CI.lower.val # These are from data[[CI.lower]]
  ci_u_vec_for_fillgap <- CI.upper.val # These are from data[[CI.upper]]
  count_vec_for_fillgap<- current_count_vec

  if (fill.gap && !connected) {
    idx_finite_time <- is.finite(time_vec_for_fillgap)
    min_time_fill <- min(time_vec_for_fillgap[idx_finite_time], na.rm = TRUE)
    max_time_fill <- max(time_vec_for_fillgap[idx_finite_time], na.rm = TRUE)

    if (is.finite(min_time_fill) && is.finite(max_time_fill) && min_time_fill <= max_time_fill) {
      idx_finite_unique_times <- !is.na(time_vec_for_fillgap) & is.finite(time_vec_for_fillgap)
      unique_times_present <- unique(time_vec_for_fillgap[idx_finite_unique_times])


      diff_times <- diff(sort(unique_times_present))
      idx_valid_diffs <- is.finite(diff_times) & diff_times > 1e-9
      valid_diffs <- diff_times[idx_valid_diffs]

      step_by <- if(length(valid_diffs) > 0 && all(abs(valid_diffs - round(valid_diffs)) < 1e-9)) {
        1
      } else if (length(valid_diffs) > 0) {
        min(valid_diffs, na.rm = TRUE)
      } else {
        1
      }

      if(!is.finite(step_by) || step_by <= 1e-9) step_by <- 1

      if ( (max_time_fill - min_time_fill)/step_by + 1 > length(unique_times_present) ) {
        full_seq <- seq(min_time_fill, max_time_fill, by = step_by)
        time.add <- setdiff(full_seq, unique_times_present)
        if (length(time.add) > 0) {
          att_vec_for_fillgap  <- c(att_vec_for_fillgap, rep(0, length(time.add)))
          ci_l_vec_for_fillgap <- c(ci_l_vec_for_fillgap, rep(0, length(time.add)))
          ci_u_vec_for_fillgap <- c(ci_u_vec_for_fillgap, rep(0, length(time.add)))
          count_vec_for_fillgap<- c(count_vec_for_fillgap, rep(NA, length(time.add)))
          time_vec_for_fillgap <- c(time_vec_for_fillgap, time.add)
        }
      }
    }
  }

  plot_data <- data.frame(
    time = time_vec_for_fillgap
  )
  plot_data[[Estimate]] <- att_vec_for_fillgap
  plot_data[[CI.lower]] <- ci_l_vec_for_fillgap # Use the parameter name as col name
  plot_data[[CI.upper]] <- ci_u_vec_for_fillgap # Use the parameter name as col name
  if(!is.null(Count)) plot_data[[Count]] <- count_vec_for_fillgap
  else plot_data[["count_placeholder"]] <- count_vec_for_fillgap

  names(plot_data)[names(plot_data) == "time"] <- Period


  # Apply only.pre/only.post modifications to final_xlim
  if (!is.null(final_xlim) && all(is.finite(final_xlim))){
    if (only.pre) {
      final_xlim[2] <- min(final_xlim[2], 0, na.rm = TRUE)
      if (start0) final_xlim[2] <- min(final_xlim[2], -0.5, na.rm=TRUE)
    } else if (only.post) {
      final_xlim[1] <- max(final_xlim[1], 0, na.rm = TRUE)
      if (!start0) final_xlim[1] <- max(final_xlim[1], 0.5, na.rm=TRUE)
    }
    if(final_xlim[1] > final_xlim[2]) final_xlim <- rev(final_xlim)
  }

  if (!is.null(final_xlim)) {
    needs_resolve_min <- is.na(final_xlim[1]) || !is.finite(final_xlim[1])
    needs_resolve_max <- is.na(final_xlim[2]) || !is.finite(final_xlim[2])

    idx_finite_times_plot_data <- is.finite(plot_data[[Period]])
    finite_times_in_plot_data <- plot_data[[Period]][idx_finite_times_plot_data]
    data_derived_min_time <- if(length(finite_times_in_plot_data) > 0) min(finite_times_in_plot_data, na.rm=TRUE) else 0
    data_derived_max_time <- if(length(finite_times_in_plot_data) > 0) max(finite_times_in_plot_data, na.rm=TRUE) else 1
    if (data_derived_min_time > data_derived_max_time) { data_derived_min_time <- 0; data_derived_max_time <- 1; }


    if (needs_resolve_min) final_xlim[1] <- data_derived_min_time
    if (needs_resolve_max) final_xlim[2] <- data_derived_max_time


    if (final_xlim[1] > final_xlim[2]) {
      final_xlim <- range(c(data_derived_min_time, data_derived_max_time, final_xlim))
    }
    if (final_xlim[1] == final_xlim[2]) {
      final_xlim <- final_xlim + c(-0.5, 0.5)
    }
    idx <- plot_data[[Period]] >= final_xlim[1] &
      plot_data[[Period]] <= final_xlim[2]
    plot_data <- plot_data[idx, ]

  }


  if(nrow(plot_data) == 0 && !(is.null(final_xlim) && is.null(user_ylim))) {
    warning("No data points remaining after applying xlim/filters. Plot will be empty or may error.")
    empty_df_structure <- data.frame(temp_period = numeric(0), temp_est = numeric(0), temp_cil = numeric(0), temp_ciu = numeric(0))
    names(empty_df_structure) <- c(Period, Estimate, CI.lower, CI.upper)
    if(!is.null(Count)) empty_df_structure[[Count]] <- numeric(0)
    plot_data <- empty_df_structure
  }

  # Determine final ylim for plotting
  final_ylim <- user_ylim
  if (is.null(final_ylim)) {
    y_min_series <- plot_data[[Estimate]]
    y_max_series <- plot_data[[Estimate]]
    # CI.lower and CI.upper columns are guaranteed to be in plot_data
    idx_finite_cil <- is.finite(plot_data[[CI.lower]])
    y_min_series <- c(y_min_series, plot_data[[CI.lower]][idx_finite_cil])

    idx_finite_ciu <- is.finite(plot_data[[CI.upper]])
    y_max_series <- c(y_max_series, plot_data[[CI.upper]][idx_finite_ciu])


    idx_finite_ymin <- is.finite(y_min_series)
    y_min_data <- min(y_min_series[idx_finite_ymin], na.rm = TRUE)
    idx_finite_ymax <- is.finite(y_max_series)
    y_max_data <- max(y_max_series[idx_finite_ymax], na.rm = TRUE)


    if (!is.finite(y_min_data) && !is.finite(y_max_data) && nrow(plot_data)==0) {
      y_min_data <- 0; y_max_data <- 1;
    } else {
      if (!is.finite(y_min_data)) y_min_data <- if(is.finite(y_max_data)) y_max_data -1 else 0
      if (!is.finite(y_max_data)) y_max_data <- if(is.finite(y_min_data)) y_min_data +1 else 1
    }
    if (y_min_data == y_max_data) {
      y_min_data <- y_min_data - 0.5
      y_max_data <- y_max_data + 0.5
    }

    range_val <- y_max_data - y_min_data
    if (!is.finite(range_val) || range_val == 0) range_val <- 1

    ## Modern recipe: small top padding so the highest CI doesn't graze the panel
    ## ceiling, larger top padding when stats annotation is drawn at top-left.
    ## Legacy: keep zero top padding (preserve the pre-2.3.1 layout).
    top_expand_factor <- if (use_modern_recipe) 0.08 else 0
    bot_expand_factor <- 0

    p_label_text_for_ylim_calc <- function(stats_vals, labs_vals) {
      text <- ""
      s_display <- formatC(stats_vals, digits = 3, format = "f", flag = "#")
      for (k in seq_along(s_display)) {
        text <- paste0(text, labs_vals[k], ifelse(labs_vals[k]=="", "", ": "), s_display[k], "\n")
      }
      sub("\n$", "", text)
    }
    if (!is.null(stats)) {
      num_stat_lines <- ceiling(length(unlist(strsplit(p_label_text_for_ylim_calc(stats, stats.labs), "\n"))))
      ## Reserve room for the stats annotation block at the top.
      ## Per-line factor accounts for the 1.25x text size used below;
      ## doubled from 0.06 to 0.12 so stats text doesn't graze the
      ## leftmost CIs on data with high pre-treatment estimates.
      if (use_modern_recipe) {
        top_expand_factor <- top_expand_factor + 0.12 * num_stat_lines
      }
    }
    if (show.count && !is.null(Count) && Count %in% names(plot_data)) {
      idx_valid_count_plot_data <- !is.na(plot_data[[Count]]) & plot_data[[Count]] > 0
      if (any(idx_valid_count_plot_data)) {
        bot_expand_factor <- bot_expand_factor + 0.35
      }
    } else if (use_modern_recipe) {
      ## No count bars => still reserve a small bottom margin for breathing room
      bot_expand_factor <- bot_expand_factor + 0.06
    }

    final_ylim <- c(
      y_min_data - bot_expand_factor * range_val,
      y_max_data + top_expand_factor * range_val
    )
    if(any(!is.finite(final_ylim))) {
      final_ylim <- c(y_min_data, y_max_data)
      if(final_ylim[1] == final_ylim[2]) final_ylim <- final_ylim + c(-0.5, 0.5)
    }
  }


  p <- ggplot(data = plot_data)


  if (use_modern_recipe) {
    p <- p + .modern_theme(base_size = 11)
  } else if (isTRUE(theme.bw)) {
    p <- p + ggplot2::theme_bw()
  }
  if (gridOff) {
    p <- p + theme(
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank()
    )
  }

  ## Modern: peach (or auto-lightened) rectangle behind highlight periods,
  ## drawn before data layers so points/lines paint on top. Opt-in via
  ## `highlight.fill = TRUE`. Default is FALSE: the colored glyph alone is
  ## sufficient signal that a period is part of a test window, and the
  ## glyph-only look survives grayscale printing without surprise.
  if (use_modern_recipe && isTRUE(highlight.fill) &&
      !is.null(highlight.periods) && length(highlight.periods) > 0) {
    hl_n <- length(highlight.periods)
    hl_pt_colors <- if (!is.null(highlight.colors) && length(highlight.colors) == hl_n) {
      highlight.colors
    } else {
      rep(.MODERN_PLACEBO_PT, hl_n)
    }
    for (i in seq_len(hl_n)) {
      hl_fill_i <- .lighten_color(hl_pt_colors[i], amount = 0.70)
      p <- p + annotate("rect",
                        xmin = as.numeric(highlight.periods[i]) - 0.5,
                        xmax = as.numeric(highlight.periods[i]) + 0.5,
                        ymin = -Inf, ymax = Inf,
                        fill = hl_fill_i, alpha = 0.55)
    }
  }

  p <- p + geom_hline(yintercept = 0, colour = lcolor[1], linewidth = lwidth[1], linetype = ltype[1])

  vline_pos <- if (start0) -0.5 else 0.5
  show_vline <- TRUE
  if (only.pre || only.post) show_vline <- FALSE
  if (!is.null(final_xlim) && all(is.finite(final_xlim))) {
    if (vline_pos < final_xlim[1] || vline_pos > final_xlim[2]) {
      show_vline <- FALSE
    }
  } else if (is.null(final_xlim)) {
    if (nrow(plot_data) > 0 && Period %in% names(plot_data)) {
      idx_finite_period_plot_data <- is.finite(plot_data[[Period]])
      if (any(idx_finite_period_plot_data)) {
        data_period_range <- range(plot_data[[Period]][idx_finite_period_plot_data], na.rm = TRUE)
        if (vline_pos < data_period_range[1] || vline_pos > data_period_range[2]) show_vline <- FALSE
      } else {
        show_vline <- FALSE
      }
    } else {
      show_vline <- FALSE
    }
  }


  if (show_vline) {
    p <- p + geom_vline(
      xintercept = vline_pos, colour = lcolor[2],
      linewidth = lwidth[2], linetype = ltype[2]
    )
  }


  intervals <- NULL
  if (!is.null(highlight.periods) && length(highlight.periods) > 0) {
    if (is.null(highlight.colors) || length(highlight.colors) != length(highlight.periods)) {
      warning("highlight.colors not provided or mismatched length; using default rainbow colors.")
      highlight.colors <- grDevices::rainbow(length(highlight.periods))
    }
    if (is.null(highlight.shapes) || length(highlight.shapes) != length(highlight.periods)) {
      highlight.shapes <- rep(19, length(highlight.periods))
    }
    intervals <- data.frame(
      start = highlight.periods - 0.5,
      end   = highlight.periods + 0.5,
      color = highlight.colors,
      shape = highlight.shapes
    )
  }

  remove_strictly_inside <- function(df, intervals_df, estimate_col, ci_l_col, ci_u_col, period_col) {
    if (is.null(intervals_df) || nrow(intervals_df) == 0) return(df)
    out_df <- df
    for (i in seq_len(nrow(intervals_df))) {
      s <- intervals_df$start[i]
      e <- intervals_df$end[i]
      idx_to_na <- which(out_df[[period_col]] > s & out_df[[period_col]] < e)
      if(length(idx_to_na) > 0) {
        out_df[[estimate_col]][idx_to_na] <- NA
        if(ci_l_col %in% names(out_df)) out_df[[ci_l_col]][idx_to_na] <- NA
        if(ci_u_col %in% names(out_df)) out_df[[ci_u_col]][idx_to_na] <- NA
      }
    }
    return(out_df)
  }

  ## Helper: add connected layers (ribbon + line + optional points) for a data subset
  .add_connected_layers <- function(p, df, col, lt, Period, Estimate, CI.lower, CI.upper,
                                    est.lwidth, est.pointsize, show.points, ci.outline,
                                    point.shape = 19) {
    if (nrow(df) == 0) return(p)
    outline_col <- ifelse(ci.outline, grDevices::adjustcolor(col, offset = c(0.3,0.3,0.3,0)), NA)
    p <- p +
      geom_ribbon(data = df, aes(x = .data[[Period]], ymin = .data[[CI.lower]], ymax = .data[[CI.upper]]),
                  fill = col, alpha = 0.2, inherit.aes = FALSE, na.rm = TRUE, color = outline_col) +
      geom_line(data = df, aes(x = .data[[Period]], y = .data[[Estimate]]),
                linewidth = est.lwidth, color = col, linetype = lt, inherit.aes = FALSE, na.rm = TRUE)
    if (show.points) {
      idx_int <- abs(as.numeric(df[[Period]]) - round(as.numeric(df[[Period]]))) < 1e-8 & !is.na(df[[Estimate]])
      df_int <- df[idx_int, ]
      if (nrow(df_int) > 0) {
        ## Non-circle shapes (triangles, diamonds) appear smaller at the same
        ## nominal size; scale up by 1.5× so they match circle visual weight
        ## Triangle (17) and diamond (18) glyphs render at a larger visual
        ## area than circle (19) at the same size aesthetic. Scale them down
        ## by 0.85 so highlight overlays look slightly smaller (not larger)
        ## than the base circles in the same plot.
        pt_size <- if (point.shape != 19) est.pointsize * 0.85 else est.pointsize
        p <- p + geom_point(data = df_int, aes(x = .data[[Period]], y = .data[[Estimate]]),
                            size = pt_size, color = col, shape = point.shape,
                            inherit.aes = FALSE, na.rm = TRUE)
      }
    }
    p
  }

  ## Split plot_data into pre-treatment and post-treatment
  ## When start0 = TRUE, period 0 is the first post-treatment period
  if (start0) {
    is_pre  <- plot_data[[Period]] < 0
    is_post <- plot_data[[Period]] >= 0
  } else {
    is_pre  <- plot_data[[Period]] <= 0
    is_post <- plot_data[[Period]] > 0
  }
  data_pre  <- plot_data[is_pre, ]
  data_post <- plot_data[is_post, ]

  if (connected) {
    data_base <- plot_data
    if (!is.null(intervals) && nrow(intervals) > 0) {
      data_base <- remove_strictly_inside(data_base, intervals, Estimate, CI.lower, CI.upper, Period)
    }
    if (start0) {
      data_base_pre  <- data_base[data_base[[Period]] < 0, ]
      data_base_post <- data_base[data_base[[Period]] >= 0, ]
    } else {
      data_base_pre  <- data_base[data_base[[Period]] <= 0, ]
      data_base_post <- data_base[data_base[[Period]] > 0, ]
    }

    ## Pre-treatment: long-dashed line
    p <- .add_connected_layers(p, data_base_pre, pre.color, "longdash",
                               Period, Estimate, CI.lower, CI.upper,
                               est.lwidth, est.pointsize, show.points, ci.outline)
    ## Post-treatment: solid line
    p <- .add_connected_layers(p, data_base_post, post.color, "solid",
                               Period, Estimate, CI.lower, CI.upper,
                               est.lwidth, est.pointsize, show.points, ci.outline)

    ## Bridge segment: connect the last pre point to the first post point
    ## When start0=FALSE: pre ends at 0, post starts at 0.5 → bridge 0→0.5
    ## When start0=TRUE:  pre ends at -0.5, post starts at 0 → bridge -0.5→0
    if (start0) {
      bridge_from <- -0.5; bridge_to <- 0
    } else {
      bridge_from <- 0; bridge_to <- 0.5
    }
    idx_from <- which(abs(data_base[[Period]] - bridge_from) < 1e-8)
    idx_to   <- which(abs(data_base[[Period]] - bridge_to)   < 1e-8)
    if (length(idx_from) > 0 && length(idx_to) > 0) {
      bridge_df <- data_base[c(idx_from[1], idx_to[1]), ]
      p <- .add_connected_layers(p, bridge_df, pre.color, "longdash",
                                 Period, Estimate, CI.lower, CI.upper,
                                 est.lwidth, est.pointsize, FALSE, ci.outline)
    }

    ## Highlight interval overlays (e.g., placebo, carryover)
    if (!is.null(intervals) && nrow(intervals) > 0) {
      for (i in seq_len(nrow(intervals))) {
        sub_color <- intervals$color[i]
        sub_shape <- if (!is.null(intervals$shape)) intervals$shape[i] else 19
        idx_sub <- plot_data[[Period]] >= intervals$start[i] & plot_data[[Period]] <= intervals$end[i]
        sub.data <- plot_data[idx_sub, ]
        p <- .add_connected_layers(p, sub.data, sub_color, "solid",
                                   Period, Estimate, CI.lower, CI.upper,
                                   est.lwidth, est.pointsize, show.points, ci.outline,
                                   point.shape = sub_shape)
      }
    }
  } else { # Not connected
    ## When highlight overlays will be drawn, exclude those periods from
    ## the base pre/post layer so we don't render two stacked symbols
    ## (a base circle peeking out from under the highlight triangle / diamond).
    base_pre  <- data_pre
    base_post <- data_post
    if (!is.null(highlight.periods) && length(highlight.periods) > 0) {
      hp_set <- as.numeric(highlight.periods)
      base_pre  <- base_pre[!(as.numeric(base_pre[[Period]])  %in% hp_set), ]
      base_post <- base_post[!(as.numeric(base_post[[Period]]) %in% hp_set), ]
    }
    ## Pre-treatment points
    if (nrow(base_pre) > 0) {
      p <- p + geom_pointrange(
        data = base_pre,
        aes(x = .data[[Period]], y = .data[[Estimate]], ymin = .data[[CI.lower]], ymax = .data[[CI.upper]]),
        linewidth = est.lwidth, color = pre.color, fill = pre.color,
        size = est.pointsize / 6,
        inherit.aes = FALSE, na.rm = TRUE)
    }
    ## Post-treatment points
    if (nrow(base_post) > 0) {
      p <- p + geom_pointrange(
        data = base_post,
        aes(x = .data[[Period]], y = .data[[Estimate]], ymin = .data[[CI.lower]], ymax = .data[[CI.upper]]),
        linewidth = est.lwidth, color = post.color, fill = post.color,
        size = est.pointsize / 6,
        inherit.aes = FALSE, na.rm = TRUE)
    }

    ## Highlight overlays
    if (!is.null(highlight.periods) && length(highlight.periods) > 0) {
      for (i in seq_along(highlight.periods)) {
        hp_period <- highlight.periods[i]
        hp_color <- highlight.colors[i]
        hp_shape <- if (!is.null(highlight.shapes)) highlight.shapes[i] else 19
        idx_sub <- as.numeric(plot_data[[Period]]) == hp_period
        sub_data_point <- plot_data[idx_sub, ]
        if (nrow(sub_data_point) > 0) {
          if (hp_shape != 19) {
            # Use linerange + point to support custom shapes
            p <- p + geom_linerange(
              data = sub_data_point,
              aes(x = .data[[Period]], ymin = .data[[CI.lower]], ymax = .data[[CI.upper]]),
              linewidth = est.lwidth, color = hp_color, inherit.aes = FALSE, na.rm = TRUE)
            p <- p + geom_point(
              data = sub_data_point,
              aes(x = .data[[Period]], y = .data[[Estimate]]),
              ## Diamonds (shape 18) have less glyph area than triangles (17)
              ## at the same nominal size, so scale them up to match the
              ## triangle's visual weight.
              size = if (hp_shape == 18) est.pointsize * 1.3 else est.pointsize * 0.9,
              color = hp_color, shape = hp_shape,
              inherit.aes = FALSE, na.rm = TRUE)
          } else {
            p <- p + geom_pointrange(
              data = sub_data_point,
              aes(x = .data[[Period]], y = .data[[Estimate]], ymin = .data[[CI.lower]], ymax = .data[[CI.upper]]),
              linewidth = est.lwidth, color = hp_color, fill = hp_color,
              size = est.pointsize / 6,
              inherit.aes = FALSE, na.rm = TRUE)
          }
        }
      }
    }
  }

  # Build shape legend when highlight shapes differ from base circle.
  # Modern theme suppresses this legend when the highlight rect is drawn ---
  # the peach/blue background + colored points self-document, and the
  # pre/post legend entries are misleading (both render in grey20).
  modern_suppresses_legend <- use_modern_recipe &&
    !is.null(highlight.periods) && length(highlight.periods) > 0
  if (!is.null(highlight.shapes) && any(highlight.shapes != 19) &&
      !legendOff && !modern_suppresses_legend) {
    unique_shapes <- unique(highlight.shapes[highlight.shapes != 19])

    # Standard shape label map
    shape_label_map <- c("17" = "Placebo Test", "18" = "Carryover Test",
                          "15" = "Square", "8" = "Asterisk")

    # Build legend entries conditionally:
    # - Include "Pre-treatment" only if pre-treatment data is shown
    # - Include "Post-treatment" only if post-treatment data is shown (not only.pre)
    legend_ids    <- c()
    legend_shapes <- c()
    legend_colors <- c()
    legend_labels <- c()

    has_pre  <- nrow(data_pre) > 0
    has_post <- nrow(data_post) > 0 && !only.pre

    if (has_pre) {
      legend_ids    <- c(legend_ids, "pre")
      legend_shapes <- c(legend_shapes, 19)
      legend_colors <- c(legend_colors, pre.color)
      legend_labels <- c(legend_labels, pre.label)
    }
    if (has_post) {
      legend_ids    <- c(legend_ids, "post")
      legend_shapes <- c(legend_shapes, 19)
      legend_colors <- c(legend_colors, post.color)
      legend_labels <- c(legend_labels, post.label)
    }

    # Map each unique highlight shape to its color from highlight.colors
    for (s in unique_shapes) {
      s_chr <- as.character(s)
      lbl <- if (s_chr %in% names(shape_label_map)) shape_label_map[s_chr] else paste("Shape", s)
      idx <- which(highlight.shapes == s)[1]
      hcol <- if (!is.null(highlight.colors) && !is.na(idx)) highlight.colors[idx] else color
      legend_ids    <- c(legend_ids, s_chr)
      legend_shapes <- c(legend_shapes, s)
      legend_colors <- c(legend_colors, hcol)
      legend_labels <- c(legend_labels, lbl)
    }
    names(legend_shapes) <- legend_ids
    names(legend_colors) <- legend_ids
    names(legend_labels) <- legend_ids

    legend_df <- data.frame(
      x = rep(NA_real_, length(legend_ids)),
      y = rep(NA_real_, length(legend_ids)),
      legend_id = legend_ids,
      stringsAsFactors = FALSE
    )

    # Use 2 rows when 4+ legend entries to avoid overflow
    legend_nrow <- if (length(legend_ids) >= 4) 2 else 1

    p <- p + geom_point(
      data = legend_df,
      aes(x = x, y = y, shape = legend_id, color = legend_id),
      na.rm = TRUE, inherit.aes = FALSE
    ) +
      ggplot2::scale_shape_manual(
        values = legend_shapes,
        labels = legend_labels,
        name = NULL
      ) +
      ggplot2::scale_color_manual(
        values = legend_colors,
        labels = legend_labels,
        name = NULL
      ) +
      guides(shape = guide_legend(nrow = legend_nrow, title = NULL),
             color = guide_legend(nrow = legend_nrow, title = NULL)) +
      theme(legend.position = "bottom",
            legend.box = "vertical",
            legend.margin = margin(0, 0, 0, 0),
            legend.text = element_text(size = if (!is.null(cex.legend)) cex.legend * 0.6 else 8),
            plot.margin = margin(5, 5, 15, 5))
  }

  ## Title styling: modern recipe is plain + left-aligned; legacy is bold + centered.
  modern_title_face  <- if (use_modern_recipe) "plain" else "bold"
  modern_title_hjust <- if (use_modern_recipe) 0     else 0.5

  p <- p +
    xlab(xlab) + ylab(ylab) +
    theme(
      axis.title  = element_text(size = cex.lab),
      axis.text   = element_text(color = "black", size = cex.axis),
      axis.text.x = element_text(angle = angle, vjust = x.v, hjust = x.h),
      plot.title  = element_text(size = cex.main, hjust = modern_title_hjust, face = modern_title_face)
    )



  if (show.count && !is.null(Count) && Count %in% names(plot_data)) {
    idx_rect_data <- !is.na(plot_data[[Count]]) & plot_data[[Count]] > 0
    rect_data <- plot_data[idx_rect_data, ]

    if(nrow(rect_data) > 0) {
      rect_data[[Period]] <- as.numeric(rect_data[[Period]])

      rect_data[,"xmin"] <- rect_data[[Period]] - 0.2
      rect_data[,"xmax"] <- rect_data[[Period]] + 0.2

      plot_range_y <- final_ylim[2] - final_ylim[1]
      if(!is.finite(plot_range_y) || plot_range_y <=0) plot_range_y <- 1

      ## Divide the bot_expand space into bars (bottom 50%) and gap (top 50%)
      ## This guarantees a visible gap without feedback loops
      bot_space <- if (exists("y_min_data") && is.finite(y_min_data)) {
        y_min_data - final_ylim[1]
      } else {
        plot_range_y * 0.35
      }
      rect_bar_max_h <- bot_space * 0.50
      rect.min_yval  <- final_ylim[1]

      max_rect_count <- max(rect_data[[Count]], na.rm = TRUE)

      if (is.finite(max_rect_count) && max_rect_count > 0) {
        rect_data[,"ymin"] <- rect.min_yval
        rect_data[,"ymax"] <- rect.min_yval + (rect_data[[Count]] / max_rect_count) * rect_bar_max_h
        p <- p + geom_rect(
          data = rect_data, aes(xmin = .data$xmin, xmax = .data$xmax, ymin = .data$ymin, ymax = .data$ymax),
          fill = count.color, linewidth = 0.2, inherit.aes = FALSE, alpha = count.alpha, color = count.outline.color)

        max_count_val <- max_rect_count
        idx_max_count <- which(rect_data[[Count]] == max_count_val)
        max_count_time_pos <- rect_data[[Period]][idx_max_count[1]]

        if (length(idx_max_count) > 1) {
          preferred_pos <- if (start0) -1 else 0
          idx_preferred_pos_in_max <- rect_data[[Period]][idx_max_count] == preferred_pos
          if (any(idx_preferred_pos_in_max)) {
            max_count_time_pos <- preferred_pos
          } else {
            if(!is.null(final_xlim) && all(is.finite(final_xlim))){
              xlim_center <- mean(final_xlim)
              max_count_time_pos <- rect_data[[Period]][idx_max_count[which.min(abs(rect_data[[Period]][idx_max_count] - xlim_center))]]
            }
          }
        }
        p <- p + annotate("text",
                          x = max_count_time_pos,
                          y = rect.min_yval + rect_bar_max_h + 0.02 * plot_range_y,
                          label = format(max_count_val, big.mark=","),
                          size = cex.text * 0.7,
                          hjust = 0.5)
      }
    }
  }

  if (!is.null(stats)) {
    actual_stats_pos <- stats.pos
    stats_hjust_val <- 0
    stats_vjust_val <- 1

    if (is.null(actual_stats_pos)) {
      x_min_for_stats <- if(!is.null(final_xlim) && is.finite(final_xlim[1])) final_xlim[1] else {
        if(nrow(plot_data) > 0 && Period %in% names(plot_data)) {
          idx_finite_period_plot_data <- is.finite(plot_data[[Period]])
          if(any(idx_finite_period_plot_data)) min(plot_data[[Period]][idx_finite_period_plot_data], na.rm = TRUE) else 0
        } else 0
      }
      x_max_for_stats <- if(!is.null(final_xlim) && is.finite(final_xlim[2])) final_xlim[2] else {
        if(nrow(plot_data) > 0 && Period %in% names(plot_data)) {
          idx_finite_period_plot_data <- is.finite(plot_data[[Period]])
          if(any(idx_finite_period_plot_data)) max(plot_data[[Period]][idx_finite_period_plot_data], na.rm = TRUE) else 1
        } else 1
      }
      if (x_min_for_stats >= x_max_for_stats) {
        x_max_for_stats <- x_min_for_stats + 1
      }


      y_min_for_stats <- if(is.finite(final_ylim[1])) final_ylim[1] else {
        y_coords <- c(plot_data[[Estimate]], plot_data[[CI.lower]], plot_data[[CI.upper]])
        idx_finite_y_coords <- is.finite(y_coords)
        y_coords <- y_coords[idx_finite_y_coords]
        if(length(y_coords) > 0) min(y_coords, na.rm = TRUE) else 0
      }
      y_max_for_stats <- if(is.finite(final_ylim[2])) final_ylim[2] else {
        y_coords <- c(plot_data[[Estimate]], plot_data[[CI.lower]], plot_data[[CI.upper]])
        idx_finite_y_coords <- is.finite(y_coords)
        y_coords <- y_coords[idx_finite_y_coords]
        if(length(y_coords) > 0) max(y_coords, na.rm = TRUE) else 1
      }
      if (y_min_for_stats >= y_max_for_stats) {
        y_max_for_stats <- y_min_for_stats + 1
      }

      current_x_range <- x_max_for_stats - x_min_for_stats
      if (!is.finite(current_x_range) || current_x_range <= 1e-9) current_x_range <- 1

      current_y_range <- y_max_for_stats - y_min_for_stats
      if (!is.finite(current_y_range) || current_y_range <= 1e-9) current_y_range <- 1

      ## Modern: symmetric inset from the top-left panel corner so the
      ## stats block looks anchored, not floating mid-panel. Both factors
      ## are 2.5% of their respective ranges; the slight pixel asymmetry
      ## from non-square panels (width:height ~ 1.33 for typical fect
      ## plots) is small enough to read as visually symmetric. Legacy
      ## keeps its pre-2.3.1 0.02/0.02 placement.
      padding_x_factor <- if (use_modern_recipe) 0.025 else 0.02
      padding_y_factor <- if (use_modern_recipe) 0.025 else 0.02

      actual_stats_pos <- c(
        x_min_for_stats + padding_x_factor * current_x_range,
        y_max_for_stats - padding_y_factor * current_y_range
      )

      if(!is.finite(actual_stats_pos[1])) actual_stats_pos[1] <- x_min_for_stats
      if(!is.finite(actual_stats_pos[2])) actual_stats_pos[2] <- y_max_for_stats
    }

    p_label_text <- ""
    for (ii in seq_along(stats_display)) {
      p_label_text <- paste0(p_label_text, stats.labs[ii], ifelse(stats.labs[ii]=="", "", ": "), stats_display[ii], "\n")
    }
    p_label_text <- sub("\n$", "", p_label_text)

    p <- p + annotate("text",
                      x = actual_stats_pos[1], y = actual_stats_pos[2],
                      label = p_label_text,
                      size = if (use_modern_recipe) cex.text * 1.0 else cex.text,
                      hjust = stats_hjust_val,
                      vjust = stats_vjust_val,
                      lineheight = .8)
  }


  if (is.null(main)) {
    p <- p + ggtitle("Estimated Dynamic Treatment Effects")
  } else if (main != "") {
    p <- p + ggtitle(main)
  }
  p <- p + coord_cartesian(xlim = c(final_xlim[1]-0.2,final_xlim[2]+0.2), ylim = final_ylim)
  p <- p + scale_x_continuous(
    breaks = function(lims) {
      ## 1. ggplot’s own suggestion (needs {scales})
      br <- scales::pretty_breaks()(lims)

      ## 2. keep only integers
      br <- br[abs(br - round(br)) < 1e-8]

      ## 3. if none left (very narrow panel or weird limits), make 5 integers
      if (length(br) == 0) {
        br <- round(seq(lims[1], lims[2], length.out = 5))
      }
      br
    }
  )


  if (!is.null(xbreaks)) {
    p <- p + scale_x_continuous(breaks = xbreaks)
  }
  if (!is.null(ybreaks)) {
    p <- p + scale_y_continuous(breaks = ybreaks)
  }
  if (!is.null(xangle)) {
    p <- p + theme(axis.text.x = element_text(angle = xangle, hjust = 1))
  }
  if (!is.null(yangle)) {
    p <- p + theme(axis.text.y = element_text(angle = yangle))
  }
  if (isTRUE(legendOff)) {
    p <- p + theme(legend.position = "none")
  }
  if (!is.null(cex.legend)) {
    p <- p + theme(legend.text = element_text(size = cex.legend))
  }

  return(p)
}
