#' Pooled Neutrosophic ANOVA for a Completely Randomized Design
#'
#' Performs pooled neutrosophic analysis of variance for a completely
#' randomized design.
#'
#' @param Lower_y Numeric matrix of lower response bounds. Columns must be
#'   arranged in consecutive year or location blocks, each containing all treatments.
#' @param Upper_y Numeric matrix of upper response bounds.
#' @param design Numeric treatment-layout matrix with the same dimensions as
#'   `Lower_y`.
#' @param alpha Significance level. Default is `0.05`.
#' @param verbose Logical; print results when `TRUE`.
#'
#' @return A list containing the initial and final NANOVA tables, interaction
#'   test, decision, and pooled MSE when applicable.
#'
#' @importFrom MASS ginv
#' @importFrom stats qf
#'
#' @examples
#' # Three replications, three treatments, and two years.
#' # Columns 1-3 are Year 1; columns 4-6 are Year 2.
#'
#' Lower_y <- matrix(c(
#'   20, 25, 30, 21, 26, 31,
#'   22, 27, 32, 23, 28, 33,
#'   21, 26, 31, 22, 27, 32
#' ), nrow = 3, byrow = TRUE)
#'
#' Upper_y <- matrix(c(
#'   22, 27, 32, 23, 28, 33,
#'   24, 29, 34, 25, 30, 35,
#'   23, 28, 33, 24, 29, 34
#' ), nrow = 3, byrow = TRUE)
#'
#' # Treatment layout:
#' # Year 1 = Treatments 1, 2, 3
#' # Year 2 = Treatments 1, 2, 3
#' design <- matrix(c(
#'   1, 2, 3, 1, 2, 3,
#'   1, 2, 3, 1, 2, 3,
#'   1, 2, 3, 1, 2, 3
#' ), nrow = 3, byrow = TRUE)
#'
#' result <- PooledCRDnsANOVA(
#'   Lower_y = Lower_y,
#'   Upper_y = Upper_y,
#'   design = design,
#'   alpha = 0.05,
#'   verbose = TRUE
#' )
#'
#' result$NANOVA.table
#' @export

