#' Series 7 PRBMSD Designs
#'
#' @description
#' This function generates a new series of PRBMS designs using the initial sequence
#' q4': [x^0, x^1, x^2, ..., x^(v-2)] with parameters (v, s = 2, m = [(v - 1)/2, (v + 1)/2], p = v).
#' It also computes the canonical efficiency factors
#'
#' @param v Total number of products (must be prime)
#' @param verbose Logical; if TRUE, prints design layout and efficiency factors
#'
#' @return A list containing design and efficiency measures
#'
#' @examples
#' SERIES7(7, verbose = FALSE)
#'
#' @export
SERIES7 <- function(v, verbose = TRUE) {

  # ==============================================================
  # PRIME CHECK
  # ==============================================================
  is_prime <- function(n) {
    if (n <= 1) return(FALSE)
    if (n <= 3) return(TRUE)
    if (n %% 2 == 0) return(FALSE)

    limit <- floor(sqrt(n))
    if (limit < 3) return(TRUE)

    for (i in seq(3, limit, by = 2)) {
      if (n %% i == 0) return(FALSE)
    }

    TRUE
  }

  # ==============================================================
  # FAST MODULAR EXPONENTIATION
  # ==============================================================
  mod_pow <- function(base, exp, mod) {

    result <- 1
    base <- base %% mod

    while (exp > 0) {

      if (exp %% 2 == 1) {
        result <- (result * base) %% mod
      }

      base <- (base * base) %% mod
      exp <- exp %/% 2
    }

    result
  }

  # ==============================================================
  # PRIME FACTORS
  # ==============================================================
  prime_factors <- function(n) {

    factors <- c()
    d <- 2

    while (d * d <= n) {

      while (n %% d == 0) {
        factors <- c(factors, d)
        n <- n / d
      }

      d <- d + 1
    }

    if (n > 1) {
      factors <- c(factors, n)
    }

    unique(factors)
  }

  # ==============================================================
  # PRIMITIVE ROOT CHECK
  # ==============================================================
  is_primitive <- function(g, p) {

    if (!is_prime(p)) return(FALSE)

    factors <- prime_factors(p - 1)

    for (q in factors) {
      if (mod_pow(g, (p - 1) / q, p) == 1) {
        return(FALSE)
      }
    }

    TRUE
  }

  # ==============================================================
  # GET PRIMITIVE ELEMENT
  # ==============================================================
  get_primitive <- function(p) {

    for (g in 2:(p - 1)) {
      if (is_primitive(g, p)) {
        return(g)
      }
    }

    stop("No primitive element found")
  }

  # ==============================================================
  # INITIAL BLOCK
  # ==============================================================
  get_initial_block <- function(v, power_type = "even") {

    if (!is_prime(v)) stop("v must be prime")

    g <- get_primitive(v)

    if ((v - 1) %% 4 == 0) {
      k <- (v - 1) / 2
    } else if ((v - 3) %% 4 == 0) {
      k <- (v + 1) / 2 - 1
    } else {
      stop("v not 4t+1 or 4t+3")
    }

    if (power_type == "even") {

      powers <- seq(0, 2 * (k - 1), by = 2)

      D <- sapply(
        powers,
        function(e) mod_pow(g, e, v)
      )

    } else {

      powers <- seq(1, 2 * k - 1, by = 2)

      D <- sapply(
        powers,
        function(e) mod_pow(g, e, v)
      )

      D <- c(D, 0)
    }

    D
  }

  # ==============================================================
  # BIBD GENERATION
  # ==============================================================
  generate_bibd <- function(v, power_type = "even") {

    D <- get_initial_block(v, power_type)

    blocks <- matrix(0, nrow = v, ncol = length(D))

    for (i in 0:(v - 1)) {
      blocks[i + 1, ] <- (D + i) %% v
    }

    blocks
  }

  convert_to_1_based <- function(mat, v) {
    mat[mat == 0] <- v
    mat
  }

  construct_bibd <- function(v, power_type = "even") {
    bibd <- generate_bibd(v, power_type)
    convert_to_1_based(bibd, v)
  }

  # ==============================================================
  # CONFLICT CHECK
  # ==============================================================
  check_immediate_conflict <- function(mat, skip_row) {

    vals <- sort(unique(as.vector(mat)))

    followers <- stats::setNames(
      vector("list", length(vals)),
      as.character(vals)
    )

    for (j in 1:ncol(mat)) {
      for (i in 1:(nrow(mat) - 1)) {

        if (i == skip_row) next

        t1 <- as.character(mat[i, j])
        t2 <- mat[i + 1, j]

        if (t2 %in% followers[[t1]]) {
          return(FALSE)
        }

        followers[[t1]] <- c(
          followers[[t1]],
          t2
        )
      }
    }

    TRUE
  }

  # ==============================================================
  # REARRANGEMENT
  # ==============================================================
  rearrange_rows_no_conflict <- function(a, v) {

    fixed_count <- (v - 1) / 2
    skip_row <- fixed_count

    fixed <- a[1:fixed_count, , drop = FALSE]

    free <- a[
      (fixed_count + 1):nrow(a),
      ,
      drop = FALSE
    ]

    n <- nrow(free)

    used <- rep(FALSE, n)

    result <- fixed

    solve <- function(current_result) {

      if (sum(used) == n) {
        return(current_result)
      }

      for (i in 1:n) {

        if (!used[i]) {

          candidate <- rbind(
            current_result,
            free[i, , drop = FALSE]
          )

          if (check_immediate_conflict(candidate, skip_row)) {

            used[i] <<- TRUE

            res <- solve(candidate)

            if (!is.null(res)) {
              return(res)
            }

            used[i] <<- FALSE
          }
        }
      }

      NULL
    }

    final <- solve(result)

    if (is.null(final)) {
      stop("No valid arrangement exists")
    }

    final
  }

  # ==============================================================
  # BUILD DESIGN
  # ==============================================================
  build_design <- function(v) {

    if (!is_prime(v)) stop("v must be prime")

    bibd_even <- construct_bibd(v, "even")
    bibd_odd <- construct_bibd(v, "odd")

    a <- rbind(
      t(bibd_even),
      t(bibd_odd)
    )

    rearrange_rows_no_conflict(a, v)
  }

  # ==============================================================
  # FINAL SERIES7 FUNCTION
  # ==============================================================
  if (!is_prime(v)) stop("v must be prime")

  a <- build_design(v)

  n <- v

  b <- matrix(0, nrow = 2, ncol = n)

  session <- c(
    (n - 1) / 2,
    (n - 1) / 2 + 1
  )

  cmat <- matrix(0, nrow(a), ncol(a))

  k <- 2
  kk <- 1

  for (i in 1:length(session)) {

    for (j in 1:(session[i] - 1)) {
      cmat[k, ] <- a[kk, ]
      k <- k + 1
      kk <- kk + 1
    }

    k <- k + 1
    kk <- kk + 1
  }

  kk <- 1

  for (i in 1:nrow(cmat)) {
    if (all(cmat[i, ] == 0)) {
      cmat[i, ] <- b[kk, ]
      kk <- kk + 1
    }
  }

  n_obs <- nrow(a) * ncol(a)
  maxa <- max(a)

  trt <- matrix(0, n_obs, maxa)

  k <- 1
  for (i in 1:nrow(a)) {
    for (j in 1:ncol(a)) {
      trt[k, a[i, j]] <- 1
      k <- k + 1
    }
  }

  residual <- matrix(0, n_obs, maxa)

  k <- 1
  for (i in 1:nrow(cmat)) {
    for (j in 1:ncol(cmat)) {
      residual[k, cmat[i, j]] <- 1
      k <- k + 1
    }
  }

  ns <- length(session)
  nperiods <- max(session)

  periods <- matrix(0, n_obs, nperiods)

  row_index <- 1

  for (s in 1:ns) {
    for (p in 1:session[s]) {
      for (j in 1:ncol(a)) {
        periods[row_index, p] <- 1
        row_index <- row_index + 1
      }
    }
  }

  panelist <- matrix(0, n_obs, ncol(a))

  k <- 1
  for (i in 1:nrow(a)) {
    for (j in 1:ncol(a)) {
      panelist[k, j] <- 1
      k <- k + 1
    }
  }

  Sessions <- matrix(0, n_obs, ns)

  kk <- 1
  for (s in 1:ns) {
    for (i in 1:session[s]) {
      for (j in 1:ncol(a)) {
        Sessions[kk, s] <- 1
        kk <- kk + 1
      }
    }
  }

  intercept <- matrix(1, n_obs, 1)

  x1 <- cbind(trt, residual)
  x2 <- cbind(intercept, periods, panelist, Sessions)

  Cjoint <- t(x1) %*% x1 -
    t(x1) %*% x2 %*%
    MASS::ginv(t(x2) %*% x2) %*%
    t(x2) %*% x1

  c11 <- Cjoint[1:maxa, 1:maxa]

  c22 <- Cjoint[
    (maxa + 1):(2 * maxa),
    (maxa + 1):(2 * maxa)
  ]

  c12 <- Cjoint[
    1:maxa,
    (maxa + 1):(2 * maxa)
  ]

  c_trt <- c11 -
    c12 %*% MASS::ginv(c22) %*% t(c12)

  c_resid <- c22 -
    t(c12) %*% MASS::ginv(c11) %*% c12

  eig_trt <- eigen(c_trt)$values
  eig_trt <- eig_trt[eig_trt > 1e-7]

  rep <- t(trt) %*% trt

  eff_trt <- length(eig_trt) /
    sum(1 / (eig_trt / rep[1, 1]))

  eig_res <- eigen(c_resid)$values
  eig_res <- eig_res[eig_res > 1e-7]

  rep_r <- t(residual) %*% residual

  eff_res <- length(eig_res) /
    sum(1 / (eig_res / rep_r[1, 1]))

  # ============================================================
  # PRINT DESIGN
  # ============================================================
  if (verbose) {

    cat("\nPRBMS Design:\n\n")

    to_roman <- function(num) {

      roman_map <- c(
        M = 1000, CM = 900, D = 500, CD = 400,
        C = 100, XC = 90, L = 50, XL = 40,
        X = 10, IX = 9, V = 5, IV = 4, I = 1
      )

      result <- ""

      for (sym in names(roman_map)) {
        while (num >= roman_map[sym]) {
          result <- paste0(result, sym)
          num <- num - roman_map[sym]
        }
      }

      result
    }

    roman_periods <- sapply(1:100, to_roman)

    n_panel <- ncol(a)

    w_session <- 8
    w_period <- 8
    w_panel <- 4

    panel_width_total <- n_panel * w_panel
    total_left_width <- w_session + w_period

    left_padding <- total_left_width +
      floor((panel_width_total - nchar("Panelist")) / 2)

    cat(sprintf("%*s%s\n", left_padding, "", "Panelist"))

    cat(sprintf("%-*s%-*s", w_session, "Session", w_period, "Period"))

    for (j in 1:n_panel) {
      cat(sprintf("%*s", w_panel, paste0("P", j)))
    }

    cat("\n\n")

    row_counter <- 1

    for (s in 1:ns) {

      for (p in 1:session[s]) {

        if (p == 1) {
          cat(sprintf("%-*s", w_session, paste0("S", s)))
        } else {
          cat(sprintf("%-*s", w_session, ""))
        }

        cat(sprintf("%-*s", w_period, roman_periods[row_counter]))

        for (j in 1:n_panel) {
          cat(sprintf("%*d", w_panel, a[row_counter, j]))
        }

        cat("\n")
        row_counter <- row_counter + 1
      }

      cat("\n")
    }

    # ============================================================
    # EFFICIENCY FACTORS
    # ============================================================
    cat("\nEfficiency Factors:\n\n")
    cat(sprintf("Direct effect: %.3f\n", eff_trt))
    cat(sprintf("Carryover effect: %.3f\n", eff_res))
  }

  invisible(list(
    design = a,
    C_direct = c_trt,
    C_carry = c_resid,
    efficiency = c(
      Direct = eff_trt,
      Carryover = eff_res
    )
  ))
}

