#' Generate p-Rep Test-Control Designs: Method III
#'
#' Constructs partially replicated (p-rep) test-control
#' designs for multiple environments using arrays derived
#' from mutually orthogonal Latin squares. The design is
#' obtained by deleting selected rows from the generated
#' arrays and assigning pairs of arrays to environments.
#' The highest-numbered test treatments are merged into a
#' control treatment with higher replication than the
#' remaining test treatments.
#'
#' @param s An odd prime or prime power (\eqn{s \ge 5}).
#'
#' @return A list containing design parameters,
#' non-randomized layouts, and randomized layouts.
#'
#' @export
TCpRep3 <- function(s){

  if(s < 5 || s %% 2 == 0)
    stop("s must be an odd integer >= 5")

  #-------------------------------------------------------
  # Step 1: Generate s-1 MOLS
  #-------------------------------------------------------

  mols <- vector("list", s - 1)

  for(k in 1:(s - 1)){
    mols[[k]] <- outer(
      0:(s - 1),
      0:(s - 1),
      function(i,j) (i + k*j) %% s
    )
  }

  #-------------------------------------------------------
  # Step 2: Position arrays
  #-------------------------------------------------------

  position_arrays <- vector("list", s - 1)

  for(k in 1:(s - 1)){

    P <- matrix(0, s, s)

    for(sym in 0:(s - 1)){
      P[, sym + 1] <- which(mols[[k]] == sym)
    }

    position_arrays[[k]] <- P
  }

  #-------------------------------------------------------
  # Step 3a: Remove last row from every array
  #-------------------------------------------------------

  temp_arrays <- lapply(
    position_arrays,
    function(x) x[-nrow(x), , drop = FALSE]
  )

  #-------------------------------------------------------
  # Step 3b: Remove row i from array i
  #-------------------------------------------------------

  final_arrays <- vector("list", s - 1)

  for(i in 1:(s - 1)){
    final_arrays[[i]] <- temp_arrays[[i]][-i, , drop = FALSE]
  }

  #-------------------------------------------------------
  # Step 4: Columns = Blocks
  # Arrays 1,2 -> Env1
  # Arrays 3,4 -> Env2
  # etc.
  #-------------------------------------------------------

  blocks <- list()
  block_info <- data.frame()

  blk <- 1

  for(i in 1:(s - 1)){

    env <- ceiling(i / 2)

    A <- final_arrays[[i]]

    for(j in 1:ncol(A)){

      blocks[[blk]] <- as.numeric(A[, j])

      block_info <- rbind(
        block_info,
        data.frame(
          Environment = env,
          Array = i,
          Block = blk
        )
      )

      blk <- blk + 1
    }
  }

  #-------------------------------------------------------
  # Environment-wise design
  #-------------------------------------------------------

  env_design <- list()

  for(env in unique(block_info$Environment)){

    idx <- which(block_info$Environment == env)

    M <- do.call(
      rbind,
      lapply(idx, function(ii) blocks[[ii]])
    )

    rownames(M) <- paste0("B", 1:nrow(M))

    env_design[[paste0("Environment_", env)]] <- M
  }

  #-------------------------------------------------------
  # Parameters
  #-------------------------------------------------------

  v <- length(unique(unlist(blocks)))
  e <- length(unique(block_info$Environment))
  b <- length(blocks)
  k <- length(blocks[[1]])

  rep_tab <- table(unlist(blocks))
  r <- round(mean(rep_tab), 3)

  #-------------------------------------------------------
  # Parameters
  #-------------------------------------------------------

  vt <- s * (s - 1) - 3
  vc <- 1
  e  <- (s - 1) / 2
  b  <- s * (s - 1)
  rt <- s - 2
  rc <- 3 * (s - 2)
  k  <- s - 2

  parameters <- data.frame(
    Parameter = c(
      "Number of Test Treatments (vt)",
      "Number of Controls (vc)",
      "Number of Environments (e)",
      "Number of Blocks (b)",
      "Test Replication (rt)",
      "Control Replication (rc)",
      "Block Size (k)"
    ),
    Value = c(
      vt,
      vc,
      e,
      b,
      rt,
      rc,
      k
    )
  )
  #-------------------------------------------------------
  #-------------------------------------------------------
  # Replace highest 3 treatments by Control (C)
  #-------------------------------------------------------

  control_trts <- (v - 2):v

  for(env in seq_along(env_design)){

    M <- env_design[[env]]

    M[M %in% control_trts] <- "C"

    env_design[[env]] <- M
  }
  Randomized_Design <- lapply(
    env_design,
    function(env){

      rnd <- t(apply(env, 1, sample))

      rownames(rnd) <- rownames(env)

      rnd
    }
  )

  Randomized_Layout <- lapply(
    Randomized_Design,
    function(env){

      data.frame(
        Block = rownames(env),
        Lines = apply(
          env,
          1,
          function(x) paste(x, collapse = " ")
        ),
        row.names = NULL,
        stringsAsFactors = FALSE
      )
    }
  )
  NonRandomized_Layout <- lapply(
    env_design,
    function(env){

      data.frame(
        Block = rownames(env),
        Lines = apply(
          env,
          1,
          function(x) paste(x, collapse = " ")
        ),
        row.names = NULL,
        stringsAsFactors = FALSE
      )
    }
  )


  return(
    structure(
      list(
        Parameters = parameters,
        NonRandomized_Layout = NonRandomized_Layout,
        Randomized_Layout = Randomized_Layout
      ),
      class = "pRep3"
    )
  )
}

#' Print p-Rep Test-Control Design
#'
#' @param x An object of class "pRep3".
#' @param ... Further arguments.
#'
#' @return The input object invisibly.
#'
#' @exportS3Method print pRep3
print.pRep3 <- function(x, ...){

  cat("\nDesign Parameters\n\n")

  print(
    x$Parameters,
    row.names = FALSE
  )

  cat("\n----------------------------------------\n\n")

  cat("Non-Randomized Layout\n\n")

  for(i in names(x$NonRandomized_Layout)){

    cat(
      sub("Environment_", "Environment ", i),
      "\n"
    )

    print(
      x$NonRandomized_Layout[[i]],
      row.names = FALSE
    )

    cat("\n")
  }

  cat("----------------------------------------\n\n")

  cat("Randomized Layout\n\n")

  for(i in names(x$Randomized_Layout)){

    cat(
      sub("Environment_", "Environment ", i),
      "\n"
    )

    print(
      x$Randomized_Layout[[i]],
      row.names = FALSE
    )

    cat("\n")
  }

  invisible(x)
}


