#' Pooled Neutrosophic Analysis of Variance for a Randomized Block Design
#'
#' Performs the pooled neutrosophic ANOVA calculation for interval-valued
#' observations measured in a Randomized Block Design over multiple years or locations or seasons.
#'
#' @param Lower_y Numeric matrix of lower response bounds. Columns must be
#'   ordered in consecutive year blocks, each containing all treatments.
#' @param Upper_y Numeric matrix of upper response bounds, with the same
#'   dimensions as `Lower_y`.
#' @param design Numeric matrix giving the treatment labels for `Lower_y`.
#' @param alpha Significance level for the treatment-by-year interaction test.
#' @param verbose Logical; print the neutrosophic ANOVA table when `TRUE`.
#'
#' @return An invisible list containing the neutrosophic ANOVA table,
#'   interaction F interval and critical value, interaction decision, and the
#'   mean-square interval used for subsequent F intervals.
#'
#' @importFrom MASS ginv
#' @importFrom stats qf
#'
#' @examples
#' # Three blocks, three treatments, and two years.
#' # Columns 1-3 are Year 1; columns 4-6 are Year 2.
#' # Each block contains every treatment once in each year.
#'
#' Lower_y <- matrix(c(
#'   20, 25, 30, 22, 28, 23,
#'   27, 32, 21, 33, 24, 29,
#'   31, 22, 26, 25, 30, 34
#' ), nrow = 3, byrow = TRUE)
#'
#' Upper_y <- matrix(c(
#'   22, 27, 32, 24, 30, 25,
#'   29, 34, 23, 35, 26, 31,
#'   33, 24, 28, 27, 32, 36
#' ), nrow = 3, byrow = TRUE)
#'
#' # Treatment layout for each block:
#' # Year 1 occupies columns 1-3.
#' # Year 2 occupies columns 4-6.
#' design <- matrix(c(
#'   1, 2, 3, 2, 3, 1,
#'   2, 3, 1, 3, 1, 2,
#'   3, 1, 2, 1, 2, 3
#' ), nrow = 3, byrow = TRUE)
#'
#' result <- PooledRBDnsANOVA(
#'   Lower_y = Lower_y,
#'   Upper_y = Upper_y,
#'   design = design,
#'   alpha = 0.05,
#'   verbose = TRUE
#' )
#'
#' result$NANOVA.table
#'
#' @export


