R/YangConway.R

In YangHuiMagic: A Generalization of Yang Hui's Magic Squares

#' Construct singly even order magic square (Yang-Hui Conway generalization)
#'
#' @param m Positive integer, final order n = 2*(2*m+1)
#' @param d_type Type of common difference: "unit" (d=1) or "square" (d=(2m+1)^2)
#' @param template_set Template series: 1~4 corresponding to matrices 4,7,9,10 in the paper
#'
#' @return n x n magic square
#' @export
#'
#' @examples
#' # Example 1: Reproduce Yang-Hui 6th order magic square (Yang diagram),
#' # m=1, d_type="square", template_set=2
#' cat("===== Yang-Hui 6th order magic square (Yang diagram) =====\n")
#' yanghui6 <- YangConway(m = 1, d_type = "square", template_set = 2)
#' print(yanghui6)
#' cat("Is it a magic square: ", is_magic_square(yanghui6), "\n\n")
#' # Example 2: Construct 10th order magic square (matrix 8 in the paper),
#' # m=2, d_type="square", template_set=2
#' cat("===== 10th order magic square (Yang-Hui method, template 7) =====\n")
#' yanghui10 <- YangConway(m = 2, d_type = "square", template_set = 2)
#' print(yanghui10)
#' cat("Is it a magic square: ", is_magic_square(yanghui10), "\n\n")
#' # Example 3: Use common difference 1 (LUX method) to construct 10th order magic square, template 4
#' cat("===== 10th order magic square (LUX method, template 4) =====\n")
#' lux10 <- YangConway(m = 2, d_type = "unit", template_set = 1)
#' print(lux10)
#' cat("Is it a magic square: ", is_magic_square(lux10), "\n\n")
YangConway <- function(m, d_type = "square", template_set = 2) {
  # Check parameters
  if (m < 1) stop("m must >= 1")
  if (!d_type %in% c("unit", "square")) stop("d_type must 'unit' or 'square'")
  if (!template_set %in% 1:4) stop("template_set must 1,2,3,4")

  # Define four sets of 2x2 filling templates (a,b,c)
  templates <- list(
    list( # Series 4 (original LUX)
      a = matrix(c(4, 1, 2, 3), nrow = 2, byrow = TRUE),
      b = matrix(c(1, 4, 2, 3), nrow = 2, byrow = TRUE),
      c = matrix(c(1, 4, 3, 2), nrow = 2, byrow = TRUE)
    ),
    list( # Series 7 (vertical flip of series 4)
      a = matrix(c(2, 3, 4, 1), nrow = 2, byrow = TRUE),
      b = matrix(c(2, 3, 1, 4), nrow = 2, byrow = TRUE),
      c = matrix(c(3, 2, 1, 4), nrow = 2, byrow = TRUE)
    ),
    list( # Series 9 (variants from left/right and up/down)
      a = matrix(c(1, 4, 3, 2), nrow = 2, byrow = TRUE),
      b = matrix(c(4, 1, 3, 2), nrow = 2, byrow = TRUE),
      c = matrix(c(4, 1, 2, 3), nrow = 2, byrow = TRUE)
    ),
    list( # Series 10 (left/right flip of series 7)
      a = matrix(c(3, 2, 1, 4), nrow = 2, byrow = TRUE),
      b = matrix(c(3, 2, 4, 1), nrow = 2, byrow = TRUE),
      c = matrix(c(2, 3, 4, 1), nrow = 2, byrow = TRUE)
    )
  )

  odd_n <- 2 * m + 1          # order of the base odd magic square
  n <- 2 * odd_n             # final singly even order

  # 1. Construct odd order magic square Q
  Q <- odd_magic_square(odd_n)

  # 2. Determine common difference
  d <- if (d_type == "unit") 1 else odd_n^2

  # 3. Initialize result matrix
  B <- matrix(0, nrow = n, ncol = n)

  # 4. Traverse each cell of the odd order square
  for (i in 1:odd_n) {
    for (j in 1:odd_n) {
      g <- Q[i, j]                     # group number

      # Generate four numbers of this group (arithmetic progression)
      if (d == 1) {
        nums <- (g - 1) * 4 + (1:4)
      } else {
        nums <- g + d * (0:3)          # Yang-Hui method: group number, group+d, group+2d, group+3d
      }

      # Determine basic template type
      if (i <= m + 1) {
        template <- templates[[template_set]]$a
      } else if (i == m + 2) {
        template <- templates[[template_set]]$b
      } else {  # i > m+2
        template <- templates[[template_set]]$c
      }

      # Adjust middle column
      mid_col <- m + 1
      if (i == m + 1 && j == mid_col) {
        template <- templates[[template_set]]$b
      }
      if (i == m + 2 && j == mid_col) {
        template <- templates[[template_set]]$a
      }

      # Fill the 2x2 block according to the template
      rows <- (i - 1) * 2 + 1:2
      cols <- (j - 1) * 2 + 1:2
      B[rows[1], cols[1]] <- nums[template[1, 1]]
      B[rows[1], cols[2]] <- nums[template[1, 2]]
      B[rows[2], cols[1]] <- nums[template[2, 1]]
      B[rows[2], cols[2]] <- nums[template[2, 2]]
    }
  }

  B
}