PooledCRDnsANOVA <- function(Lower_y, Upper_y, design,
                             alpha = 0.05, verbose = FALSE) {

  Lower_y <- as.matrix(Lower_y)
  Upper_y <- as.matrix(Upper_y)
  design <- as.matrix(design)

  stopifnot(
    is.numeric(Lower_y),
    is.numeric(Upper_y),
    is.numeric(design),
    identical(dim(Lower_y), dim(Upper_y)),
    identical(dim(Lower_y), dim(design)),
    alpha > 0,
    alpha < 1
  )

  if (any(Lower_y > Upper_y)) {
    stop("Each value in Lower_y must be less than or equal to Upper_y.")
  }

  b <- nrow(design)                      # replications per treatment/year
  k <- ncol(design)
  v <- length(unique(as.vector(design))) # treatments

  treatment_counts <- table(design[1, ])

  if (length(treatment_counts) != v ||
      length(unique(as.numeric(treatment_counts))) != 1) {
    stop("Each treatment must occur equally often in each row of design.")
  }

  r <- as.integer(treatment_counts[1])   # years

  if (k != r * v) {
    stop("Columns must be ordered as consecutive year blocks.")
  }

  n <- b * k

  d_y <- (Lower_y + Upper_y) / 2
  i_y <- abs(Upper_y - Lower_y) / 2

  # Vectorisation: Year 1 observations, then Year 2, and so on.
  year_cols <- split(seq_len(k), ceiling(seq_len(k) / v))

  dy <- unlist(lapply(
    year_cols,
    function(cols) c(t(d_y[, cols, drop = FALSE]))
  ))

  iy <- unlist(lapply(
    year_cols,
    function(cols) c(t(i_y[, cols, drop = FALSE]))
  ))

  trt_labels <- unlist(lapply(
    year_cols,
    function(cols) c(t(design[, cols, drop = FALSE]))
  ))

  trt_levels <- sort(unique(as.vector(design)))
  trt_id <- match(trt_labels, trt_levels)

  Tmat <- matrix(0, nrow = n, ncol = v)
  Tmat[cbind(seq_len(n), trt_id)] <- 1

  Rmat <- matrix(0, nrow = n, ncol = r)
  year_id <- rep(seq_len(r), each = b * v)
  Rmat[cbind(seq_len(n), year_id)] <- 1

  mu <- matrix(1, nrow = n, ncol = 1)

  TYmat <- t(vapply(
    seq_len(n),
    function(i) kronecker(Rmat[i, ], Tmat[i, ]),
    numeric(r * v)
  ))

  # Total sum of squares
  ybar_d <- mean(d_y)
  ybar_i <- mean(i_y)

  yminusbar_l <- d_y - ybar_d
  yminusbar_u <- yminusbar_l + i_y - ybar_i

  yminusbar_d <- (yminusbar_l + yminusbar_u) / 2
  yminusbar_i <- abs(yminusbar_u - yminusbar_l) / 2

  total_sq_l <- yminusbar_d^2

  total_sq_u <- total_sq_l +
    2 * yminusbar_d * yminusbar_i +
    yminusbar_i^2

  toss_l <- sum(total_sq_l)
  toss_u <- sum(total_sq_u)
  toss_d <- (toss_l + toss_u) / 2
  toss_i <- abs(toss_u - toss_l) / 2

  interval_ss <- function(A, Z) {

    M <- diag(n) -
      Z %*%
      MASS::ginv(t(Z) %*% Z) %*%
      t(Z)

    C <- t(A) %*% M %*% A

    Q_l <- t(A) %*% dy -
      t(A) %*% Z %*%
      MASS::ginv(t(Z) %*% Z) %*%
      t(Z) %*% dy

    Q_u <- Q_l +
      t(A) %*% iy -
      t(A) %*% Z %*%
      MASS::ginv(t(Z) %*% Z) %*%
      t(Z) %*% iy

    Q_d <- (Q_l + Q_u) / 2
    Q_i <- abs(Q_u - Q_l) / 2

    a_l <- MASS::ginv(C) %*% Q_d
    a_u <- a_l + MASS::ginv(C) %*% Q_i

    a_d <- (a_l + a_u) / 2
    a_i <- abs(a_u - a_l) / 2

    ss_l <- sum(Q_d * a_d)

    ss_u <- ss_l +
      sum(
        Q_d * a_i +
          Q_i * a_d +
          Q_i * a_i
      )

    list(
      lower = ss_l,
      upper = ss_u,
      d = (ss_l + ss_u) / 2,
      i = abs(ss_u - ss_l) / 2
    )
  }

  # Main-effect sums of squares adjusted for the other main effect
  ss_treatment <- interval_ss(Tmat, cbind(mu, Rmat))
  ss_year <- interval_ss(Rmat, cbind(mu, Tmat))

  # Treatment Year interaction sum of squares
  ss_interaction <- interval_ss(TYmat, cbind(mu, Tmat, Rmat))

  # Error sum of squares
  model_ss_l <- ss_treatment$d + ss_year$d + ss_interaction$d

  model_ss_u <- model_ss_l +
    ss_treatment$i +
    ss_year$i +
    ss_interaction$i

  model_ss_d <- (model_ss_l + model_ss_u) / 2
  model_ss_i <- abs(model_ss_u - model_ss_l) / 2

  error_l <- toss_d - model_ss_d
  error_u <- error_l + toss_i - model_ss_i

  error_d <- (error_l + error_u) / 2
  error_i <- abs(error_u - error_l) / 2

  # Degrees of freedom for pooled CRD
  df_year <- r - 1
  df_treatment <- v - 1
  df_interaction <- (r - 1) * (v - 1)
  df_error <- r * v * (b - 1)
  df_total <- n - 1

  ms_interval <- function(ss, df) {
    list(
      lower = ss$lower / df,
      upper = ss$upper / df,
      d = ss$d / df,
      i = ss$i / df
    )
  }

  ms_year <- ms_interval(ss_year, df_year)
  ms_treatment <- ms_interval(ss_treatment, df_treatment)
  ms_interaction <- ms_interval(ss_interaction, df_interaction)

  ms_error <- list(
    lower = error_l / df_error,
    upper = error_u / df_error,
    d = error_d / df_error,
    i = error_i / df_error
  )

  f_interval <- function(numerator_ms, denominator_ms) {

    F_l <- numerator_ms$d / denominator_ms$d

    F_u <- F_l +
      (
        numerator_ms$d * denominator_ms$i +
          numerator_ms$i * denominator_ms$d +
          numerator_ms$i * denominator_ms$i
      ) /
      (denominator_ms$d^2)

    c(Lower = F_l, Upper = F_u)
  }

  # First test: Treatment Year interaction against Error
  F_interaction <- f_interval(ms_interaction, ms_error)

  F_critical_interaction <- stats::qf(
    1 - alpha,
    df1 = df_interaction,
    df2 = df_error
  )

  interaction_decision <- if (F_interaction["Lower"] > F_critical_interaction) {
    "Significant"
  } else if (F_interaction["Upper"] <= F_critical_interaction) {
    "Not Significant"
  } else {
    "Indeterminate"
  }

  # Significant interaction: use MS(Treatment Year).
  # Non-significant interaction: pool Interaction and Error.
  if (interaction_decision == "Not Significant") {

    df_pooled_error <- df_interaction + df_error

    pooled_error_l <- ss_interaction$lower + error_l
    pooled_error_u <- ss_interaction$upper + error_u
    pooled_error_d <- (pooled_error_l + pooled_error_u) / 2
    pooled_error_i <- abs(pooled_error_u - pooled_error_l) / 2

    denominator_ms <- list(
      lower = pooled_error_l / df_pooled_error,
      upper = pooled_error_u / df_pooled_error,
      d = pooled_error_d / df_pooled_error,
      i = pooled_error_i / df_pooled_error
    )

    denominator_name <- "Pooled Error (Treatment*Year + Error)"

    F_year <- f_interval(ms_year, denominator_ms)
    F_treatment <- f_interval(ms_treatment, denominator_ms)

    final_table <- data.frame(
      Source = c(
        "Year",
        "Treatment",
        "Pooled Error (Treatment*Year + Error)",
        "Total"
      ),
      DF = c(
        df_year,
        df_treatment,
        df_pooled_error,
        df_total
      ),
      SSN = c(
        sprintf("[%.2f, %.2f]", ss_year$lower, ss_year$upper),
        sprintf("[%.2f, %.2f]", ss_treatment$lower, ss_treatment$upper),
        sprintf("[%.2f, %.2f]", pooled_error_l, pooled_error_u),
        sprintf("[%.2f, %.2f]", toss_l, toss_u)
      ),
      MSSN = c(
        sprintf("[%.2f, %.2f]", ms_year$lower, ms_year$upper),
        sprintf("[%.2f, %.2f]", ms_treatment$lower, ms_treatment$upper),
        sprintf("[%.2f, %.2f]", denominator_ms$lower, denominator_ms$upper),
        ""
      ),
      FN = c(
        sprintf("[%.2f, %.2f]", F_year[1], F_year[2]),
        sprintf("[%.2f, %.2f]", F_treatment[1], F_treatment[2]),
        "",
        ""
      ),
      stringsAsFactors = FALSE
    )

  } else {

    denominator_ms <- ms_interaction
    denominator_name <- "Treatment*Year"

    F_year <- f_interval(ms_year, denominator_ms)
    F_treatment <- f_interval(ms_treatment, denominator_ms)

    final_table <- data.frame(
      Source = c(
        "Year",
        "Treatment",
        "Treatment*Year",
        "Error",
        "Total"
      ),
      DF = c(
        df_year,
        df_treatment,
        df_interaction,
        df_error,
        df_total
      ),
      SSN = c(
        sprintf("[%.2f, %.2f]", ss_year$lower, ss_year$upper),
        sprintf("[%.2f, %.2f]", ss_treatment$lower, ss_treatment$upper),
        sprintf("[%.2f, %.2f]", ss_interaction$lower, ss_interaction$upper),
        sprintf("[%.2f, %.2f]", error_l, error_u),
        sprintf("[%.2f, %.2f]", toss_l, toss_u)
      ),
      MSSN = c(
        sprintf("[%.2f, %.2f]", ms_year$lower, ms_year$upper),
        sprintf("[%.2f, %.2f]", ms_treatment$lower, ms_treatment$upper),
        sprintf("[%.2f, %.2f]", ms_interaction$lower, ms_interaction$upper),
        sprintf("[%.2f, %.2f]", ms_error$lower, ms_error$upper),
        ""
      ),
      FN = c(
        sprintf("[%.2f, %.2f]", F_year[1], F_year[2]),
        sprintf("[%.2f, %.2f]", F_treatment[1], F_treatment[2]),
        sprintf("[%.2f, %.2f]", F_interaction[1], F_interaction[2]),
        "",
        ""
      ),
      stringsAsFactors = FALSE
    )
  }

  interaction_table <- data.frame(
    Source = "Treatment*Year",
    DF = df_interaction,
    F_Neutrosophic = sprintf(
      "[%.2f, %.2f]",
      F_interaction[1],
      F_interaction[2]
    ),
    F_Critical = round(F_critical_interaction, 4),
    Decision = interaction_decision,
    check.names = FALSE
  )

  if (verbose) {
    cat("\nTreatment Year Interaction Test\n")
    print(interaction_table, row.names = FALSE)

    cat("\nFinal Pooled Neutrosophic CRD ANOVA\n")
    print(final_table, row.names = FALSE)

    cat("\nDenominator used for Year and Treatment:", denominator_name, "\n")
  }

  invisible(list(
    interaction.table = interaction_table,
    NANOVA.table = final_table,
    Interaction.F = F_interaction,
    Interaction.F.critical = F_critical_interaction,
    Interaction.decision = interaction_decision,
    denominator = denominator_name,
    denominator.MSE = c(
      Lower = denominator_ms$lower,
      Upper = denominator_ms$upper
    )
  ))
}