PooledRBDnsANOVA <- 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)

  if (!identical(dim(Lower_y), dim(Upper_y)) ||
      !identical(dim(Lower_y), dim(design))) {
    stop("Lower_y, Upper_y, and design must have the same dimensions.")
  }

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

  v <- max(design)
  b <- nrow(design)
  k <- ncol(design)

  treatment_counts <- table(design[1, ])
  r <- as.integer(treatment_counts[1])

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

  l <- b * v
  n <- b * k

  trt_vec <- as.vector(t(design))

  Tmat <- matrix(0, n, v)
  for (i in seq_len(n)) {
    Tmat[i, trt_vec[i]] <- 1
  }

  mu <- matrix(1, n, 1)

  blk <- rep(seq_len(l), each = v)
  Bmat <- matrix(0, n, l)
  for (i in seq_len(n)) {
    Bmat[i, blk[i]] <- 1
  }

  rep_vec <- rep(seq_len(r), each = n / r)
  Rmat <- matrix(0, n, r)
  for (i in seq_len(n)) {
    Rmat[i, rep_vec[i]] <- 1
  }

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

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

  dy <- unlist(lapply(
    split(seq_len(ncol(d_y)), ceiling(seq_len(ncol(d_y)) / v)),
    function(j) c(t(d_y[, j, drop = FALSE]))
  ))

  iy <- unlist(lapply(
    split(seq_len(ncol(i_y)), ceiling(seq_len(ncol(i_y)) / v)),
    function(j) c(t(i_y[, j, drop = FALSE]))
  ))

  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

  yminusbar_sq_l <- yminusbar_d^2
  yminusbar_sq_u <- yminusbar_sq_l +
    2 * yminusbar_d * yminusbar_i +
    yminusbar_i^2

  toss_l <- sum(yminusbar_sq_l)
  toss_u <- sum(yminusbar_sq_u)
  toss_d <- (toss_l + toss_u) / 2
  toss_i <- abs(toss_u - toss_l) / 2

  interval_effect <- function(Cmat, C_adjust,
                              Qmat, Q_adjust,
                              rows = NULL) {

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

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

    Q_l <- t(Qmat) %*% dy -
      t(Qmat) %*% Q_adjust %*%
      MASS::ginv(t(Q_adjust) %*% Q_adjust) %*%
      t(Q_adjust) %*% dy

    Q_u <- Q_l +
      t(Qmat) %*% iy -
      t(Qmat) %*% Q_adjust %*%
      MASS::ginv(t(Q_adjust) %*% Q_adjust) %*%
      t(Q_adjust) %*% iy

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

    if (!is.null(rows)) {
      Q_d <- Q_d[rows, , drop = FALSE]
      Q_i <- Q_i[rows, , drop = FALSE]
    }

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

    list(
      Q_d = Q_d,
      Q_i = Q_i,
      a_d = (a_l + a_u) / 2,
      a_i = abs(a_l - a_u) / 2
    )
  }

  trt <- interval_effect(
    Tmat, cbind(mu, Bmat, Rmat),
    cbind(Tmat, Bmat, Rmat), mu,
    seq_len(v)
  )

  blk_effect <- interval_effect(
    Bmat, cbind(mu, Tmat, Rmat),
    cbind(Bmat, Tmat), cbind(mu, Rmat),
    seq_len(l)
  )

  yr <- interval_effect(
    Rmat, cbind(mu, Tmat),
    cbind(Rmat, Bmat, Tmat), mu,
    seq_len(r)
  )

  ty <- interval_effect(
    TYmat, cbind(mu, Tmat, Rmat),
    TYmat, cbind(mu, Tmat, Rmat)
  )

  interval_ss <- function(effect) {

    ss_l <- sum(effect$Q_d * effect$a_d)

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

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

  ss_t <- interval_ss(trt)
  ss_b <- interval_ss(blk_effect)
  ss_r <- interval_ss(yr)
  ss_ty <- interval_ss(ty)

  mdss_l <- ss_t$d + ss_b$d + ss_r$d + ss_ty$d

  mdss_u <- mdss_l +
    ss_t$i + ss_b$i + ss_r$i + ss_ty$i

  mdss_d <- (mdss_l + mdss_u) / 2
  mdss_i <- abs(mdss_u - mdss_l) / 2

  ess_l <- toss_d - mdss_d
  ess_u <- ess_l + toss_i - mdss_i

  ess_d <- (ess_l + ess_u) / 2
  ess_i <- abs(ess_u - ess_l) / 2

  df_year <- r - 1
  df_trt <- v - 1
  df_rep <- r * (b - 1)
  df_ty <- (v - 1) * (r - 1)
  df_error <- r * (v - 1) * (b - 1)

  F_ty_L <- (ss_ty$d / df_ty) / (ess_d / df_error)

  F_ty_U <- F_ty_L +
    (
      (ss_ty$d / df_trt) * (ess_d / df_error) +
        (ss_ty$i / df_trt) * (ess_d / df_error) +
        (ss_ty$i / df_trt) * (ess_d / df_error)
    ) /
    (
      (ess_d / (ess_d / df_error)) *
        (ess_d / (ess_d / df_error))
    )

  F_critical <- stats::qf(
    1 - alpha,
    df1 = df_ty,
    df2 = df_error
  )

  interaction <- if (F_ty_L > F_critical) {
    "Significant"
  } else if (F_ty_U <= F_critical) {
    "Not Significant"
  } else {
    "Indeterminate"
  }

  if (interaction == "Not Significant") {

    pooled_MSE_l <- (ss_ty$d + ess_d) / (df_ty + df_error)

    pooled_MSE_u <- pooled_MSE_l +
      ss_ty$i / df_ty +
      ess_i / df_error

    pooled_MSE_d <- (pooled_MSE_l + pooled_MSE_u) / 2
    pooled_MSE_i <- abs(pooled_MSE_u - pooled_MSE_l) / 2

  } else {

    pooled_MSE_l <- ss_ty$lower / df_ty
    pooled_MSE_u <- ss_ty$upper / df_ty
    pooled_MSE_d <- ss_ty$d / df_ty
    pooled_MSE_i <- ss_ty$i / df_ty
  }

  F_interval <- function(ss, df) {

    F_L <- (ss$d / df) / pooled_MSE_d

    F_U <- F_L +
      (
        (ss$d / df) * pooled_MSE_i +
          (ss$i / df) * pooled_MSE_d +
          (ss$i / df) * pooled_MSE_i
      ) /
      (pooled_MSE_d * pooled_MSE_d)

    c(F_L, F_U)
  }

  F_year <- F_interval(ss_r, df_year)
  F_trt <- F_interval(ss_t, df_trt)
  F_rep <- F_interval(ss_b, df_rep)

  format_interval <- function(x) {
    if (any(is.na(x))) return("")
    paste0("[", round(x[1], 2), ", ", round(x[2], 2), "]")
  }

  SSN <- list(
    c(ss_r$lower, ss_r$upper),
    c(ss_t$lower, ss_t$upper),
    c(ss_b$lower, ss_b$upper),
    c(ss_ty$lower, ss_ty$upper),
    c(ess_l, ess_u),
    c(NA, NA)
  )

  MSSN <- list(
    c(ss_r$lower / df_year, ss_r$upper / df_year),
    c(ss_t$lower / df_trt, ss_t$upper / df_trt),
    c(ss_b$lower / df_rep, ss_b$upper / df_rep),
    c(ss_ty$lower / df_ty, ss_ty$upper / df_ty),
    c(ess_l / df_error, ess_u / df_error),
    c(NA, NA)
  )

  FN <- list(
    F_year,
    F_trt,
    F_rep,
    c(F_ty_L, F_ty_U),
    c(NA, NA),
    c(NA, NA)
  )

  nanova_table <- data.frame(
    SV = c(
      "Year",
      "Treatment",
      "Replication within year",
      "Treatment*Year",
      "Error",
      "Total"
    ),
    DF = c(
      df_year,
      df_trt,
      df_rep,
      df_ty,
      df_error,
      n - 1
    ),
    SSN = vapply(SSN, format_interval, character(1)),
    MSSN = vapply(MSSN, format_interval, character(1)),
    FN = vapply(FN, format_interval, character(1)),
    stringsAsFactors = FALSE
  )

  if (verbose) {
    print(nanova_table, row.names = FALSE)
    cat("\nInteraction:", interaction, "\n")
    cat("F critical:", round(F_critical, 4), "\n")
  }

  invisible(list(
    nanova_table = nanova_table,
    Interaction = interaction,
    Interaction.F = c(Lower = F_ty_L, Upper = F_ty_U),
    F.critical = F_critical,
    Pooled.MSE = c(Lower = pooled_MSE_l, Upper = pooled_MSE_u)
  ))
}




