https://github.com/cran/pracma
Raw File
Tip revision: 392ae21a013fb3f518e8f9eb8efb458a55a2eca2 authored by HwB on 09 April 2011, 00:00:00 UTC
version 0.3-0
Tip revision: 392ae21
.Rapp.history
setwd('/Users/HwB/Work/myRforge/optimist/pkg/pracma/R')
####
### m a g i c . R -- Create a Magic Square#
####
#
#
magic <- function(n) {#
    if (!is.numeric(n)) {#
        stop("Argument 'n' must be numeric.")#
    } else if (!(length(n) == 1)) {#
        stop("Argument 'n' must be of length 1.")#
    }#
#
    oddOrder <- function(n) {#
        J <- matrix(rep(1:n, each = n),  n, n)#
        I <- matrix(rep(1:n, times = n), n, n)#
        A <- (I + J - (n + 3) / 2) %% n#
        B <- (I + 2 * J - 2) %% n#
        M <- n * A + B + 1;#
#
        return(M)#
    }#
#
    doublyEvenOrder <- function(n) {#
        J <- matrix(rep(1:n, each = n),  n, n)#
        I <- matrix(rep(1:n, times = n), n, n)#
        K <- trunc((I %% 4) / 2) == trunc((J %% 4) / 2)#
        M <- t(matrix(1:(n*n), n, n))#
        # M <- t(pracma::reshape(as.matrix(1:(n * n)), n, n))#
        M[K] = n * n + 1 - M[K]#
#
        return(M)#
    }#
#
    singlyEvenOrder <- function(n) {#
        p <- n / 2#
        M <- magic(p)#
        M <- rbind(cbind(M, M + 2 * p ^ 2),#
                   cbind(M + 3 * p ^ 2, M + p ^ 2))#
        if (!(n == 2)) {#
            i <- t(1:p)#
            k <- (n - 2) / 4#
            j <- c(1:k, if ((n - k + 2) <= n) (n - k + 2):n)#
            M[cbind(i, i + p), j] <- M[cbind(i + p, i), j]#
            i <- k + 1#
            j <- c(1, i)#
            M[cbind(i, i + p), j] <- M[cbind(i + p, i), j]#
        }#
#
        return(M)#
    }#
#
    n <- floor(n)#
    M <- if (n <= 0) {#
             matrix(numeric(0), 0, 0)       # degenerate#
         } else if (n == 1) {#
             matrix(as.numeric(1), 1, 1)    # degenerate#
         } else {#
             if (pracma::mod(n, 2) == 1) {#
                 oddOrder(n)#
             } else if (pracma::mod(n, 4) == 0) {#
                 doublyEvenOrder(n)#
             } else {#
                 singlyEvenOrder(n)#
             }#
         }#
#
    if (n == 2)                             # impossible#
        warning("There is no magic square of order 2.")#
    return(M)#
}
setwd('/Users/HwB/Work/myRforge/optimist/pkg/pracma/tests')
identical(magic(3), matrix(c(8, 1, 6,#
                             3, 5, 7,#
                             4, 9, 2), nrow = 3, ncol = 3, byrow = TRUE))#
#
identical(magic(4), matrix(c(16,  2,  3, 13,#
                              5, 11, 10,  8,#
                              9,  7,  6, 12,#
                              4, 14, 15,  1),#
                            nrow = 4, ncol = 4, byrow = TRUE))#
#
identical(magic(6), matrix(c(35,  1,  6, 26, 19, 24,#
                              3, 32,  7, 21, 23, 25,#
                             31,  9,  2, 22, 27, 20,#
                              8, 28, 33, 17, 10, 15,#
                             30,  5, 34, 12, 14, 16,#
                              4, 36, 29, 13, 18, 11),#
                           nrow = 6, ncol = 6, byrow = TRUE))#
#
identical(magic(10), matrix(c(92, 99,  1,  8, 15, 67, 74, 51, 58, 40,#
                              98, 80,  7, 14, 16, 73, 55, 57, 64, 41,#
                               4, 81, 88, 20, 22, 54, 56, 63, 70, 47,#
                              85, 87, 19, 21,  3, 60, 62, 69, 71, 28,#
                              86, 93, 25,  2,  9, 61, 68, 75, 52, 34,#
                              17, 24, 76, 83, 90, 42, 49, 26, 33, 65,#
                              23,  5, 82, 89, 91, 48, 30, 32, 39, 66,#
                              79,  6, 13, 95, 97, 29, 31, 38, 45, 72,#
                              10, 12, 94, 96, 78, 35, 37, 44, 46, 53,#
                              11, 18,100, 77, 84, 36, 43, 50, 27, 59),#
                            nrow = 10, ncol = 10, byrow = TRUE))
back to top