magic/0000755000176200001440000000000014335056755011347 5ustar liggesusersmagic/NAMESPACE0000644000176200001440000000046313434564446012571 0ustar liggesusersexportPattern("^[[:alpha:]]+") exportPattern("%eq%") exportPattern("%ne%") exportPattern("%gt%") exportPattern("%ge%") exportPattern("%lt%") exportPattern("%le%") import("abind") importFrom("graphics", "lines", "par", "plot", "points", "text") importFrom("stats", "runif") importFrom("utils", "combn") magic/README.md0000644000176200001440000000336014200263305012606 0ustar liggesusersManipulation of high-dimensional arrays in R with the magic package ================ [![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/magic)](https://CRAN.R-project.org/package=magic) [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/magic)](https://cran.r-project.org/package=magic) # Overview The magic package implements functionality for manipulating high-dimensional arrays using efficient vectorised methods. The original application was high-dimensional magic hypercubes. This README shows some of the more useful functions in the package. # Installation You can install the released version of `magic` from [CRAN](https://CRAN.R-project.org) with: ``` r # install.packages("magic") # uncomment this to install the package library("magic") ``` # Package highlights - Function `adiag()` binds arbitrarily-dimensioned arrays corner-to-corner - Function `apad()` pads arbitrarily-dimensioned arrays - Function `apldrop()` is a replacement for APL’s drop - Function `aplus()` superimposes two arrays of different dimensions and returns the sum of overlapping elements - Function `arev()` is a multidimensional generalization of `rev()` - Function `arot()` is a generalization of matlab’s `rotdim` - Function `fnsd()` returns the first nonsingleton dimension of an arbitrary dimensioned array - Function `ashift()` shifts the origin of arbitrary dimensioned arrays Much of the package functionality is vectorised in array dimension. # Further information For more detail, see the package vignette `vignette("magic")` magic/data/0000755000176200001440000000000013434564446012260 5ustar liggesusersmagic/data/perfectcube6.rda0000644000176200001440000000107114334512427015314 0ustar liggesusers]jai-*.\pQDDDD٦3&M)"Rz)^^W ~BUjlEh4'_gJSLte«/y|M$v},>~ =z]>\?ПoS~JW><¦zF7w޵W=+_ӿ~&}2w ̏'Go;5r{s7c{4sX}9qV_E_að}#{&4Cy{>7)v{ޫKg Bo]:6goؽe tW~# _ ;=:cG9 a/$k}傗wؑ__Ч>0/NnYa/]z%'jNSLWöwO?;Uܾ!gIVw/G2WpY~~BCN=W>~{.q.N>l>&magic/data/magiccubes.rda0000644000176200001440000000041114334512427015036 0ustar liggesusersBZh91AY&SYǐIHsLLUU@> @Hh4i1!$5@& /ɼap4VdEA3A\Z5qcU8Z l͂XaYhKvgՀ =ַxk i`1R#T:q&E"*F E*  {PT mG2+#% Z/Adm rE8PǐIHmagic/data/cube2.rda0000644000176200001440000000034614334512427013743 0ustar liggesusers]Kk@Fob*.\pQjflcʵڅ qb109sp!Ϭ2":&sOҖacr} >c!%8uzK<'yW~}؄8R|9§ sp_`/guaHCG^t>7zܻ9!Fg7 _magic/data/perfectcube5.rda0000644000176200001440000000056414334512427015321 0ustar liggesusers]JPFoZT\pBDDDDMtmIDVp!R|$@5XHO76|. !4ke孮ɿła:yM mYfƪG3e‡6RQ?1tsa ˜ׄP!'xMO~=ǰN>UsyCgoW#?{;CM.=G5"L x̞kw>>}s<[xΗW`@}̾]"o!s}!q|[%/ɯ=oM9;q>:ރ E}oS/]_Ws0I} OK[ygWUNmagic/data/Ollerenshaw.rda0000644000176200001440000000062214334512427015223 0ustar liggesusers]NPF/Bq .\c1(#EF[(JH Ѕ[GQx'0ޏMI9)!D\$1OD_#&b>Bk2_[ZFF[]FSbn}w!.߃ y50vu Oa~xM;>p"\9X'Wx+ח&\.ns= 9'Z:9W/x9M( mrX W~>SmE+x}_C\Unm x 3RS%1{ 3Xo magic/data/hendricks.rda0000644000176200001440000000173314334512427014716 0ustar liggesusersBZh91AY&SYpsDDUU@@@@@@@PCC@=MQz~PީԘڞT Sj44P)PLLg6eR~UMPF0` ~*TUR$T* i@4 d4 fRI$I$G βUT!B&GMQ%9*R%:u$I$I$I$I$I$铮H&&fs39왙y̒[Ɏ;/ OϴciwUffgEBЄ`ЂD,cyKB!Oo[vӧJ"qqʵjR(BAssXfamZ({-/ǜ]w,܏_޻ww~!u(z$/mIuc(bHB$!aJXCt$`\ʒ{+e)eKϨz'v"""""#dTRScfgBmcXۺt/CI} W]kNqfM6c4p cd$*Iز `(((((((((((,c "" (@PP(( J eYȮ뮪j3|45lM5"Ɔ/o4OZ$FGq哶#뎸ѷ: Q HAwz3?^SS1M88C)bI0Гy@@G@x @I$@P@` !8)bFW` aL)6v)8):ZeZyMۈe<Z:PȈ FDDDFQDDD""""""$~|뮲,3}UXJVI$iDZTC6zP`DXR@DuPRJY=*VAҁYzkiKڑNNaaoԦ:DDDDD@D@D@Q"(Hƀmagic/man/0000755000176200001440000000000014334512360012106 5ustar liggesusersmagic/man/magiccube.2np1.Rd0000644000176200001440000000141013434564446015103 0ustar liggesusers\name{magiccube.2np1} \alias{magiccube.2np1} \title{Magic cubes of order 2n+1} \description{ Creates odd-order magic cubes } \usage{ magiccube.2np1(m) } \arguments{ \item{m}{n=2m+1} } \references{website} \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ #try with m=3, n=2*3+1=7: m <-7 n <- 2*m+1 apply(magiccube.2np1(m),c(1,2),sum) apply(magiccube.2np1(m),c(1,3),sum) apply(magiccube.2np1(m),c(2,3),sum) #major diagonal checks out: sum(magiccube.2np1(m)[matrix(1:n,n,3)]) #now other diagonals: b <- c(-1,1) f <- function(dir,v){if(dir>0){return(v)}else{return(rev(v))}} g <- function(jj){sum(magiccube.2np1(m)[sapply(jj,f,v=1:n)])} apply(expand.grid(b,b,b),1,g) #each diagonal twice, once per direction. } \keyword{array} magic/man/magic-package.Rd0000644000176200001440000000114113671575431015056 0ustar liggesusers\name{magic-package} \alias{magic-package} \docType{package} \title{ \packageTitle{magic} } \description{ \packageDescription{magic} } \details{ The DESCRIPTION file: \packageDESCRIPTION{magic} \packageIndices{magic} } \author{ \packageAuthor{magic} Maintainer: \packageMaintainer{magic} } \references{ \itemize{ \item R. K. S. Hankin 2005. \dQuote{Recreational mathematics with R: introducing the \pkg{magic} package}. R news, 5(1) } } \keyword{ package } \examples{ magic(6) magicplot(magic(8)) magichypercube.4n(1) is.alicehypercube(magichypercube.4n(1,d=5),4,give.answers=TRUE) } magic/man/magic.prime.Rd0000644000176200001440000000160414136346326014600 0ustar liggesusers\name{magic.prime} \alias{magic.prime} \title{Magic squares prime order} \description{ Produces magic squares of prime order using the standard method } \usage{ magic.prime(n,i=2,j=3) } \arguments{ \item{n}{The order of the square} \item{i}{row number of increment} \item{j}{column number of increment} } \details{ Claimed to work for order any prime \eqn{p} with \eqn{(p,ij)=1}, but I've tried it (with the defaults for \code{i} and \code{j}) for many composite integers of the form \eqn{6n+1}{6n+1} and \eqn{6n-1}{6n-1} and found no exceptions; indeed, they all seem to be panmagic. It is not clear to me when the process works and when it doesn't. } \author{Robin K. S. Hankin} \examples{ magic.prime(7) f <- function(n){is.magic(magic.prime(n))} all(sapply(6*1:30+1,f)) all(sapply(6*1:30-1,f)) is.magic(magic.prime(9,i=2,j=4),give.answers=TRUE) magic.prime(7,i=2,j=4) } \keyword{array} magic/man/magic.4np2.Rd0000644000176200001440000000113614010574652014243 0ustar liggesusers\name{magic.4np2} \alias{magic.4np2} \title{Magic squares of order 4n+2} \description{ Produces a magic square of order \eqn{4n+2} using Conway's \dQuote{LUX} method } \usage{ magic.4np2(m) } \arguments{ \item{m}{returns a magic square of order \eqn{n=4m+2} for \eqn{m\geq 1}{m>=1}, using Conway's \dQuote{LUX} construction} } \references{\url{https://mathworld.wolfram.com/MagicSquare.html}} \author{Robin K. S. Hankin} \note{I am not entirely happy with the method used: it's too complicated} \seealso{\code{\link{magic}}} \examples{ magic.4np2(1) is.magic(magic.4np2(3)) } \keyword{array} magic/man/arow.Rd0000644000176200001440000000154713434564446013370 0ustar liggesusers\name{arow} \alias{arow} \title{Generalized row and col} \description{ Given an array, returns an array of the same size whose elements are sequentially numbered along the \eqn{i^{\rm th}}{i-th} dimension. } \usage{ arow(a, i) } \arguments{ \item{a}{array to be converted} \item{i}{Number of the dimension} } \value{ An integer matrix with the same dimensions as \code{a}, with element \eqn{\left(n_1,n_2,\ldots n_d\right)}{(n1,n2, ..., n_d)} being \eqn{n_i}{n_i}. } \author{Robin K. S. Hankin} \note{ This function is equivalent to, but faster than, \code{function(a,i){do.index(a,function(x){x[i]})}}. However, it is much more complicated. The function is nominally the same as \code{slice.index()} but I have not checked all the edge cases. } \examples{ a <- array(0,c(3,3,2,2)) arow(a,2) (arow(a,1)+arow(a,2)+arow(a,3)+arow(a,4))\%\%2 } \keyword{array} magic/man/magic.8.Rd0000644000176200001440000000073114010574677013636 0ustar liggesusers\name{magic.8} \alias{magic.8} \title{Regular magic squares of order 8} \description{ Returns all 90 regular magic squares of order 8 } \usage{ magic.8(...) } \arguments{ \item{\dots}{ignored} } \value{ Returns an array of dimensions \code{c(8,8,90)} of which each slice is an 8-by-8 magic square. } \references{\url{https://www.grogono.com/magic/index.php}} \author{Robin K. S. Hankin} \examples{ h <- magic.8() h[,,1] stopifnot(apply(h,3,is.magic)) } \keyword{array} magic/man/magic.4n.Rd0000644000176200001440000000061013434564446014006 0ustar liggesusers\name{magic.4n} \alias{magic.4n} \title{Magic squares of order 4n} \description{ Produces an associative magic square of order \eqn{4n} using the delta-x method. } \usage{ magic.4n(m) } \arguments{ \item{m}{Order \eqn{n}{n} of the square is given by \eqn{n=4m}} } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ magic.4n(4) is.magic(magic.4n(5)) } \keyword{array} magic/man/hudson.Rd0000644000176200001440000000256213434564446013716 0ustar liggesusers\name{hudson} \alias{hudson} \title{Pandiagonal magic squares due to Hudson} \description{ Returns a regular pandiagonal magic square of order \eqn{6m\pm 1}{6m+/-1} using a method developed by Hudson. } \usage{ hudson(n = NULL, a = NULL, b = NULL) } \arguments{ \item{n}{Order of the square, \eqn{n=6m\pm 1}{n=6m+/-1}. If \code{NULL}, use the length of \code{a}} \item{a}{The first line of Hudson's \eqn{A} matrix. If \code{NULL}, use Hudson's value of \code{c(n-1,0:(n-2))}} \item{b}{The first line of Hudson's \eqn{B} matrix. If \code{NULL}, use Hudson's value of \code{c(2:(n-1),n,1)}. Using default values for \code{a} and \code{b} gives an associative square } } \details{ Returns one member of a set of regular magic squares of order \eqn{n=6m\pm 1}{n=6m+/-1}. The set is of size \eqn{(n!)^2}. Note that \code{n} is not checked for being in the form \eqn{6n\pm 1}{6n+1/6n-1}. If it is not the correct form, the square is magic but not necessarily normal. } \references{C. B. Hudson, \emph{On pandiagonal squares of order 6t +/- 1}, Mathematics Magazine, March 1972, pp94-96} \author{Robin K. S. Hankin} \seealso{\code{\link{recurse}}} \examples{ hudson(n=11) magicplot(hudson(n=11)) is.associative(hudson(n=13)) hudson(a=(2*1:13)\%\%13 , b=(8*1:13)\%\%13) all(replicate(10,is.magic(hudson(a=sample(13),b=sample(13))))) } \keyword{array} magic/man/magic.product.Rd0000644000176200001440000000313613434564446015153 0ustar liggesusers\name{magic.product} \alias{magic.product} \alias{magic.product} \alias{magic.product.fast} \title{Product of two magic squares} \description{ Gives a magic square that is a product of two magic squares. } \usage{ magic.product(a, b, mat=NULL) magic.product.fast(a, b) } \arguments{ \item{a}{First magic square; if \code{a} is an integer, use \code{magic(a)}.} \item{b}{as above} \item{mat}{Matrix, of same size as \code{a}, of integers treated as modulo 8. Default value of \code{NULL} equivalent to passing \code{a*0}. Each number from 0-7 corresponds to one of the 8 squares which have the same Frenicle's standard form, as generated by \code{transf()}. Then subsquares of the product square (ie tiles of the same size as \code{b}) are rotated and transposed appropriately according to their corresponding entry in \code{mat}. This is a lot easier to see than to describe (see examples section).} } \details{ Function \code{magic.product.fast()} does not take a \code{mat} argument, and is equivalent to \code{magic.product()} with \code{mat} taking the default value of \code{NULL}. The improvement in speed is doubtful unless \code{order(a)}\eqn{\gg}{>>}\code{order(b)}, in which case there appears to be a substantial saving. } \references{ William H. Benson and Oswald Jacoby. New recreations with magic squares, Dover 1976 (and that paper in JRM)} \author{Robin K. S. Hankin} \examples{ magic.product(magic(3),magic(4)) magic.product(3,4) mat <- matrix(0,3,3) a <- magic.product(3,4,mat=mat) mat[1,1] <- 1 b <- magic.product(3,4,mat=mat) a==b } \keyword{array} magic/man/is.ok.Rd0000644000176200001440000000106013434564446013431 0ustar liggesusers\name{is.ok} \alias{is.ok} \title{does a vector have the sum required to be a row or column of a magic square?} \description{ Returns \code{TRUE} if and only if \code{sum(vec)==magic.constant(n,d=d))} } \usage{ is.ok(vec, n=length(vec), d=2) } \arguments{ \item{vec}{Vector to be tested} \item{n}{Order of square or hypercube. Default assumes order is equal to length of \code{vec}} \item{d}{Dimension of square or hypercube. Default of 2 corresponds to a square} } \author{Robin K. S. Hankin} \examples{ is.ok(magic(5)[1,]) } \keyword{array} magic/man/panmagic.8.Rd0000644000176200001440000000174514136346326014340 0ustar liggesusers\name{panmagic.8} \alias{panmagic.8} \title{Panmagic squares of order 8} \description{ Produces each of a wide class of order 8 panmagic squares } \usage{ panmagic.8(chosen = 1:6, vals = 2^(0:5)) } \arguments{ \item{chosen}{Which of the magic carpets are used in combination} \item{vals}{The values combined to produce the magic square. Choosing \code{0:5} gives a normal magic square.} } \references{\url{https://www.grogono.com/magic/index.php}} \author{Robin K. S. Hankin} \note{ Not all choices for \code{chosen} give normal magic squares. There seems to be no clear pattern. See website in references for details. } \seealso{\code{\link{panmagic.4}}} \examples{ is.panmagic(panmagic.8(chosen=2:7)) is.normal(panmagic.8(chosen=2:7)) is.normal(panmagic.8(chosen=c(1,2,3,6,7,8))) #to see the twelve basis magic carpets, set argument 'chosen' to each #integer from 1 to 12 in turn, with vals=1: panmagic.8(chosen=1,vals=1)-1 image(panmagic.8(chosen=12,vals=1)) } \keyword{array} magic/man/magichypercube.4n.Rd0000644000176200001440000000107413434564446015722 0ustar liggesusers\name{magichypercube.4n} \alias{magichypercube.4n} \title{Magic hypercubes of order 4n} \description{ Returns magic hypercubes of order 4n and any dimension. } \usage{ magichypercube.4n(m, d = 3) } \arguments{ \item{m}{Magic hypercube produced of order \eqn{n=4m}} \item{d}{Dimensionality of cube} } \details{ Uses a rather kludgy (but vectorized) method. I am not 100\% sure that the method does in fact produce magic squares for all orders and dimensions. } \author{Robin K. S. Hankin} \examples{ magichypercube.4n(1,d=4) magichypercube.4n(2,d=3) } \keyword{array} magic/man/aplus.Rd0000644000176200001440000000237413434564446013543 0ustar liggesusers\name{aplus} \alias{aplus} \title{Generalized array addition} \description{ Given two arrays \code{a} and \code{b} with \code{length(dim(a))==length(dim(b))}, return a matrix with dimensions \code{pmax(dim(a),dim(b))} where \dQuote{overlap} elements are \code{a+b}, and the other elements are either 0, a, or b according to location. See details section. } \usage{ aplus(...) } \arguments{ \item{\dots}{numeric or complex arrays} } \details{ The function takes any number of arguments (the binary operation is associative). The operation of \code{aplus()} is understandable by examining the following \strong{pseudo}code: \itemize{ \item \code{outa <- array(0,pmax(a,b))} \item \code{outb <- array(0,pmax(a,b))} \item \code{outa[1:dim(a)] <- a} \item \code{outb[1:dim(a)] <- b} \item \code{return(outa+outb)} } See how \code{outa} and \code{outb} are the correct size and the appropriate elements of each are populated with \code{a} and \code{b} respectively. Then the sum is returned. } \author{Robin K. S. Hankin} \seealso{\code{\link{apad}}} \examples{ aplus(rbind(1:9),cbind(1:9)) a <- matrix(1:8,2,4) b <- matrix(1:10,5,2) aplus(a*100,b,b) } \keyword{ array } magic/man/subsums.Rd0000644000176200001440000000515213434564446014115 0ustar liggesusers\name{subsums} \alias{subsums} \title{Sums of submatrices} \description{ Returns the sums of submatrices of an array; multidimensional moving window averaging} \usage{ subsums(a,p,func="sum",wrap=TRUE, pad=0) } \arguments{ \item{a}{Array to be analysed} \item{p}{Argument specifying the subarrays to be summed. If a vector of length greater than one, it is assumed to be of length \code{d=length(dim(a))}, and is interpreted to be the dimensions of the subarrays, with the size of the window's \eqn{n{^{\rm th}}}{n-th} dimension being \code{a[n]}. If the length of \code{p} is one, recycling is used. If not a vector, is assumed to be a matrix with \code{d} columns, each row representing the coordinates of the elements to be summed. See examples. } \item{func}{Function to be applied over the elements of the moving window. Default value of \code{sum} gives the sum as used in \code{is.2x2.correct()}; other choices might be \code{mean}, \code{prod}, or \code{max}. If \code{sum=""}, return the array of dimension \code{c(dim(a),prod(p))} where each hyperplane is a shifted version of \code{a}.} \item{wrap}{Boolean, with default value of \code{TRUE} meaning to view array \code{a} as a n-dimensional torus. Thus, if \code{x=subsums(a,p,wrap=TRUE)}, and if \code{dim(a)=c(a_1,...,a_d)} then \code{x[a_1,...,a_d]} is the sum of all corner elements of \code{a}. If \code{FALSE}, do not wrap \code{a} and return an array of dimension \code{dim(a)+p-1}.} \item{pad}{If \code{wrap} is \code{TRUE}, \code{pad} is the value used to pad the array with. Use a \dQuote{neutral} value here; for example, if \code{func=sum}, then use 0; if \code{max}, use \eqn{-\infty}{-Inf}.} } \details{ The offset is specified so that \code{allsums(a,v)[1,1,...,1]= sum(a[1:v[1],1:v[2],...,1:v[n]])}, where \code{n=length(dim(a))}. Function \code{subsums()} is used in \code{is.2x2.correct()} and \code{is.diagonally.correct()}. } \author{Robin K. S. Hankin} \examples{ data(Ollerenshaw) subsums(Ollerenshaw,c(2,2)) subsums(Ollerenshaw[,1:10],c(2,2)) subsums(Ollerenshaw, matrix(c(0,6),2,2)) # effectively, is.bree.correct() # multidimensional example. a <- array(1,c(3,4,2)) subsums(a,2) # note that p=2 is equivalent to p=c(2,2,2); # all elements should be identical subsums(a,2,wrap=FALSE) #note "middle" elements > "outer" elements #Example of nondefault function: x <- matrix(1:42,6,7) subsums(x,2,func="max",pad=Inf,wrap=TRUE) subsums(x,2,func="max",pad=Inf,wrap=FALSE) } \keyword{array} magic/man/hadamard.Rd0000644000176200001440000000124113434564446014150 0ustar liggesusers\name{hadamard} \alias{hadamard} \alias{is.hadamard} \alias{sylvester} \title{Hadamard matrices} \description{ Various functionality for Hadamard matrices } \usage{ sylvester(k) is.hadamard(m) } \arguments{ \item{k}{Function \code{sylvester()} gives the \code{k}-th Sylvester matrix} \item{m}{matrix} } \details{ A \dfn{Hadamard matrix} is a square matrix whose entries are either +1 or -1 and whose rows are mutually orthogonal. } \references{ \dQuote{Hadamard matrix.} \emph{Wikipedia, The Free Encyclopedia.} 19 Jan 2009, 18:21 UTC. 20 Jan 2009 } \author{Robin K. S. Hankin} \examples{ is.hadamard(sylvester(4)) image(sylvester(5)) } \keyword{array} magic/man/as.standard.Rd0000644000176200001440000000646013434564446014621 0ustar liggesusers\name{as.standard} \alias{as.standard} \alias{is.standard} \alias{is.standard.toroidal} \title{Standard form for magic squares} \description{ Transforms a magic square or magic hypercube into Frenicle's standard form } \usage{ as.standard(a, toroidal = FALSE, one_minus=FALSE) is.standard(a, toroidal = FALSE, one_minus=FALSE) } \arguments{ \item{a}{Magic square or hypercube (array) to be tested or transformed} \item{toroidal}{Boolean, with default \code{FALSE} meaning to use Frenicle's method, and \code{TRUE} meaning to use additional transformations appropriate to toroidal connectivity} \item{one_minus}{Boolean, with \code{TRUE} meaning to use the transformation \eqn{x\longrightarrow n^2+1-x}{x -> n^2+1-x} if appropriate, and default \code{FALSE} meaning not to use this} } \details{ For a square, \code{as.standard()} transforms a magic square into Frenicle's standard form. The four numbers at each of the four corners are determined. First, the square is rotated so the smallest of the four is at the upper left. Then, element \code{[1,2]} is compared with element\code{[2,1]} and, if it is larger, the transpose is taken. Thus all eight rotated and transposed versions of a magic square have the same standard form. The square returned by \code{magic()} is in standard form. For hypercubes, the algorithm is generalized. First, the hypercube is reflected so that \code{a[1,1,...,1,1]} is the smallest of the \eqn{2^d} corner elements (eg \code{a[1,n,1,...,1,1]}). Next, \code{aperm()} is called so that \code{a[1,1,...,1,2] < a[1,1,...,2,1] < ... < a[2,1,...,1,1]}. Note that the inequalities are strict as hypercubes are assumed to be normal. As of version 1.3-1, \code{as.standard()} will accept arrays of any dimension (ie arrays \code{a} with \code{minmax(dim(a))==FALSE} will be handled sensibly). An array with any dimension of extent zero is in standard form by definition; dimensions of length one are dropped. If argument \code{toroidal} is \code{TRUE}, then the array \code{a} is translated using \code{ashift()} so that \code{a[1,1,...,1] == min(a)}. Such translations preserve the properties of semimagicness and pandiagonalness (but not magicness or associativity). It is easier (for me at least) to visualise this by considering two-dimensional arrays, tiling the plane with copies of \code{a}. Next, the array is shifted so that \code{a[2,1,1,...,1] < a[dim(a)[1],1,1,...,1]} and \code{a[1,2,1,..,1] < a[1,dim(a)[2],1,...,1]} and so on. Then \code{aperm()} is called as per the non-toroidal case above. \code{is.standard()} returns \code{TRUE} if the magic square or hypercube is in standard form. \code{is.standard()} and \code{as.standard()} check for neither magicness nor normality (use \code{\link{is.magic}} and \code{\link{is.normal}} for this). } \note{ There does not appear to be a way to make the third letter of \dQuote{Frenicle} have an acute accent, as it should do. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}, \code{\link{eq}}} \examples{ is.standard(magic.2np1(4)) as.standard(magic.4n(3)) as.standard(magichypercube.4n(1,5)) ##non-square arrays: as.standard(magic(7)[1:3,]) ## Toroidal transforms preserve pandiagonalness: is.pandiagonal(as.standard(hudson(11))) ## but not magicness: is.magic(as.standard(magic(10),TRUE)) } \keyword{array} magic/man/allsubhypercubes.Rd0000644000176200001440000000323513434564446015770 0ustar liggesusers\name{allsubhypercubes} \alias{allsubhypercubes} \title{Subhypercubes of magic hypercubes} \description{ Extracts all subhypercubes from an n-dimensional hypercube. } \usage{ allsubhypercubes(a) } \arguments{ \item{a}{The magic hypercube whose subhypercubes are computed} } \value{ Returns a list, each element of which is a subhypercube of \code{a}. Note that major diagonals are also returned (as n-by-1 arrays). The names of the list are the extracted subhypercubes. Consider \code{a <- magichypercube.4n(1,d=4)} (so n=4) and if \code{jj <- allsubhypercubes(a)}, consider \code{jj[9]}. The name of \code{jj[9]} is \code{"n-i+1,i,i,"}; its value is a square matrix. The columns of \code{jj[9]} may be recovered by \code{a[n-i+1,i,i,]} with \eqn{i=1\ldots n}{i=1...n} (\strong{NB}: that is, jj[[9]] == \code{cbind(a[n-1+1,1,1,], a[n-2+1,2,2,], a[n-3+1,3,3,], a[n-4+1,4,4,])} where \code{n=4}). The list does not include the whole array. } \author{Robin K. S. Hankin} \note{This function is a dog's dinner. It's complicated, convoluted, and needs an absurd use of the \code{eval(parse(text=...))} construction. Basically it sucks big time. BUT\ldots I cannot for the life of me see a better way that gives the same results, without loops, on hypercubes of arbitrary dimension. On my 256MB Linuxbox, \code{allsubhypercubes()} cannot cope with \code{d} as high as 5, for \code{n=4}. Heigh ho. The term \dQuote{subhypercube} does not include diagonally oriented entities at \code{is.magichypercube}. But it does here. } \seealso{\code{\link{is.perfect}}} \examples{ a <- magichypercube.4n(1,d=4) allsubhypercubes(a) } \keyword{array} magic/man/cilleruelo.Rd0000644000176200001440000000245414316714673014554 0ustar liggesusers\name{cilleruelo} \alias{cilleruelo} \title{ A class of multiplicative magic squares due to Cilleruelo and Luca } \description{ Cilleruelo and Luca give a class of multiplicative magic squares whose behaviour is interesting. } \usage{ cilleruelo(n, m) } \arguments{ \item{n,m}{Arguments: usually integers} } \details{ \deqn{ \left( \begin{array}{cccc} (n+2)(m+0) & (n+3)(m+3) & (n+1)(m+2) & (n+0)(m+1)\\ (n+1)(m+1) & (n+0)(m+2) & (n+2)(m+3) & (n+3)(m+0)\\ (n+0)(m+3) & (n+1)(m+0) & (n+3)(m+1) & (n+2)(m+2)\\ (n+3)(m+2) & (n+2)(m+1) & (n+0)(m+0) & (n+1)(m+3) \end{array} \right) }{a 4x4 array} } \value{ Returns a \eqn{4\times 4}{4x4} matrix. } \references{ Javier Cilleruelo and Florian Luca 2010, \dQuote{On multiplicative magic squares}, \emph{The Electronic Journal of Combinatorics} vol 17, number 8 } \author{Robin K. S. Hankin} \examples{ is.magic(cilleruelo(5,6)) is.magic(cilleruelo(5,6),func=prod) f <- function(n){ jj <- sapply( seq(from=5,len=n), function(i){cilleruelo(i,i-4)} ) xM <- apply(jj,2,max) xm <- apply(jj,2,min) cbind(xM-xm , 5^(5/12)*xm^0.5 , 6*xm^0.5) } matplot(f(200),type='l',log='xy',xlab='n',ylab='') legend(x="topleft",legend=c("xM-xm","5^(5/12).xm^(1/2)","6xm^(1/2)"), lty=1:3,col=1:3) } magic/man/is.magichypercube.Rd0000644000176200001440000002423613434564446016021 0ustar liggesusers\name{is.magichypercube} \alias{is.semimagichypercube} \alias{is.magichypercube} \alias{is.nasik} \alias{is.alicehypercube} \alias{is.perfect} \alias{is.diagonally.correct} \alias{is.latinhypercube} \title{magic hypercubes} \description{ Returns \code{TRUE} if a hypercube is semimagic, magic, perfect } \usage{ is.semimagichypercube(a, give.answers=FALSE, func=sum, boolean=FALSE, ...) is.diagonally.correct(a, give.answers = FALSE, func=sum, boolean=FALSE, ...) is.magichypercube(a, give.answers = FALSE, func=sum, boolean=FALSE, ...) is.perfect(a, give.answers = FALSE, func=sum, boolean=FALSE) is.latinhypercube(a, give.answers=FALSE) is.alicehypercube(a,ndim,give.answers=FALSE, func=sum, boolean=FALSE) } \arguments{ \item{a}{The hypercube (array) to be tested} \item{give.answers}{Boolean, with \code{TRUE} meaning to also return the sums} \item{func}{Function to be applied across each dimension} \item{ndim}{In \code{is.alicehypercube()}, dimensionality of subhypercube to take sums over. See the details section} \item{boolean}{Boolean, with \code{TRUE} meaning that the hypercube is deemed magic, semimagic, etc, if all applications of \code{func} evaluate to \code{TRUE}. If \code{boolean} is \code{FALSE}, the hypercube is magic etc if all applications of \code{func} are identical} \item{...}{Further arguments passed to \code{func()}} } \details{ (Although apparently non-standard, here a hypercube is defined to have dimension \eqn{d} and order \eqn{n}---and thus has \eqn{n^d} elements). \itemize{ \item A \dfn{semimagic hypercube} has all \dQuote{rook's move} sums equal to the magic constant (that is, each \eqn{\sum a[i_1,i_2,\ldots,i_{r-1},,i_{r+1}, \ldots,i_d]}{sum(a[i_1,i_2, \ldots,i_{r-1},,i_{r+1},\ldots,i_d])} with \eqn{1\leq r\leq d}{1 <= r <= d} is equal to the magic constant for all values of the \eqn{i}'s). In \code{is.semimagichypercube()}, if \code{give.answers} is \code{TRUE}, the sums returned are in the form of an array of dimension \code{c(rep(n,d-1),d)}. The first \code{d-1} dimensions are the coordinates of the projection of the summed elements onto the surface hypercube. The last dimension indicates the dimension along which the sum was taken over. Optional argument \code{func}, defaulting to \code{sum()}, indicates the function to be taken over each of the \code{d} dimensions. Currently requires \code{func} to return a scalar. \item A \dfn{Latin hypercube} is one in which each line of elements whose coordinates differ in only one dimension comprises the numbers \eqn{1} to \eqn{n} (or \eqn{0} to \eqn{n-1}), not necessarily in that order. Each integer thus appears \eqn{n^{d-1}} times. \item A \dfn{magic hypercube} is a semimagic hypercube with the additional requirement that all \eqn{2^{d-1}}{2^(d-1)} long (ie extreme point-to-extreme point) diagonals sum correctly. Correct diagonal summation is tested by \code{is.diagonally.correct()}; by specifying a function other than \code{sum()}, criteria other than the diagonals returning the correct sum may be tested. \item An \dfn{Alice hypercube} is a different generalization of a semimagic square to higher dimensions. It is named for A. M. Hankin (\dQuote{Alice}), who originally suggested it. A semimagic hypercube has all one-dimensional subhypercubes (ie lines) summing correctly. An Alice hypercube is one in which all \code{ndim}-dimensional subhypercubes have the same sum, where \code{ndim} is a fixed integer argument. Thus, if \code{a} is a hypercube of size \eqn{n^d}{n^d}, \code{is.alicehypercube(a,ndim)} returns \code{TRUE} if all \code{n^{d-ndim}} subhypercubes have the same sum. For example, if \code{a} is four-dimensional with dimension \eqn{5\times 5\times 5\times 5}{5x5x5x5} then \code{is.alicehypercube(a,1)} is \code{TRUE} if and only if \code{a} is a semimagic hypercube: all \eqn{{4\choose 1}5^3=500}{4*5^3=500} one-dimensional subhypercubes have the same sum. Then \code{is.alicehypercube(a,2)} is \code{TRUE} if all 2-dimensional subhypercubes (ie all \eqn{{4\choose 2}\times 5^2=150}{6x5^2=150} of the \eqn{5\times 5}{5x5} squares, for example \code{a[,2,4,]} and \code{a[1,1,,]}) have the same sum. Then \code{is.alicehypercube(a,3)} means that all 3d subhypercubes (ie all \eqn{{4\choose 3}\times 5^1=20}{4x5=20} of the \eqn{5\times 5\times 5}{5x5x5} cubes, for example \code{a[,,1,]} and \code{a[4,,,]}) have the same sum. For any hypercube \code{a}, \code{is.alicehypercube(a,dim(a))} returns \code{TRUE}. A semimagic hypercube is an Alice hypercube for any value of \code{ndim}. \item A \dfn{perfect magic hypercube} (use \code{is.perfect()}) is a magic hypercube with all nonbroken diagonals summing correctly. This is a seriously restrictive requirement for high dimensional hypercubes. As yet, this function does not take a \code{give.answers} argument. \item A \dfn{pandiagonal magic hypercube}, also \dfn{Nasik hypercube} (or sometimes just a \dfn{perfect hypercube}) is a semimagic hypercube with all diagonals, including broken diagonals, summing correctly. This is not implemented. } The terminology in this area is pretty confusing. In \code{is.magichypercube()}, if argument \code{give.answers=TRUE} then a list is returned. The first element of this list is Boolean with \code{TRUE} if the array is a magic hypercube. The second element and third elements are answers from\code{is.semimagichypercube()} and \code{is.diagonally.correct()} respectively. In \code{is.diagonally.correct()}, if argument \code{give.answers=TRUE}, the function also returns an array of dimension \code{c(q,rep(2,d))} (that is, \eqn{q\times 2^d}{q*2^d} elements), where \eqn{q}{q} is the length of \code{func()} applied to a long diagonal of \code{a} (if \eqn{q=1}{q=1}, the first dimension is dropped). If \eqn{q=1}, then in dimension \code{d} having index 1 means \code{func()} is applied to elements of \code{a} with the \eqn{d^{\rm th}}{d-th} dimension running over \code{1:n}; index 2 means to run over \code{n:1}. If \eqn{q>1}, the index of the first dimension gives the index of \code{func()}, and subsequent dimensions have indices of 1 or 2 as above and are interpreted in the same way. An example of a function for which these two are not identical is given below. If \code{func=f} where \code{f} is a function returning a vector of length \code{i}, \code{is.diagonally.correct()} returns an array \code{out} of dimension \code{c(i,rep(2,d))}, with \code{out[,i_1,i_2,...,i_d]} being \code{f(x)} where \code{x} is the appropriate long diagonal. Thus the \eqn{2^d} equalities \code{out[,i_1,i_2,...,i_d]==out[,3-i_1,3-i_2,...,3-i_d]} hold if and only if \code{identical(f(x),f(rev(x)))} is \code{TRUE} for each long diagonal (a condition met, for example, by \code{sum()} but not by the identity function or \code{function(x){x[1]}}). } \references{ \itemize{ \item R. K. S. Hankin 2005. \dQuote{Recreational mathematics with R: introducing the \pkg{magic} package}. R news, 5(1) \item Richards 1980. \dQuote{Generalized magic cubes}. \emph{Mathematics Magazine}, volume 53, number 2, (March). } } \author{Robin K. S. Hankin} \note{ On this page, \dQuote{subhypercube} is restricted to rectangularly-oriented subarrays; see the note at \code{subhypercubes}. Not all subhypercubes of a magic hypercube are necessarily magic! (for example, consider a 5-dimensional magic hypercube \code{a}. The square \code{b} defined by \code{a[1,1,1,,]} might not be magic: the diagonals of \code{b} are not covered by the definition of a magic hypercube). Some subhypercubes of a magic hypercube are not even semimagic: see below for an example. Even in three dimensions, being perfect is pretty bad. Consider a \eqn{5\times5\times 5}{5x5x5} (ie three dimensional), cube. Say \code{a=magiccube.2np1(2)}. Then the square defined by \code{sapply(1:n,function(i){a[,i,6-i]}, simplify=TRUE)}, which is a subhypercube of \code{a}, is not even semimagic: the rowsums are incorrect (the colsums must sum correctly because \code{a} is magic). Note that the diagonals of this square are two of the \dQuote{extreme point-to-point} diagonals of \code{a}. A \dfn{pandiagonal magic hypercube} (or sometimes just a \dfn{perfect hypercube}) is semimagic and in addition the sums of all diagonals, including broken diagonals, are correct. This is one seriously bad-ass requirement. I reckon that is a total of \eqn{\frac{1}{2}\left( 3^d-1\right)\cdot n^{d-1}}{(3^d-1)n^(d-1)/2} correct summations. This is not coded up yet; I can't see how to do it in anything like a vectorized manner. } \seealso{\code{\link{is.magic}}, \code{\link{allsubhypercubes}}, \code{\link{hendricks}}} \examples{ library(abind) is.semimagichypercube(magiccube.2np1(1)) is.semimagichypercube(magichypercube.4n(1,d=4)) is.perfect(magichypercube.4n(1,d=4)) # Now try an array with minmax(dim(a))==FALSE: a <- abind(magiccube.2np1(1),magiccube.2np1(1),along=2) is.semimagichypercube(a,g=TRUE)$rook.sums # is.semimagichypercube() takes further arguments: mymax <- function(x,UP){max(c(x,UP))} not_mag <- array(1:81,rep(3,4)) is.semimagichypercube(not_mag,func=mymax,UP=80) # FALSE is.semimagichypercube(not_mag,func=mymax,UP=81) # TRUE a2 <- magichypercube.4n(m=1,d=4) is.diagonally.correct(a2) is.diagonally.correct(a2,g=TRUE)$diag.sums ## To extract corner elements (note func(1:n) != func(n:1)): is.diagonally.correct(a2,func=function(x){x[1]},g=TRUE)$diag.sums #Now for a subhypercube of a magic hypercube that is not semimagic: is.magic(allsubhypercubes(magiccube.2np1(1))[[10]]) data(hendricks) is.perfect(hendricks) #note that Hendricks's magic cube also has many broken diagonals summing #correctly: a <- allsubhypercubes(hendricks) ld <- function(a){length(dim(a))} jj <- unlist(lapply(a,ld)) f <- function(i){is.perfect(a[[which(jj==2)[i]]])} all(sapply(1:sum(jj==2),f)) #but this is NOT enough to ensure that it is pandiagonal (but I #think hendricks is pandiagonal). is.alicehypercube(magichypercube.4n(1,d=5),4,give.answers=TRUE) } \keyword{array} magic/man/perfectcube5.Rd0000644000176200001440000000041113434564446014761 0ustar liggesusers\name{perfectcube5} \alias{perfectcube5} \docType{data} \title{A perfect magic cube of order 5} \description{ A perfect cube of order 5, due to Trump and Boyer } \usage{data(perfectcube5)} \examples{ data(perfectcube5) is.perfect(perfectcube5) } \keyword{datasets} magic/man/nqueens.Rd0000644000176200001440000000246214010577366014067 0ustar liggesusers\name{nqueens} \alias{nqueens} \alias{bernhardsson} \alias{bernhardssonA} \alias{bernhardssonB} \title{N queens problem} \description{ Solves the N queens problem for any n-by-n board. } \usage{ bernhardsson(n) bernhardssonA(n) bernhardssonB(n) } \arguments{ \item{n}{Size of the chessboard} } \details{ Uses a direct transcript of Bo Bernhardsson's method. All solutions (up to reflection and translation) for the 8-by-8 case given in the examples. } \references{ \itemize{ \item Bo Bernhardsson 1991. \dQuote{Explicit solutions to the n-queens problem for all \eqn{n}}. \emph{SIGART Bull.}, 2(2):7 \item Weisstein, Eric W. \dQuote{Queens Problem} From \emph{MathWorld--A Wolfram Web Resource} \url{https://mathworld.wolfram.com/QueensProblem.html} } } \author{Robin K. S. Hankin} \examples{ bernhardsson(7) a <- matrix( c(3,6,2,7,1,4,8,5, 2,6,8,3,1,4,7,5, 6,3,7,2,4,8,1,5, 3,6,8,2,4,1,7,5, 4,8,1,3,6,2,7,5, 7,2,6,3,1,4,8,5, 2,6,1,7,4,8,3,5, 1,6,8,3,7,4,2,5, 1,5,8,6,3,7,2,4, 2,4,6,8,3,1,7,5, 6,3,1,8,4,2,7,5, 4,6,8,2,7,1,3,5) ,8,12) out <- array(0L,c(8,8,12)) for(i in 1:12){ out[cbind(seq_len(8),a[,i],i)] <- 1L } } \keyword{array} magic/man/magic.Rd0000644000176200001440000000237613434564446013501 0ustar liggesusers\name{magic} \alias{magic} \title{Creates magic squares} \description{ Creates normal magic squares of any order \eqn{>2}{>2}. Uses the appropriate method depending on n modulo 4. } \usage{ magic(n) } \arguments{ \item{n}{Order of magic square. If a vector, return a list whose \eqn{i}{i}-th element is a magic square of order \code{n[i]}} } \details{ Calls either \code{magic.2np1()}, \code{magic.4n()}, or \code{magic.4np2()} depending on the value of \code{n}. Returns a magic square in standard format (compare the \code{magic.2np1()} et seq, which return the square as generated by the direct algorithm). } \references{William H. Benson and Oswald Jacoby. \emph{New recreations with magic squares}. Dover 1976. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic.2np1}}, \code{\link{magic.prime}}, \code{\link{magic.4np2}}, \code{\link{magic.4n}},\code{\link{lozenge}}, \code{\link{as.standard}}, \code{\link{force.integer}}} \examples{ magic(6) all(is.magic(magic(3:10))) ## The first eigenvalue of a magic square is equal to the magic constant: eigen(magic(10),FALSE,TRUE)$values[1] - magic.constant(10) ## The sum of the eigenvalues of a magic square after the first is zero: sum(eigen(magic(10),FALSE,TRUE)$values[2:10]) } \keyword{array} magic/man/eq.Rd0000644000176200001440000000260713434564446013023 0ustar liggesusers \name{eq} \alias{eq} \alias{ne} \alias{gt} \alias{lt} \alias{ge} \alias{le} \alias{\%eq\%} \alias{\%ne\%} \alias{\%gt\%} \alias{\%lt\%} \alias{\%ge\%} \alias{\%le\%} \title{Comparison of two magic squares} \description{ Compares two magic squares according to Frenicle's method. Mnemonic is the old Fortran \dQuote{.GT.} (for \dQuote{Greater Than}) comparison et seq. To compare magic square \code{a} with magic square \code{b}, their elements are compared in rowwise order: \code{a[1,1]} is compared with \code{b[1,1]}, then \code{a[1,2]} with \code{b[1,2]}, up to \code{a[n,n]}. Consider the first element that is different, say \code{[i,j]}. Then \code{ao)`0u!"{1y?$y |>_?c: (y@U{0L6.Dy |tʌ:z8b@r>@\G \}qt@J(8Z&|>_@VyD)#aV<YE|>_+Mp*|>_QKCj,"SS qvWCIhS,N Dzu>L̺ ?9G) Dũ"LǼ(Lڰ1l_@b3C D 3Lʺ @r+.l|U'@Dja0 R@O7af݈j-QV ۤՃM $*olŸ`Ȉw`gJdUHQ D9J|JW(<:cCR|P }n  W))H2ARlf߃)97܊8 ޮ{WZl`@d3PupVΏq^HɐQ5rvV&#"1H(R+^ ʌ&簮>t5I+} l 3 O<s،WGo#>- "R&&"{0YHf H9y0-fԸ=@}U.DUdEd-"H;~LȺsGr)eVѴ eoBS>ie"dLI,L:Sxv1eEd." 8`1&e]-LTcMٸy L +S0=6ȻD)eڥm#*}ie"H"!ϼsGzHIe Eh멓W*1"i ${4+ZYTM-A_KJlʈ`0  3`v}8#{>|K+We*g}5ieI#`@dPǙ9ף`1cҤ4_ʅh.L6mD0$s`lŸ)d$$L {e[}7{H?"d0xNJPZnwjֆJ)v D 1;^SCvxm?ie#(Yq !f2i+oƑ=RcGQҏC.Z줉c;ߋf)e# hY`x)GCXJyb}<ޙ$ DG  10#L]_2xuQ^U뤕ɦ((xg6d62P8dr(\ֵRcMfa0 #|^b$H*Vr>.7w\+^R#RMo<Fw_pylI&BF(LGx2yFkO ީ;Woٜ $DmS0=6ȻD "rڶP^mI):`0 CL01J)|)qy#r v4wN46d"8iW)3G=6l{;m H3 -%8d(cm<ޙ,`@Q$Lqf݅4 "-QV ۄbsOZ0А\2NR;66f"`0d0x9SK$Ԉ:cCRLb0IYC&2ɡOe  DBLZQ$P^;w Ů1P0:W ;qV<ޙdc00`x)GCHB(L0x@3 3ܛ㋗P+"} *]=x>1! -zɱ#$ԊPѴ eoBS>Mx G#栴x9C&r/w]@py.dbWP#"ZKO5T)xgv`R<mۈi{_,v`BbNH)ND L1Q(-^YjDD?% v n] \@F H+pF|P+"r]X[3>pYN܁DCA/g\<þh)Gyh.\gc0p(c3.Fi K#FDt`/5w`02AViW '_(FD6lmx`PYb!dᘝ/C&"M;w[bW   8Lκ%#)6[R+*Vf#\1(LqEˑ4QBȫ|/b6 'aϼLBBZ{j~|t%*ݏ # 1I"":^]fW.@Uz @89!%.WR" bױv4w!V"e0LƴAqWPZ#ϔP#""}zP(6?@PY``#P_1)*HDKw;; DA?sonjE'I-kPV?.] ,$8ǐ?JJD;W꟢^,vSb0㐧`^r+FDDbcoP9`0 ~㐉B+T51 Qi0xrNT#"" vck/n=k*ݛ1 :̄q()|!ES5xg0h$~LϽ 3qDDյoBYTSvu1h  (R$֊+w JbA)QZ)3$ՈȻN QRC&"2Asw%܅ /<d%PsaZ͈KY}++uP9.6 dxnH͑X+ry*","mU4BY4u}.TKO=y܉^d"g0:Sxa]օpQ0 +?7|rY C}mƚ;q%e+ " Ο ; h)-~W߀”|_PU` A01*hR-DuဈH])phog7GN%< WpvZP3ўڰ1ؽp`0 VCa@P׌8??R =U?ï n9S "$[?ƤaV(]VJDtOר/3a9)vs#RC.~  'Iv*%_ҏ:)?;8a6ŶƗnhm0\].ŃH(M> 󊗣8Dbc8p>?~Vbs'}nwVr*Ad )6 {?=881[p ~0a9*ooTj!;8jFP}e( .Cn"@q#;imnǡigw>zGٜY;^t5.GS "`x)t \ :ei#G`ʈ*GF D^|B0Ȼ!s8j6ɫ[}U.DU뻆˰sD'}y 8-/g=M>W:Ȉm ;G, "/rd-x+H!VggBt[@ar5()|Iنʠ8z`X׹5>i+H^ehA:b 2J0&mp &=(q j \;a'R5=nOܢ'06"eqG #ھ) y{ς c:C3`M*̸r``4$d`v2F}q 9n-P0kwȿ ss~pn|\00|/gd] rɇNǀ` KuhM]09MS:wA;WbMh6^ʀ7Q3(k[[pǁ[01*\7̿B3h Ho#ߩk0"LCe5={*|It8 J cďqj楆$Aʅ8 f-2QGa`.5O5diޱW.āt0annʿx=^ ediqDrl4b;{)3֑Ć5njqlQϦzjeOI51~OVw4ixLV޿YJk~<9&.N$Oٿhi}',ZULq@"4M%d'NwZP]1@rUyFyE#a6.'Z4% d y8@';P_$6 - hH bkI;8@^`>Oapm6 d&&=02P@fc0 Gt dD7lDzr!Y 9P$ d.>$!z[p NrFI@b tMπr2 (e@LlڏG n}K@z6'=z{X ݭO%>?] d#Bi\B@!p PWt~'{ /ם}RSS@ tvvըBUUn<)@^Uk{k-TorxKd2$ڙ\pNRX&Lʞz#?6&8 `| xȅ,K7b |k_',*wعZza<8`O,$ bժUx'v/?$&&>:}a8\ ,Ɖ~fQCZ$WP@F.09 Tg^~ d537xf͒Zin: N~o~?@X9iʹ\RpÙ +B E|V 1m*' ܴ2lvs܋Lqŷ%%%<EG*,!6Њ{Q_|KbHhzEԤ%0Srs) yr'E钇g\q}}}g}v]_!໋B#g}Mevv-5{Cȷߤt[wQ9__0j>}k_ ݟ{ceк8cz( m|s\|H&IL  ݯ֭ConpUWizqC^ن/OB}@zNh=BVWRrM}3Z`;>Lb֭شi6oތ]vᢴĝB*rF& 0&:+nfGD mE`ơﱰl{&{r^GWFq)OB- ك}oEFz! )=O &ݡmDFq"mPnPM\yxWvっP@ IDAT(:oj\zP+bx!nXf ZZZN;؍>3T-vk\G=e ~?{1r)r:?׏;2QhE+O~ꬵĺ_c[F >튜J Z P("uʕx ?WG |ӟۀg|A{%?T L]6C?G3\ Aq?| C`@z+-[yyyxrB:g߬9xb|ڎ08Dnww}='lpAs7B hTZE pG {9&Nѡ{#DS x%}eh"UDܴoqkz쎷^H$ 'qvpᠳ?C ho]ENذVi:,\pOh * t8|SJ׆ 0bD/bݧLzѳa%4MM׳hJC;bƈ񓟄9!?/zLN d`xU}30 |jNw{h^Ɵg0YwD3rFG̾C@4m`Kw/3kEd bch{ׇ>L+ZhQv ҢWICUm?6?aџJ__ !Lm_4%{%>+dо۬;,hNlZ;{0UO  . V6FdLuh>(O-Qٴ88z:ybRFVuwSSS3z5}+CUTWmt$C-!FzO3ΈQ5?y~|*'04]>_mcՍf& w*>yىgm,\~ g:WXxrPпVv#wYLf4| { 3^ \=Dwؽ蜄o~K{s-00$kXo[ 4]ZG0i.`ÿE\B pR |=9믿'<}m!ܝ:-NG҈b0 ZzZr?zww~,ǯF)3T㣯`jּl3 uFٺ h3\ٹ`|!}7:x ?aÆ ضmjkk܌vyNBӲCecu?C$*MLz `ݺu¡CpN:;4zR4A"4`HJ_o  I`@7 }?Ec= |l|a 4p=39`9a*))AII^loi L7aDٽJ/>,tNVOv Xnx/ZhYW)X!"1'=UIgYEX u^ TosxՍr&^7?&=GWDc0 OSgk{OxHcgE^6? ؍Ҥ!2 D sEL!`?sc1wW~OO~awͫkUpbbf:'D`@d聖o{>nkAf>p3G^[[zFW\Òh=+j>su!2\0*)=c Au,U|>"ꫯ⩧駟S3@vv6 sNEbjDM[nڵk" }c5|`ZKDx5 O6foBg!@ Gx饗6m¯~+CwfvvCCMM q7;"q*(=;5?VYzn|d` D gah HLf^j~]`0 @-tDZa;];& q8~/GrѤ-fm˛h^ 0D1 !^IgE١i!FOyVkދNb $迟L@f(p+m۶I{V23+cx~$e $ Q٤wu0\yBV g\@ﴁmwL(~20:i`@$ovnR:&V΀HfoofvfXfbݺuXj)}/4ͤ&2q\c@$@¶?x衇L|[ްy11"-{u p `бϟg( 1> 2ᣲ'ډ;-ݻhJB$!9_z:B|8\ #c#o`e?dr'nСZ}q G?| i;mˁgV博"i=H%gTGv͡T~{DǏGii)rrr4-&(s[J8FOP' ,F:s=k>|y ȿxy} ϛ9cbbpg~-C" ^he3o_𡠻x'  7Y&؈k,f4yD^פ:8b`38ʟד׬uDz%a5kD2dznQ?Psn4BCsʾ7E``TV؈S$A1Xb#yPdz47\N``(=ð"?8,Ho `(+Dy悺r 2YkaDM!p&،H ߸̸Y҂ wŊh%:5@PlJP8`m\eUdkC p3 k%T}bc8pEq׻dŎ֛}80W{UCza5FZyr^!p/8G"Kkk ܍!s\/}+׬s0F΅!Dw(ոFYS c 8SyͲs \;ԢBz@Y\;%CAn!NGO> c 8bRܹ>X+p׏ѩvTq`r ꑹz3wP8ܹ`w#3kV.҂csA3Di 38Va(  Nx*a>Lq@F1ÁDV4 ؉Ecr6; |j\Y`fgLvh'`@~3\fi8m@0 sA;# qb#j'(`@Cð~|EΝڈkH +q]H-qz% 31&n fr͆EkV+2g%fn qŀ-rYU_9G H7NSf( +1!NUDZZ}D8Z8ehme|he kdb0 aae=< v-PIj߸T ͦ5К:UcEs{'se Yr/nW$6ZZ6ڱߎU>:L;Y܊5K2No`ߌz~vZRZ lWeZ"UyYqpֿ ĩYCnk\4i ӌkI#d)YĜK:Qx2Y3H6<.Xyy^$J [ٹ`|U9xȮUnN=L-)n1 nl< atbb}Ujd]k|IEJ e {nmĩ,G vk'+IT8Q ;z%YJN&u;c_ d=si̬գOɌkV{@©29saZ-;ר}ΩG TV*盘׬Y E~_k܉LaheieGCi*~볱Q%TI¹N\sY[iHݪkx1 iTh`>xЎzxP\n5r+ى`\D1esƷ9FF)׬N dHaqUO>ZF i $ 7ӡl㖣EpY4sʴ*O ȨwCTᚈdĉZMLVl=rk۟?`@9u-N&f>2?' +>^Ϛ ^Ǩx͒ hHN_Kob2;L҆H+:q Ŋ_zM}&3^gzx`@7.씝~UOpda0/y *Bd]ID XF:xʺձCN5^oqü;(k4V@epp@1o\ V|ff< } CHf+VvKcc\ܹ^JPG dvgd^Z̾5,w(X;܇# I s5CCq+ps] 7.:Ս>c8܁S ` p6+n9l4;PYPP w.8G lRK2˺fT .8\d7s,>1CYҊk1R<ծY8 dd5kDqa l? QzRUn?30؈ ;x͒Yxmk l?R W/&j)_e\kL2Y2#sZKgLDFx;v8ur݉*IDAT8 AaK^jD=pDަ";F鷧uF$/Z^RVpYZ ;8NiAu(:F3;r6Dγ3xFM˘ɣDtVuN_{@DCc0 r+v"S D`@pvw= r"Epev22E1QY!1Stzy eSzwY \ \G-CWtoQ,{m@ DD :|f_'z"G a(9z@| D  -R"p*FVY;  Z RG lb7e+OWԊ;bNe}"`0 G#@ UNO7"b0 2գZ7$z:HHn"0I7vvw2D`0 6>3:;P0|"0Ib~GVGͩ"1 z`s[ɪ©"0Sݩڵa(;h\ z#k`@FÄ9z@d":8H& D0i`ZF;kwTf¡-.Zc0q`SUm'P zqT`@4F;< DGy"-T-Pi&w.`@5hew}~8z@$<ώPɮɝ DqWyC=ꝗ; DqĀ ݁;a0 O{A#0i`@8i@ C TZK Q-S^qhh j*U*uܹ@Srjg)N-db0 W{ǁ,NZ[ܹ@t ;v&Np@`@.iqhӦ:r4L< 9q􀼊) Ue6tܹ@^`@Hֹ8yJa \ /a0 puv7 rw:҉ Hin6ͣnN; HYN6--c012J :G= a0 :puJG)5;]"Z^xQgg' ?gR G vn 5εd d+8Zp1! -zɱ#$| `L MP&4u3\4O*baF{3b|k%W.|bLܜŭ_۷r!Z5\ 3D"2Gwk˻NǞ7%L8p6qmk:zQV=ݑi R+^ j$ƭk9@[údd ~"Y9?y"!&CbqB%:::2W.]P+P0'b0+Lɹ>_ZEP@t(44'\8 ޮ{Wźa'Yۈʅil]+fDDd[gk& +I`DJ04@yT'TûU@|z!3aJ $ՈT߁+]НpI0'FżI:]RHU_\5u\ ^9~ #96GbHMPVM] .ԝH@HpvS>PDDC}VW.;Nw@|zax⩘W c2&FDDdF}[E0gw< x9%T#""2CgA?9;?t"""5j!v*cݤ >zYwr3EvS]u+4!TG DBn(-^s%Ո;e v."~2g?JRHc!ߎbeKd0'ɘ2F̿TI""Hʅ8P9 a0D4 aSw&":/l!s0x9 RfHڱQ0D!|cBSRr%֊kC JbTL˽3D/AR}+uP9a0AxQR0w&"ҠkG_Bi``lI""rU(\#]{af р;Dif|wrإc0D4 d%eUI5""R_g!}@8d@D K#FDDj {e b7& DB/g\㝉ȕh)GyB4t*ݗ9 L$R1~=>%Պ>껰ke2dL/%O(J-FDDbcxn ]Be2E3/ŜǑ?RJ;?E[OXY,``1;OϽ3@?QRiۀi \)k1؄;tWaMϰq%ݓ= l$cȴ1x9F$!FDDڱxv1Be[DBsGrI""Ҧi#*ݑ "baF;۷rZ ŮH 10<-zc3.P#"b}񗼍 1(JF@^yEˑ4QBlix!ďwY9?y !fZׄCGnGm  cx)97狑P+"xm?8#Di HUga[C +Tga0p Y;_P2NP#"r߭ 屋q $Lqf݅4I""!o.]s18уԸ.;y C& !# Lü(L%FD@6=8 .#x'_,ND v4wN4v#`B2F){w&rڶ(\bN .&# 㼂Řu]ZzNLQ1x破x9r&KY7ЁMr2P !#xg"ghZ7{pY*c^9&-´ܛ㋗P+"}.]0xOܢ'16jDD:zAlixV8d R# ٸnG{ ("F?UBejU.DC6S4 WG0)*rF$ܬkkW枴`0 dM/LGi ̐R~)z屙'= H79YWbNH˓PX]u `0 d<3N$Ԋșj>@yBTSJyl(&# d&CI#y9GkO < I'Q $b^r$.<"UxtǦda0 ^9~ #96GBRѴ e ۻ(:ϻ9lN$@ lKQe-"QH:K0腎 AR j teo;L-)N;+ Ir&}LZowwɳ>.;kzM=z 82oE;ty&yo)cxhֽ+jX5 땛-Z7Rmz^&;qt ml;?`^Ը2ЪHGn1.AY2m ժrk:?1ndUA)YpʾhUlvйMy1)dW,RyyMC> Od2AxKz6R~TEO5]7F5c ( zgxN^J}Ie K(*]JכuT[Ac‹(,(W~K[jTMSwj`M"E1YʴwƬuHt:N1ruUAXjjhKe2rbU7ikaU4CZg0dO(rp PP_KL2o)m֝%<+b߲*Ei3Z]^.xt. $ ?;?aWL!Kd7U9^ 1DrUA^E&5Zu}IcbcU ڧ5 Ntd/!Kr_VcEKWebv&#zK:ӵO!LF#r9ͪ LwZJdbf.SmbHD+PVPShgZz,qP *>u/&y6]|库&A`/Iu-ZRYfJ:2됁rU?г Ud+jnS&y=Q OaU+_ynS;~bb̀ꒇnQ,3یMV[:sXI&0 q=>}f~7Χ55dC1 f6mٝ띯W$Ce2ހ٣sdy{V H۱::dB'˂tGT[,ӫ!\5̹t׳C|bdzQU=`9S(6oh2bd8^uWZhvLFY,oұ؇u6d@1=1}, and function \code{panmagic.6nm1(m)} returns a panmagic square of order \eqn{n=6m-1} for \eqn{m\geq 1}{m>=1}, using a classical method. Function \code{panmagic.4n(m)} returns a magic square of order \eqn{n=4m}} \item{n}{Function \code{panmagic.6npm1(n)} returns a panmagic square of order \eqn{n} where \eqn{n=6m\pm 1}{n=6n+/-1}} } \details{ Function \code{panmagic.6npm1(n)} will return a square if \code{n} is not of the form \eqn{6m\pm 1}{6n+/-1}, but it is not necessarily magic. } \references{ \dQuote{Pandiagonal magic square.} \emph{Wikipedia, The Free Encyclopedia.} Wikimedia Foundation, Inc. 13 February 2013 } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ panmagic.6np1(1) panmagic.6npm1(13) all(sapply(panmagic.6np1(1:3),is.panmagic)) } \keyword{array} magic/man/magic.constant.Rd0000644000176200001440000000155113434564446015323 0ustar liggesusers\name{magic.constant} \alias{magic.constant} \title{Magic constant of a magic square or hypercube} \description{ Returns the magic constant: that is, the common sum for all rows, columns and (broken) diagonals of a magic square or hypercube } \usage{ magic.constant(n,d=2,start=1) } \arguments{ \item{n}{Order of the square or hypercube} \item{d}{Dimension of hypercube, defaulting to \code{d=2} (a square)} \item{start}{Start value. Common values are 0 and 1} } \details{ If \code{n} is an integer, interpret this as the order of the square or hypercube; return \eqn{n({\rm start}+n^d-1)/2}{n(start+n^d-1)/2}. If \code{n} is a square or hypercube, return the magic constant for a normal array (starting at 1) of the same dimensions as \code{n}. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ magic.constant(4) } \keyword{array} magic/man/force.integer.Rd0000644000176200001440000000115013434564446015140 0ustar liggesusers\name{force.integer} \alias{force.integer} \title{Integerize array elements} \description{ Returns an elementwise \code{as.integer}-ed array. All magic squares should have integer elements. } \usage{ force.integer(x) } \arguments{ \item{x}{Array to be converted} } \author{Robin K. S. Hankin} \note{ Function \code{force.integer()} differs from \code{as.integer()} as the latter returns an integer vector, and the former returns an array whose elements are integer versions of \code{x}; see examples section below. } \examples{ a <- matrix(rep(1,4),2,2) force.integer(a) as.integer(a) } \keyword{array} magic/man/transf.Rd0000644000176200001440000000103213434564446013702 0ustar liggesusers\name{transf} \alias{transf} \title{Frenicle's equivalent magic squares} \description{ For a given magic square, returns one of the eight squares whose Frenicle's standard form is the same. } \usage{ transf(a, i) } \arguments{ \item{a}{Magic square} \item{i}{Integer, considered modulo 8. Specifying 0-7 gives a different magic square} } \author{Robin K. S. Hankin} \seealso{\code{\link{is.standard}}} \examples{ a <- magic(3) identical(transf(a,0),a) transf(a,1) transf(a,2) transf(a,1) \%eq\% transf(a,7) } \keyword{array} magic/man/sam.Rd0000644000176200001440000000217513434564446013176 0ustar liggesusers\name{sam} \alias{sam} \title{Sparse antimagic squares} \description{ Produces an antimagic square of order \eqn{m} using Gray and MacDougall's method. } \usage{ sam(m, u, A=NULL, B=A) } \arguments{ \item{m}{Order of the magic square (not \dQuote{\code{n}}: the terminology follows Gray and MacDougall)} \item{u}{See details section} \item{A,B}{Start latin squares, with default \code{NULL} meaning to use \code{circulant(m)}} } \details{ In Gray's terminology, \code{sam(m,n)} produces a \eqn{SAM(2m,2u+1,0)}. The method is not vectorized. To test for these properties, use functions such as \code{is.antimagic()}, documented under \code{is.magic.Rd}. } \references{ I. D. Gray and J. A. MacDougall 2006. \dQuote{Sparse anti-magic squares and vertex-magic labelings of bipartite graphs}, \emph{Discrete Mathematics}, volume 306, pp2878-2892 } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}},\code{\link{is.magic}}} \examples{ sam(6,2) jj <- matrix(c( 5, 2, 3, 4, 1, 3, 5, 4, 1, 2, 2, 3, 1, 5, 4, 4, 1, 2, 3, 5, 1, 4, 5, 2, 3),5,5) is.sam(sam(5,2,B=jj)) } \keyword{array} magic/man/recurse.Rd0000644000176200001440000000165313434564446014066 0ustar liggesusers\name{recurse} \alias{recurse} \title{Recursively apply a permutation} \description{ Recursively apply a permutation to a vector an arbitrary number of times. Negative times mean apply the inverse permutation. } \usage{ recurse(perm, i, start = seq_along(perm)) } \arguments{ \item{perm}{Permutation (integers 1 to \code{length(start)} in some order)} \item{start}{Start vector to be permuted} \item{i}{Number of times to apply the permutation. \code{i=0} gives \code{start} by definition and negative values use the inverse permutation} } \author{Robin K. S. Hankin} \seealso{\code{\link{hudson}}} \examples{ n <- 15 noquote(recurse(start=letters[1:n],perm=shift(1:n),i=0)) noquote(recurse(start=letters[1:n],perm=shift(1:n),i=1)) noquote(recurse(start=letters[1:n],perm=shift(1:n),i=2)) noquote(recurse(start=letters[1:n],perm=sample(n),i=1)) noquote(recurse(start=letters[1:n],perm=sample(n),i=2)) } \keyword{array} magic/man/panmagic.4.Rd0000644000176200001440000000116514010574705014323 0ustar liggesusers\name{panmagic.4} \alias{panmagic.4} \title{Panmagic squares of order 4} \description{ Creates all fundamentally different panmagic squares of order 4. } \usage{ panmagic.4(vals = 2^(0:3)) } \arguments{ \item{vals}{a length four vector giving the values which are combined in each of the \eqn{2^4}{2^4} possible ways. Thus \code{vals=2^sample(0:3)} always gives a normal square (0-15 in binary).} } \references{\url{https://www.grogono.com/magic/index.php}} \author{Robin K. S. Hankin} \seealso{\code{\link{panmagic.6npm1}}} \examples{ panmagic.4() panmagic.4(2^c(1,3,2,0)) panmagic.4(10^(0:3)) } \keyword{array} magic/man/apl.Rd0000644000176200001440000000334013434564446013165 0ustar liggesusers\name{apl} \alias{apl} \alias{take} \alias{apldrop} \alias{apltake} \alias{apldrop<-} \alias{apltake<-} \title{Replacements for APL functions take and drop} \description{ Replacements for APL functions take and drop } \usage{ apldrop(a, b, give.indices=FALSE) apldrop(a, b) <- value apltake(a, b, give.indices=FALSE) apltake(a, b) <- value } \arguments{ \item{a}{Array} \item{b}{Vector of number of indices to take/drop. Length of \code{b} should not exceed \code{length(dim(a))}; if it does, an error is returned} \item{give.indices}{Boolean, with default \code{FALSE} meaning to return the appropriate subset of array \code{a}, and \code{TRUE} meaning to return the list of the selected elements in each of the dimensions. Setting to \code{TRUE} is not really intended for the end-user, but is used in the code of \code{apltake<-()} and \code{apldrop<-()}} \item{value}{elements to replace} } \details{ \code{apltake(a,b)} returns an array of the same dimensionality as \code{a}. Along dimension \code{i}, if \code{b[i]>0}, the first \code{b[i]} elements are retained; if \code{b[i]<0}, the last \code{b[i]} elements are retained. \code{apldrop(a,b)} returns an array of the same dimensionality as \code{a}. Along dimension \code{i}, if \code{b[i]>0}, the first \code{b[i]} elements are dropped if \code{b[i]<0}, the last \code{b[i]} elements are dropped. These functions do not drop singleton dimensions. Use \code{drop()} if this is desired. } \author{Robin K. S. Hankin} \examples{ a <- magichypercube.4n(m=1) apltake(a,c(2,3,2)) apldrop(a,c(1,1,2)) b <- matrix(1:30,5,6) apldrop(b,c(1,-2)) <- -1 b <- matrix(1:110,10,11) apltake(b,2) <- -1 apldrop(b,c(5,-7)) <- -2 b } \keyword{array} magic/man/notmagic.2n.Rd0000644000176200001440000000115713434564446014534 0ustar liggesusers\name{notmagic.2n} \alias{notmagic.2n} \title{An unmagic square} \description{ Returns a square of order \eqn{n=2m} that has been claimed to be magic, but isn't. } \usage{ notmagic.2n(m) } \arguments{ \item{m}{Order of square is \eqn{n=2m}} } \references{\dQuote{Magic Squares and Cubes}, Andrews, (book)} \author{Robin K. S. Hankin} \note{This took me a whole evening to code up. And I was quite pleased with the final vectorized form: it matches Andrews's (8 by 8) example square exactly. What a crock} \examples{ notmagic.2n(4) is.magic(notmagic.2n(4)) is.semimagic(notmagic.2n(4)) } \keyword{array} magic/man/strachey.Rd0000644000176200001440000000252313434564446014235 0ustar liggesusers\name{strachey} \alias{strachey} \title{Strachey's algorithm for magic squares} \description{ Uses Strachey's algorithm to produce magic squares of singly-even order. } \usage{ strachey(m, square=magic.2np1(m)) } \arguments{ \item{m}{magic square produced of order \code{n=2m+1}} \item{square}{magic square of order \code{2m+1} needed for Strachey's method. Default value gives the standard construction, but the method will work with any odd order magic square} } \details{ Strachey's method essentially places four identical magic squares of order \eqn{2m+1} together to form one of \eqn{n=4m+2}. Then \eqn{0,n^2/4,n^2/2,3n^2/4} is added to each square; and finally, certain squares are swapped from the top subsquare to the bottom subsquare. See the final example for an illustration of how this works, using a zero matrix as the submatrix. Observe how some 75s are swapped with some 0s, and some 50s with some 25s. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic.4np2}},\code{\link{lozenge}}} \examples{ strachey(3) strachey(2,square=magic(5)) strachey(2,square=magic(5)) \%eq\% strachey(2,square=t(magic(5))) #should be FALSE #Show which numbers have been swapped: strachey(2,square=matrix(0,5,5)) #It's still magic, but not normal: is.magic(strachey(2,square=matrix(0,5,5))) } \keyword{array} magic/man/Ollerenshaw.Rd0000644000176200001440000000064113434564446014675 0ustar liggesusers\name{Ollerenshaw} \alias{Ollerenshaw} \docType{data} \title{A most perfect square due to Ollerenshaw} \description{ A 12-by-12 most perfect square due to Ollerenshaw } \usage{data(Ollerenshaw)} \source{ \dQuote{Most perfect pandiagonal magic squares}, K. Ollerenshaw and D. Bree, 1998, Institute of Mathematics and its applications } \examples{ data(Ollerenshaw) is.mostperfect(Ollerenshaw) } \keyword{datasets} magic/man/lozenge.Rd0000644000176200001440000000065013434564446014055 0ustar liggesusers\name{lozenge} \alias{lozenge} \title{Conway's lozenge algorithm for magic squares} \description{ Uses John Conway's lozenge algorithm to produce magic squares of odd order. } \usage{ lozenge(m) } \arguments{ \item{m}{magic square returned is of order \code{n=2m+1}} } \author{Robin Hankin} \seealso{\code{\link{magic.4np2}}} \examples{ lozenge(4) all(sapply(1:10,function(n){is.magic(lozenge(n))})) } \keyword{array} magic/man/apad.Rd0000644000176200001440000000444513434564446013325 0ustar liggesusers\name{apad} \alias{apad} \title{Pad arrays} \description{ Generalized padding for arrays of arbitrary dimension } \usage{ apad(a, l, e = NULL, method = "ext", post = TRUE) } \arguments{ \item{a}{Array to be padded} \item{l}{Amount of padding to add. If a vector of length greater than one, it is interpreted as the extra extent of \code{a} along each of its dimensions (standard recycling is used). If of length one, interpret as the dimension to be padded, in which case the amount is given by argument \code{l}.} \item{e}{If \code{l} is of length one, the amount of padding to add to dimension \code{l}} \item{method}{String specifying the values of the padded elements. See details section.} \item{post}{Boolean, with default \code{TRUE} meaning to append to \code{a} and \code{FALSE} meaning to prepend.} } \details{ Argument \code{method} specifies the values of the padded elements. It can be either \dQuote{\code{ext}}, \dQuote{\code{mirror}}, or \dQuote{\code{rep}}. Specifying \code{ext} (the default) uses a padding value given by the \dQuote{nearest} element of \code{a}, as measured by the Manhattan metric. Specifying \code{mirror} fills the array with alternate mirror images of \code{a}; while \code{rep} fills it with unreflected copies of \code{a}. } \author{Robin K. S. Hankin} \note{ Function \code{apad()} does not work with arrays with dimensions of zero extent: what to pad it with? To pad with a particular value, use \code{adiag()}. The function works as expected with vectors, which are treated as one-dimensional arrays. See examples section. Function \code{apad()} is distinct from \code{adiag()}, which takes two arrays and binds them together. Both functions create an array of the same dimensionality as their array arguments but with possibly larger extents. However, the functions differ in the values of the new array elements. Function \code{adiag()} uses a second array; function \code{apad()} takes the values from its primary array argument. } \seealso{\code{\link{adiag}}} \examples{ apad(1:10,4,method="mirror") a <- matrix(1:30,5,6) apad(a,c(4,4)) apad(a,c(4,4),post=FALSE) apad(a,1,5) apad(a,c(5,6),method="mirror") apad(a,c(5,6),method="mirror",post=FALSE) } \keyword{array} magic/man/minmax.Rd0000644000176200001440000000152713434564446013707 0ustar liggesusers\name{minmax} \alias{minmax} \title{are all elements of a vector identical?} \description{ Returns \code{TRUE} if and only if all elements of a vector are identical. } \usage{ minmax(x, tol=1e-6) } \arguments{ \item{x}{Vector to be tested} \item{tol}{Relative tolerance allowed} } \details{ If \code{x} is an integer, exact equality is required. If real or complex, a relative tolerance of \code{tol} is required. Note that functions such as \code{is.magic()} and \code{is.semimagichypercube()} use the default value for \code{tol}. To change this, define a new Boolean function that tests the sum to the required tolerance, and set \code{boolean} to \code{TRUE} } \author{Robin K. S. Hankin} \seealso{is.magic()} \examples{ data(Ollerenshaw) minmax(subsums(Ollerenshaw,2)) #should be TRUE, as per is.2x2.correct() } \keyword{array} magic/man/arev.Rd0000644000176200001440000000276613434564446013361 0ustar liggesusers\name{arev} \alias{arev} \title{Reverses some dimensions; a generalization of rev} \description{ A multidimensional generalization of \code{rev()}: given an array \code{a}, and a Boolean vector \code{swap}, return an array of the same shape as \code{a} but with dimensions corresponding to \code{TRUE} elements of \code{swap} reversed. If \code{swap} is not Boolean, it is interpreted as the dimensions along which to swap. } \usage{ arev(a, swap = TRUE) } \arguments{ \item{a}{Array to be reversed} \item{swap}{Vector of Boolean variables. If \code{swap[i]} is \code{TRUE}, then dimension \code{i} of array \code{a} is reversed. If \code{swap} is of length one, recycle to \code{length(dim(a))}} } \details{ If \code{swap} is not Boolean, it is equivalent to \code{1:n \%in\% swap} (where \code{n} is the number of dimensions). Thus multiple entries are ignored, as are entries greater than \code{n}. If \code{a} is a vector, \code{rev(a)} is returned. Function \code{arev()} handles zero-extent dimensions as expected. Function \code{arev()} does not treat singleton dimensions specially, and is thus different from Octave's \code{flipdim()}, which (if supplied with no second argument) flips the first nonsingleton dimension. To reproduce this, use \code{arev(a,fnsd(a))}. } \author{Robin K. S. Hankin} \seealso{\code{\link{ashift}}} \examples{ a <- matrix(1:42,6,7) arev(a) #Note swap defaults to TRUE b <- magichypercube.4n(1,d=4) arev(b,c(TRUE,FALSE,TRUE,FALSE)) } \keyword{array} magic/DESCRIPTION0000644000176200001440000000164714335056755013065 0ustar liggesusersPackage: magic Version: 1.6-1 Title: Create and Investigate Magic Squares Authors@R: person(given=c("Robin", "K. S."), family="Hankin", role = c("aut","cre"), email="hankin.robin@gmail.com", comment = c(ORCID = "0000-0001-5982-0415")) Depends: R (>= 2.10), abind Description: A collection of functions for the manipulation and analysis of arbitrarily dimensioned arrays. The original motivation for the package was the development of efficient, vectorized algorithms for the creation and investigation of magic squares and high-dimensional magic hypercubes. Maintainer: Robin K. S. Hankin License: GPL-2 URL: https://github.com/RobinHankin/magic BugReports: https://github.com/RobinHankin/magic/issues NeedsCompilation: no Packaged: 2022-11-14 19:20:55 UTC; rhankin Author: Robin K. S. Hankin [aut, cre] () Repository: CRAN Date/Publication: 2022-11-16 03:50:05 UTC magic/build/0000755000176200001440000000000014334512426012435 5ustar liggesusersmagic/build/vignette.rds0000644000176200001440000000032714334512426014776 0ustar liggesusersmP 0 n( @w]kʴJ-s阝i}ɗ^ǘ?s^a1tP ps[/P]֭Bx=r}Wr}xrjҁ dqy,fC~.L$Ul* 1zoBIso!mM ?pg~57L4Qd- 6eX6V 85FqPTe_m_j P47ÔM ,TuE"UZX,NNJbEYV-(+oMqapX(۪qTɯ?GVR,... [+/K!`}'Rp<=T7I, Ot%5(xʦrCդ~o@2cpae[0mQhfFc[ܕbk*`EVBWTsޖOrm)Yf#6IE(Yzj6$]<<5K?oZ K g Kcြ5?rZ79jd yobA/7[235]>hcyu]~U~# /]`bCCHx7[&aMB1tr~NCo bTۜlw?a4a"]`NM' z֒}ʶj4UQڟv%blز懙(wq0M?m`*HUTu4ln"N(Щ8Yu#kĻw VN-٢Ymr$Zh%7GM&AHmjK6dy5:["D ȦbjUe1d ;{&ں83U+65%SsUY9]z#/SWZG{jn Oee}MzݗuowJS 𙇭8p4T\ͤe>2D&*먔/.cpp)j=uVKg柍,;62\lHr`?DzfFˀt9rseQ|8xdO!\Nxx?͗2O9_.3GgmXkB Bch ^-\^ɒߎMrfK q߂lY\tfx؛`?cp_#uSn 1sǏ//лck~(@9%v?H5͛ {pΔ"kn]_ش&Y`a_(G$+OvcȢEM\sAS֠N7#N1 H[:U'lݐE%paZo[U 6wL0 tI7e_"/'ڜ;nɝvq/PdCil`)Ƌ>2tJNG^|.ilql|-LȆ( u~"DB/yGXWxӂ&k*i^ڳ0BW!W1aScv^Rۍ5AD*4 i@8ix,BUl!;$l䁿"ꆝulIiE|p{XȆ"L3lHT4: M5/LlH2KҘ`dsՏb¤Ӂ [RJyQa`ƑM@n]rD~>jS9uP|dq>_Ҿ/fw;4NŽ AH3?C߷]h'],7qg5GӊF|6DPeMő@hPĊҘ$`-Y]4r4^;qѢWf_  h>p &wk R6?m _ rm@hw3m>#1ivmlMU`l_~%}J6p@dCwݒ5[G&j &t(_*ح>WE >BD`G.WV囋EiD;+SdsS]wٺFYkhLɢB@t>+D3Z'tkܫ?in=z@0:ldxύdF6dHP&Si(7T|Y?PDzwgƷ-^pH,ņv5jor L>GOCCLǓL%WzRPj09ʶ2@ "Ôqdz[Z1&jBrI]:ӑr+2:ө5ϮE ;œctzV7ƽ)k5wXؾ`E.Tee -Vb2JZBwHè,RSβlq/fb*~zVuhek-g;mAtX_BiOVc]]hg57Nhe[J %.Y`{7@ceio\8d4!,pQFo}󈜞f=f JyۅVl.,o|[ceY%I|NqXJGXs3ۧVc͌U;'tTt;DEJmϝctt![y"ii&Fks}cEk 1 N+o\:ﳺ}EŪ_MՒc>v_r"uعnDṳ>}6}#L_CG y+AQlbXH29y?i0 E֎Gp|cU cGe U昄cְ@D. &a3}޴E@TUP8pT(Kޫ߸^5&Zt@ZDgXO'?h#u%[A "c kɝuͦwe0a *:r3U+o⸦&Uk:7a< oðޗdØUZ6cǔ":C>tǘff4zY[`٦`Ih!8oH С6UP$5v-$YsA N4& p0yV)Vyp L#L±i$Wb֙X>OIj/r84M;ydF[7_'g}~U_& i[0&&ūٹ_ zF(e}AÝUϫ?s!Z!$9A^,tWo?>|+XbrQk8c3`iaX1!zk[E*)|LjDt׻3m7_: WTz|yo0p_~:v1"TDT$׽gK8dP k̸iЛ\Jê;ݩϟWVW='FڟzATGsL/ZlkP[ݗ/E!Y3LdL#Ț4T=Q駘Ĕ ,`X'#| T,eIF+oliț2j+KG7*DX7g7{,(&1`BD4DzYEOmagic/tests/0000755000176200001440000000000013434564446012511 5ustar liggesusersmagic/tests/aaa.R0000644000176200001440000002211013434564446013352 0ustar liggesuserslibrary(magic) n <- 10 # first check minmax (NB: includes checking all zeros): stopifnot(all(sapply(0:10,function(i){minmax(rep(i,9))}))) # test magic() for magicness, standardness, and normality for magic(3)..magic(n): stopifnot(is.magic (magic(3:n))) stopifnot(is.standard(magic(3:n))) stopifnot(is.normal (magic(3:n))) # now test some of the specific algorithms: stopifnot(is.magic(strachey(1:n))) stopifnot(is.magic(lozenge (1:n))) stopifnot(is.magic(magic.4n(1:n))) stopifnot(sapply(1:n,function(i){is.square.palindromic(circulant(i))})) # now test for magic.2np1() giving a generalized circulant: stopifnot(sapply(1:n,function(i){is.circulant(magic.2np1(i)%%(2*i+1),c(2,-1))})) # Now test that is.diagonally.correct() in fact extracts the correct elements, # using a function that returns just the first element: test.corners <- function(i){ a <- magic(i) identical(a[c(1,i),c(1,i)],is.diagonally.correct(a,func=function(x){x[1]},g=TRUE)$diag.sums) } stopifnot(all(sapply(3:n,test.corners))) # Now check that, in a 3x3x3 magic cube, the second element of each diagonal is the same: f <- function(x){x[2]} stopifnot(is.diagonally.correct(magiccube.2np1(1),func=f,boolean=FALSE,give=FALSE)) # Now check that the first eigenvalue of a magic square is indeed # equal to its magic constant. # First, define a wrapper to ensure that eigen() returns an integer: eigen.wrap <- function(M){as.integer(round(Re(eigen(M,FALSE,TRUE)$values)))} f <- function(i){minmax(c(eigen.wrap(magic(i))[1],magic.constant(i)))} stopifnot(sapply(3:n,f)) # Now check that the sum of eigenvalues 2,...,n of a magic square is zero: f <- function(i){minmax(c(1,1+sum(eigen.wrap(magic(i))[-1])))} stopifnot(sapply(3:n,f)) # Check hudson() for 6n+1 and 6n-1: stopifnot(sapply(c(6*(1:n)+1,6*(1:n)-1),function(i){is.magic(hudson(i))})) # Check magichypercube.4n() for a range of dimensions and orders: stopifnot(apply(expand.grid(m=1:2,d=2:4),1,function(x){is.magichypercube(magichypercube.4n(x[1],x[2]))})) ## Check magiccube.2np1(): stopifnot(sapply(1:n,function(i){is.magichypercube(magiccube.2np1( i))})) ## Sundry tests for transf; ## is transf(a,0) == a? stopifnot(sapply(3:n , function(i){a <- magic(i);identical(a,transf(a,0))})) ## NB: following two tests *removed* following redefinition of ## "equal", that is eq(), or %eq%. The _old_ definition was to put ## the square into Frenicle standard form, then compare. The _new_ ## definition considers the square directly. ## is transf(a,X) equal (ie eq()) to "a" for different X? #stopifnot(sapply(3:n , function(i){a <- magic(i);eq(a,transf(a,i%%8 ))})) #stopifnot(sapply(3:n , function(i){a <- magic(i);eq(a,transf(a,i%%8+1))})) data(magiccubes) stopifnot(unlist(lapply(magiccubes,is.magichypercube))) data(Ollerenshaw) stopifnot(is.mostperfect(Ollerenshaw)) data(cube2) stopifnot(is.magichypercube(cube2)) data(hendricks) stopifnot(is.perfect(hendricks)) data(perfectcube5) stopifnot(is.perfect(perfectcube5)) data(perfectcube6) stopifnot(is.perfect(perfectcube6)) data(Frankenstein) stopifnot(is.perfect(Frankenstein)) # Comment out the line below because it takes too long #stopifnot(apply(magic.8(),3,is.magic)) ## Now check magic.product() works: f <- function(x){is.magic(magic.product(x[1],x[2]))} stopifnot(apply(expand.grid(3:5,3:5),1,f)) ## Now check some identities for adiag(): a <- matrix(1:6,2,3) a2 <- matrix(1,2,2) a3 <- matrix(1,3,3) x <- 0 dim(x) <- rep(1,7) stopifnot(identical(dim(adiag(x,x,x)),rep(3:3,7))) stopifnot(identical(adiag(a,t(a)),t(adiag(t(a),a)))) stopifnot(identical(adiag(1,1,1,1,1),diag(5))) stopifnot(identical(adiag(a2,a2),kronecker(diag(2),a2))) stopifnot(identical(adiag(a3,a3,a3),kronecker(diag(3),a3))) stopifnot(identical(adiag(matrix(1,0,5),matrix(1,5,0),pad=1:5), kronecker(t(rep(1,5)),1:5))) # Now some more tests. # First, set the dimension. Feel free to change this! n <- 6 # Check that pad value is correctly used: a <- array(43,rep(2,n)) stopifnot(minmax(adiag(a,43,pad=43))) # Check that adiag() plays nicely with subsums(): a <- array(1,rep(1,n)) stopifnot(minmax(subsums(adiag(a,a),2))) # And another test: a <- array(1,rep(1,n)) jj1 <- subsums(adiag(a,0,a),2,wrap=F) x <- array(1,rep(2,n)) jj2 <- adiag(x,x) stopifnot(identical(jj1,jj2)) # Now test adiag() for associativity: jj1 <- array(seq_len(2^n),rep(2,n)) jj2 <- array(seq_len(3^n),rep(3,n)) jj3 <- array(seq_len(4^n),rep(4,n)) f <- function(x,y,z){stopifnot(identical(adiag(adiag(x,y),z),adiag(x,adiag(y,z))))} f(jj1,jj2,jj3) f(jj2,jj3,jj1) f(jj1,jj1,jj1) f(jj3,jj3,jj3) # Now some tests for is.circulant(): a <- array(0,rep(2,10)) a[1] <- a[1024] <- 1 stopifnot(is.circulant(a)) # "break" a by changing just one (randomly chosen) element: a[1,1,1,1,2,1,2,1,1,1] <- 1 stopifnot(!is.circulant(a)) # Now test arev() with some tests: a <- array(1:32,rep(2,5)) stopifnot(identical(as.vector(arev(a)),rev(a))) jj <- as.vector(magic(19))[seq_len(360)] stopifnot(identical(arev(array(jj,3:6)) , array(rev(jj),3:6))) b <- c(TRUE,FALSE,TRUE,FALSE,TRUE) stopifnot(identical(a,arev(arev(a,b),b))) stopifnot(identical(a[,2:1,,,],arev(a,2))) stopifnot(identical(arev(a,c(2:4)),a[,2:1,2:1,2:1,])) # now some tests of arot(): stopifnot(identical(arot(arot(a)),arot(a,2))) stopifnot(identical(arot(arot(arot(a))),arot(a,3))) b <- c(2,4) stopifnot(identical(arot(arot(arot(a,p=b),p=b),p=b),arot(a,p=b,3))) stopifnot(identical(arot(a,2),arev(a,1:2))) #now some tests of shift: stopifnot(identical(c(as.integer(10),1:9),shift(1:10))) stopifnot(identical(shift(1:10,-2),c(3:10,1:2))) stopifnot(identical(magic(4),ashift(ashift(ashift(ashift(magic(4))))))) stopifnot(identical(ashift(ashift(ashift(magiccube.2np1(1)))),magiccube.2np1(1))) a <- array(1:24,2:4) stopifnot(identical(a,ashift(a,dim(a)))) stopifnot(is.magichypercube(ashift(magichypercube.4n(1)))) stopifnot(is.semimagichypercube(ashift(magichypercube.4n(1),1:3))) stopifnot(is.semimagichypercube(ashift(magichypercube.4n(1,d=5),c(1,2,3,2,1)))) # now test bug reported by Andre Mikulec via gmail: a1 <- array( 2^(0:5) , 1:3) dimnames(a1) <- list(ALPHA = "A", BETA = c("a","b"), GAMMA = c("i","ii","iii")) stopifnot(identical(dim(a1),dim(ashift(a1,c(0,1,0))))) zero.extent <- array(0,c(3,0,3,2,3)) stopifnot(is.standard(zero.extent)) # Now test subsums. With wrap=TRUE, a matrix with identical # entries should have identical subsums: a <- array(1,c(2,2,2,2,3,2,2)) stopifnot(minmax(subsums(a,2))) # Now sundry tests of apltake(), apldrop(), apad(), arev() etc: f1 <- function(a){ zero <- as.integer(0) identical(ashift(a,dim(a)),a) & identical(apltake(a,dim(a)),a) & identical(apltake(a,-dim(a)),a) & identical(apldrop(a,dim(a)*0),a) & identical(apldrop(adiag(a,zero),-1+dim(a)*0),a) & identical(apldrop(adiag(a,a),dim(a)),a) & identical(apltake(adiag(a,a),dim(a)),a) & identical(apltake(adiag(a,a),-dim(a)),a) & identical(apldrop(apad(a,dim(a)),-dim(a)),a) & identical(apldrop(apad(a,dim(a),method="mirror"),dim(a)),arev(a)) & identical(apldrop(apad(a,dim(a)),dim(a)),array(do.call("[",c(list(a),as.list(dim(a)))),dim(a))) & identical(a,apldrop(ashift(adiag(a,a),dim(a)),dim(a))) } stopifnot( f1(magichypercube.4n(m=1,d=4)) & f1(array(1:24,2:4)) & f1(array(1:64,rep(2,7))) & f1(matrix(1:30,5,6)) ) # Some tests of do.index(): f1 <- function(x){as.integer(sum(x))} f2 <- function(a){ stopifnot(identical(do.index(a,f1),arow(a,1)+arow(a,2)+arow(a,3)+arow(a,4))) } f2(array(0L,c(2,3,4,5))) f2(array(0L,c(3,5,4,2))) # Some tests of the incidence functionality: n <- 7 f <- function(a){ is.latin(a) & is.latin(unincidence(aperm(incidence(a),c(3,1,2)))) & is.latin(unincidence(aperm(incidence(a),c(3,2,1)))) & is.latin(unincidence(aperm(incidence(a),c(1,3,2)))) } stopifnot(sapply(sapply(2:n , latin) , f)) #Some tests of the antimagic functions: f <- function(x){is.sam(sam(x[1],x[2]))} jj <- as.matrix(which(lower.tri(matrix(0,n,n)),arr.ind=TRUE)) stopifnot(all(apply(jj,1,f))) #Some tests of fnsd(): a <- array(1:24,c(1,1,1,1,2,1,3,1,1,4)) stopifnot(length(fnsd(a,0))==0) stopifnot(fnsd(a)==5) stopifnot(all(fnsd(a,2) == c(5,7))) #Some tests of recurse(): f <- function(p,i){ stopifnot(all(recurse(start=recurse(p,i),p,-i) == seq_along(p))) } f(magic(10),0) f(magic(11),1) f(magic(12),2) f(magic(13),3) f(magic(14),4) #Some multiplicative magic square tests; see Javier Cilleruelo and #Florian Luca 2010, "On multiplicative magic squares", The Electronic #Journal of Combinatorics", vol 17. #N8 f <- function(n,m){ matrix(c( (n+2)*(m+0), (n+3)*(m+3), (n+1)*(m+2), (n+0)*(m+1), (n+1)*(m+1), (n+0)*(m+2), (n+2)*(m+3), (n+3)*(m+0), (n+0)*(m+3), (n+1)*(m+0), (n+3)*(m+1), (n+2)*(m+2), (n+3)*(m+2), (n+2)*(m+1), (n+0)*(m+0), (n+1)*(m+3) ),nrow=4,ncol=4,byrow=TRUE) } stopifnot(all(apply(as.matrix(expand.grid(seq_len(n),seq_len(n))),1,function(x){is.magic(f(x[1],x[2]),func=prod)}))) stopifnot(all(sapply(panmagic.6np1(seq_len(n)),is.panmagic))) stopifnot(all(sapply(panmagic.6np1(seq_len(n)),is.panmagic))) magic/vignettes/0000755000176200001440000000000014334512426013346 5ustar liggesusersmagic/vignettes/magic.bib0000644000176200001440000000201714316716266015114 0ustar liggesusers@Manual{R, title = {\proglang{R}: A language and environment for statistical computing}, author = {\proglang{R} {D}evelopment {C}ore {T}eam}, organization = {\proglang{R} {F}oundation for {S}tatistical {C}omputing}, address = {Vienna, Austria}, year = {2004}, note = {ISBN 3-900051-07-0}, url = {https://www.R-project.org}, } @Book{benson1976, author = {William H. Benson and Oswald Jacoby}, title = {New recreations with magic squares}, publisher = {Dover}, year = {1976} } @Article{hendricks1973, author = {J. R. Hendricks}, title = {Magic tesseracts and {N}-dimensional magic hypercubes}, journal = {Journal of Recreational Mathematics}, year = {1973}, volume = {6}, number = {3}, pages = {193--201}} @Article{hankin2005, author = {Robin K. S. Hankin}, title = {Recreational mathematics with \proglang{R}: introducing the \pkg{magic} package}, journal = {\proglang{R} News}, year = 2005, volume = 5, number = 1, pages = {48--51}, month ={May} } magic/vignettes/magic.Rnw0000644000176200001440000003476714316715255015144 0ustar liggesusers\documentclass[nojss]{jss} \usepackage{amssymb} \usepackage{wrapfig} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% just as usual \author{Robin K. S. Hankin} \title{Recreational mathematics with \proglang{R}: introducing the \pkg{magic} package} %\VignetteIndexEntry{A vignette for the magic package} %% for pretty printing and a nice hypersummary also set: %% \Plainauthor{Achim Zeileis, Second Author} %% comma-separated \Plaintitle{Recreational mathematics with R: introducing the magic package} \Shorttitle{Magic squares in R} %% an abstract and keywords \Abstract{ The \proglang{R} computer language~\citep{R} has been applied with a great deal of success to a wide variety of statistical, physical, and medical applications. Here, I show that \proglang{R} is an equally superb research tool in the field of recreational mathematics. An earlier version of this vignette was published as~\citet{hankin2005}. } \Keywords{Magic squares} % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- \Address{ Robin K. S. Hankin\\ AUT University\\ Auckland\\ New Zealand\\ E-mail: \email{hankin.robin@gmail.com} } %% need no \usepackage{Sweave.sty} \begin{document} \section{Overview} \setlength{\intextsep}{0pt} \begin{wrapfigure}{r}{0.2\textwidth} \begin{center} \includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}} \end{center} \end{wrapfigure} Recreational mathematics is easier to recognize than define, but seems to be characterized by requiring a bare minimum of ``raw material'': complex notation is not needed, and problems are readily communicated to the general public. This is not to say that all problems of recreational mathematics are trivial: one could argue that much number theory is recreational in nature; yet attempts to prove Fermat's Last Theorem, or the search for ever higher perfect numbers, have been the catalyst for the development of many fruitful new areas of mathematics. The study of magic squares is also an example of nontrivial recreational mathematics as the basic concept is simple to grasp---yet there remain unsolved problems in the field whose study has revealed deep mathematical truths. Here, I introduce the \pkg{magic} package, and show that \proglang{R} is an excellent environment for the creation and investigation of magic squares. I also show that one's appreciation of magic squares may be enhanced through computer tools such as \proglang{R}, and that the act of translating `paper' algorithms of the literature into \proglang{R} idiom can lead to new insight. \section{Introduction} Magic squares have essentially zero practical use; their fascination---like much of pure mathematics---lies in the appeal of \ae sthetics and structure rather than immediate usefulness. The following definitions are almost universal: \begin{itemize} \item A {\em semimagic square} is one all of whose row sums equal all its columnwise sums (i.e. the magic constant). \item A {\em magic square} is a semimagic square with the sum of both unbroken diagonals equal to the magic constant. \item A {\em panmagic square} is a magic square all of whose broken diagonals sum to the magic constant. \end{itemize} (all squares are understood to be $n\times n$ and to be {\em normal\/}, that is, to comprise $n^2$ consecutive integers\footnote{Most workers require the entries to start at 1, which is the convention here; but there are several instances where starting at~0 is far more convenient. In any case, if \code{x} is magic, then \code{x+n} is magic for any integer \code{n}.}). Functions \code{is.semimagic()}, \code{is.magic()}, and \code{is.panmagic()} test for these properties. <>= <>= require(magic) @ A good place to start is the simplest---and by far the most commonly encountered---magic square, {\em lo zhu}: <>= magic(3) @ This magic square has been known since antiquity (legend has it that the square was revealed to humanity inscribed upon the shell of a divine turtle). More generally, if consecutive numbers of a magic square are joined by lines, a pleasing image is often obtained (figure~\ref{magic7}, for example, shows a magic square of order~7; when viewed in this way, the algorithm for creating such a square should be immediately obvious). \begin{figure}[htbp] \begin{center} <>= magicplot(magic.2np1(3)) @ \caption{Magic square of order~7\label{magic7} in graphical form (obtained by \texttt{magicplot(magic.2np1(3))}) } \end{center} \end{figure} Function \code{magic()} takes an integer argument~$n$ and returns a normal magic square of size $n\times n$. There are eight equivalent forms for {\em lo zhu\/} or indeed any magic square, achieved by rotating and reflecting the matrix~\citep{benson1976}; such equivalence is tested by \code{eq()} or \code{\%eq\%}. Of these eight forms, a magic square \code{a} is said to be in {\em Fr\'{e}nicle's standard form} if \code{a[1,1]}$\leq$\code{b[1,1]} whenever \code{a \%eq\% b}, and \code{a[1,2]a[2,1]}, take the transpose''. I shall show later that expressing such an algorithm in \proglang{R} leads to new insight when considering magic hypercubes. A wide variety of algorithms exists for calculating magic squares. For a given order $n$, these algorithms generally depend on $n$ modulo~4. A typical paper algorithm for magic squares of order~$n=4m$ would go as follows. \begin{quote} Algorithm 1: in a square of order~$4m$, shade the long major diagonal. Then shade all major diagonals distant by a multiple of~4 cells from the long diagonal. Do the same with the minor diagonals. Then, starting with ``1'' at the top left corner and proceeding from left to right and top to bottom, count from~1 to $n^2$, filling in the shaded squares with the appropriate number and omitting the unshaded ones [figure~\ref{magicsquare8.halfdone}]. Fill in the remaining (unshaded) squares in the same way, starting at the lower right corner, moving leftwards and upwards [figure~\ref{magicsquare8}]. \end{quote} Such paper algorithms are common in the literature but translating this one into code that uses \proglang{R}'s vectorized tools effectively can lead to new insight. The magicness of such squares may be proved by considering the increasing and decreasing sequences separately. \begin{figure}[htb] \begin{center} <>= shadedsquare <- function(m=2){ n <- 4*m jj.1 <- kronecker(diag(2), matrix(1, 2, 2)) jj <- kronecker(matrix(1, m + 1, m + 1), jj.1)[2:(n + 1), 2:(n + 1)] par(xaxt="n",yaxt="n") image(1:n,1:n,jj,xlab="",ylab="",asp=1,frame=FALSE,col=c(gray(0.9),gray(0.4))) abline(v=0.5+(0:n)) segments(x0=rep(0.5,n),y0=0.5+(0:n),x1=rep(n+0.5,n),y1=0.5+(0:n)) return(invisible(jj)) } jj <- shadedsquare() #a <- magic(8) #text(row(a),col(a),as.character(a),col="white") for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } } } @ \caption{Half-completed magic square of order\label{magicsquare8.halfdone} 8} \end{center} \end{figure} \begin{figure}[htb] \begin{center} <>= shadedsquare() for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } else { text(i,j,magic(8)[i,9-j],col="black") } } } @ \caption{Magic square of order\label{magicsquare8} 8} \end{center} \end{figure} The interesting part of the above paper algorithm lies in determining the pattern of shaded and unshaded squares\footnote{If \code{a <- matrix(1:(n*n),n,n)}, with \code{jj} a Boolean vector of length~$n^2$ with \code{TRUE} corresponding to shaded squares, then with it is clear that \code{a[jj] <- rev(a[jj])} will return the above magic square.}. As the reader may care to verify, parsing the algorithm into \proglang{R} idiom is not straightforward. An alternative, readily computed in \proglang{R}, would be to recognize that the repeating $4\times 4$ cell \code{a[2:5,2:5]} is \code{kronecker(diag(2),matrix(1,2,2)) -> b} say, replicate it with \code{kronecker(matrix(1,3,3),b) -> g}; then trim off the border by selecting only the middle elements, in this case \code{g[2:9,2:9]}. Function \code{magic.4n()} implements the algorithm for general $m$. \section{Magic hypercubes} One of the great strengths of \proglang{R} is its ability to handle arbitrary dimensioned arrays in an efficient and elegant manner. Generalizing magic squares to magic hypercubes~\citep{hendricks1973} is thus natural when working in \proglang{R}. The following definitions represent a general consensus, but are far from universal: \begin{itemize} \item A {\em semimagic hypercube} has all ``rook's move'' sums equal to the magic constant (that is, each~$\sum_{i_r=1}^n a[i_1,i_2,\ldots,i_{r-1},i_r,i_{r+1},\ldots,i_d]$ with $1\leqslant r\leqslant d$ is equal to the magic constant for all values of the other i's). \item A {\em magic hypercube} is a semimagic hypercube with the additional requirement that all $2^{d-1}$ long (ie extreme point-to-extreme point) diagonals sum correctly. \item A {\em perfect magic hypercube} is a magic hypercube with all nonbroken diagonals summing correctly\footnote{This condition is quite restrictive; in the case of a tesseract, this would include subsets such as $\sum_{i=1}^na[1,i,n-i+1,n]$ summing correctly.}. \item A {\em pandiagonal hypercube} is a perfect magic hypercube with all broken diagonals summing correctly. \end{itemize} (a magic hypercube is understood to be of dimension \code{rep(n,d)} and normal). Functions \code{is.semimagichypercube()}, \code{is.magichypercube()} and \code{is.perfect(a)} test for the first three properties; the fourth is not yet implemented. Function \code{is.diagonally.correct()} tests for correct summation of the $2^d$ (sic) long diagonals. \subsection[Magic hypercubes of order 4n]{Magic hypercubes of order~{\boldmath $4n$}} Consider algorithm 1 generalized to a $d$-dimensional hypercube. The appropriate generalization of the repeating cell of the $8\times 8$ magic square discussed above is not immediately obvious when considering figure~\ref{magicsquare8.halfdone}, but the \proglang{R} formalism (viz \code{kronecker(diag(2),matrix(1,2,2))}) makes it clear that the appropriate generalization is to replace \code{matrix(1,2,2)} with \code{array(1,rep(2,d))}. The appropriate generalization for \code{diag(2)} (call it \code{g}) is not so straightforward, but one might be guided by the following requirements: \begin{itemize} \item The dimension of \code{g} must match the first argument to \code{kronecker()}, viz \code{rep(2,d)} \item The number of 0s must be equal to the number of 1s: \code{sum(g==1)==sum(g==0)} \item The observation that \code{diag(2)} is equal to its transpose would generalize to requiring that \code{aperm(g,K)} be identical to \code{g} for any permutation \code{K}. \end{itemize} These lead to specifying that \code{g[i1,...,id]} should be zero if $(i_1,\ldots,i_d)$ contains an odd number of 2s and one otherwise. One appropriate \proglang{R} idiom would be to define a function \code{dimension(a,p)} to be an integer matrix with the same dimensions as \code{a}, with element $(n_1,n_2, ..., n_d)$ being $n_p$, then if $\mbox{\code{jj}}=\sum_{i=1}^d\mbox{\code{dimension(a,i)}}$, we can specify \code{g=jj*0} and then \code{g[jj\%\%2==1] <- 1}. Another application of \code{kronecker()} gives a hypercube that is of extent $4m+2$ in each of its \code{d} dimensions, and this may be trimmed off as above to give an array of dimensions \code{rep(4m,d)} using \code{do.call()} and \code{[<-}. The numbers may be filled in exactly as for the 2d case. The resulting hypercube is magic, in the sense defined above\footnote{If I had a rigorous proof of this, the margin might be too narrow for it.}, although it is not perfect; function \code{magichypercube.4n()} implements the algorithm. The ability to generate magic hypercubes of arbitrary dimension greater than one is apparently novel. \subsubsection{Standard form for hypercubes} Consider again the paper definition for Fr\'{e}nicle's standard form of a magic square \code{a}: it is rotated so that the smallest number appears at the top left; then if \code{a[1,2] 2) { jj <- do.call("Recall", c(args[-1], list(pad = pad))) return(do.call("Recall", c(list(args[[1]]), list(jj), list(pad = pad)))) } a <- args[[1]] b <- args[[2]] if (is.null(b)) { return(a) } if (is.null(dim(a)) & is.null(dim(b))) { dim(a) <- rep(1, 2) dim(b) <- rep(1, 2) } if (is.null(dim(a)) & length(a) == 1) { dim(a) <- rep(1, length(dim(b))) } if (is.null(dim(b)) & length(b) == 1) { dim(b) <- rep(1, length(dim(a))) } if (length(dim.a <- dim(a)) != length(dim.b <- dim(b))) { stop("a and b must have identical number of dimensions") } s <- array(pad, dim.a + dim.b) s <- do.call("[<-", c(list(s), lapply(dim.a, seq_len), list(a))) ind <- lapply(seq(dim.b), function(i) seq_len(dim.b[[i]]) + dim.a[[i]]) out <- do.call("[<-", c(list(s), ind, list(b))) n.a <- dimnames(a) n.b <- dimnames(b) if (do.dimnames & !is.null(n.a) & !is.null(n.b)) { dimnames(out) <- mapply(c, n.a, n.b, SIMPLIFY = FALSE) names(dimnames(out)) <- names(n.a) } return(out) } "allsubhypercubes" <- function (a) { if (!minmax(dim(a))) { stop("only cubes of equal dimensions allowed") } n <- dim(a)[1] d <- length(dim(a)) tri <- c("", "i", "n-i+1") q <- expand.grid(sapply(1:d, function(x) { tri }, simplify = FALSE)) jj <- apply(apply(q, 2, paste), 1, paste, collapse = ",") wanted <- grep("i.*i", jj) jj <- jj[wanted] number.of.subhypercubes <- length(jj) f <- function(i, a, string) { n <- dim(a)[1] execute.string <- paste("jj <- a[", string, "]", collapse = "") eval(parse(text = execute.string)) d <- round(log(length(jj))/log(n)) if(d > 0.5){ return(array(jj, rep(n, d))) } else { return(jj) } } dummy <- function(p) { x <- sapply(1:n, f, a = a, string = jj[p], simplify = FALSE) along.dim <- 1 + sum(dim(x[[1]]) > 1) return(do.call("abind", c(x, along = along.dim))) } out <- lapply(1:number.of.subhypercubes, dummy) names(out) <- jj return(out) } "allsums" <- function (m, func = NULL, ...) { n <- nrow(m) if(is.null(func)){ rowsums <- rowSums(m) colsums <- colSums(m) func <- sum } else { rowsums <- apply(m, 1, FUN=func, ...) colsums <- apply(m, 2, FUN=func, ...) } f1 <- function(i) { func(diag.off(m, i, nw.se = TRUE), ...) } f2 <- function(i) { func(diag.off(m, i, nw.se = FALSE), ...) } majors <- sapply(0:(n - 1), FUN=f1) minors <- sapply(0:(n - 1), FUN=f2) return(list(rowsums = rowsums, colsums = colsums, majors = majors, minors = minors)) } "aplus" <- function(...){ args <- list(...) if (length(args) == 1) { return(args[[1]]) } if (length(args) > 2) { jj <- do.call("Recall", c(args[-1])) return(do.call("Recall", c(list(args[[1]]), list(jj)))) } a <- args[[1]] b <- args[[2]] dima <- dim(a) dimb <- dim(b) stopifnot(length(dima)==length(dimb)) out <- array(0,pmax(dima,dimb)) return( do.call("[<-",c(list(out),lapply(dima,seq_len),list(a)))+ do.call("[<-",c(list(out),lapply(dimb,seq_len),list(b))) ) } "arev" <- function(a, swap=TRUE) { if(is.vector(a)){return(rev(a))} d <- dim(a) n <- length(d) N <- seq_len(n) if(is.logical(swap)){ if(length(swap)==1){swap <- rep(swap,n)} } else { swap <- N %in% swap } f <- function(i){ if(d[i]>0){ return(swap[i]*rev(seq_len(d[i])) + (!swap[i])*seq_len(d[i])) } else { return(0) } } do.call("[", c(list(a), sapply(N, f, simplify=FALSE),drop=FALSE)) } "arot" <- function (a, rights=1, pair=1:2) { d <- dim(a) n <- length(d) jj <- 1:n jj[pair] <- shift(jj[pair],1) rights <- rights%%4 if(rights==0){ return(a) } else if (rights==1){ return(aperm(arev(a,pair[2]),jj)) } else if (rights==2){ return(arev(a,pair)) } else if (rights==3){ return(aperm(arev(a,pair[1]),jj)) } else { stop("rights must be one of 0,1,2,3") } } "ashift" <- function (a, v=rep(1,length(dim(a)))) { if (is.vector(a)) { return(shift(a, v)) } v <- c(v,rep(0,length(dim(a))-length(v))) f <- function(i) { shift(seq_len(dim(a)[i]), v[i]) } do.call("[", c(list(a), sapply(seq_along(dim(a)), f, simplify = FALSE),drop=FALSE)) # bug and patch from Andre Mikulec } "as.standard" <- function (a, toroidal=FALSE, one_minus=FALSE) { if(one_minus){ a1 <- as.standard(a, toroidal=toroidal,one_minus=FALSE) a2 <- as.standard(1L+max(a)-a,toroidal=toroidal,one_minus=FALSE) if(a1 %lt% a2){ return(a1) } else { return(a2) } } a <- drop(a) d.a <- dim(a) if(any(d.a) < 1){ return(a) } if(!toroidal & (max(d.a) <= 1 )){ return(a) } d <- length(d.a) if(toroidal){ jj <- which(a==min(a),arr.ind=TRUE) if(nrow(jj)==1){ a <- ashift(a,1-jj) # move the "1" to top-left. } else { stop("minimum not unique") } # now pivot so a[2,1,1] < a[d[1],1,1] etc: f <- function(a){cbind(c(1,a-1))} ind <- matrix(a[1+do.call("adiag",sapply(d.a, f, simplify=FALSE))],nrow=2) jj <- ind[1,] > ind[2,] a <- ashift(arev(a,jj),jj+0) } else { # not toroidal corners <- as.matrix(do.call("expand.grid", lapply(1:d, function(i) c(1, d.a[i])))) pos.of.min <- corners[which.min(a[corners]), ] d.a[pos.of.min > 1] <- -1 a <- arev(a, d.a<0) } # now aperm so adjacent elements are in the correct order: return(aperm(a, order(-a[1 + diag(nrow = d)]))) } "circulant" <- function (vec,doseq=TRUE) { if((length(vec)==1) & (doseq)){ vec <- seq(length=vec) } n <- length(vec) a <- matrix(0,n,n) out <- process(1-row(a)+col(a),n) out[] <- vec[out] return(out) } latin <- circulant "diag.off" <- function (a, offset = 0, nw.se = TRUE) { n <- dim(a)[1] if (nw.se == TRUE) { indices <- cbind(1:n, 1:n) } else { indices <- cbind(1:n, n:1) } jj <- process(sweep(indices, 2, c(0, offset), "+"), n) return(a[jj]) } "arow" <- function (a, i) { p <- 1:prod(dim(a)) n <- length(dim(a)) d <- dim(a)[i] permute <- c(i, (1:n)[-i]) a <- aperm(a, permute) a[] <- p permute[permute] <- 1:n return(force.integer(aperm(process(a, d), permute))) } "force.integer" <- function (x) { out <- as.integer(x) attributes(out) <- attributes(x) return(out) } "hudson" <- function (n = NULL, a = NULL, b = NULL) { if (is.null(n)) { n <- length(a) } if (is.null(a)) { a <- c(n - 1, 0:(n - 2)) } if (is.null(b)) { b <- c(2:(n - 1), n, 1) } perm <- c(n - 1, n, 1:(n - 2)) f <- function(i) { recurse(perm=perm, i=i, start = a) } g <- function(i) { recurse(perm = perm, i=i, start = b) } jj <- 0:(n - 1) aa <- t(sapply(jj, f)) bb <- t(sapply(-jj, g)) return(n * aa + bb) } "is.2x2.correct" <- function (m, give.answers = FALSE) { window <- c(2, 2) sums <- subsums(m, window) answer <- minmax(sums) if (give.answers == FALSE) { return(answer) } else { return(list(answer = answer, tbt.sums = sums)) } } "is.associative" <- function (m) { if(is.list(m)){ return(sapply(m,match.fun(sys.call()[[1]]))) } is.magic(m) & minmax(c(m + arev(m))) } "is.square.palindromic" <- function (m, base=10, give.answers=FALSE) { n <- nrow(m) S <- function(i){ashift(diag(n),c(i,0))} f.maj <- function(i){ is.persymmetric(m %*% S(i) %*% t(m)) } f.min <- function(i){ is.persymmetric(t(m) %*% S(i) %*% m) } row.sufficient <- is.persymmetric(t(m) %*% m) col.sufficient <- is.persymmetric(m %*% t(m)) major.diag.sufficient <- all(sapply(1:nrow(m),f.maj)) minor.diag.sufficient <- all(sapply(1:nrow(m),f.min)) sufficient <- row.sufficient & col.sufficient & major.diag.sufficient & minor.diag.sufficient b <- base^(0:(n-1)) R <- diag(n)[n:1,] is.necessary <- function(mat,tol=1e-8){ as.vector(abs( (crossprod(b, R %*% mat %*% R) %*% b)/ (crossprod(b, mat) %*% b)-1) 0) * (1:n) + (dir < 0) * (n:1) } g <- function(jj) { func(a[sapply(jj, f)], ...) } ans <- expand.grid(rep(list(b),d)) diag.sums <- apply(ans, 1, g) dim(diag.sums) <- c(length(diag.sums)/(2^d), rep(2, d)) if (boolean) { answer <- all(diag.sums) } else { answer <- minmax(diag.sums) } if (give.answers) { return(list(answer = answer, diag.sums = drop(diag.sums))) } else { return(answer) } } "is.latin" <- function (m, give.answers = FALSE) { is.latinhypercube(a = m, give.answers = give.answers) } "is.latinhypercube" <- function (a, give.answers = FALSE) { f <- function(x) { minmax(c(1, diff(sort(x)))) } is.consecutive <- is.semimagichypercube(a, func = f, give.answers = TRUE)$rook.sums answer <- all(is.consecutive) if (give.answers) { return(list(answer = answer, is.consecutive)) } else { return(answer) } } "is.magic" <- function (m, give.answers = FALSE, func = sum, boolean = FALSE) { if(is.list(m)){ out <- lapply(m,match.fun(sys.call()[[1]]), give.answers = give.answers, func = func, boolean = boolean ) if(give.answers){ return(out) } else { return(unlist(out)) } } sums <- allsums(m, func = func) jj <- c(sums$rowsums, sums$colsums, sums$majors[1], sums$minors[1]) if (boolean) { answer <- all(jj) } else { answer <- minmax(jj) } if (give.answers) { return(c(answer = answer, sums)) } else { return(answer) } } "is.magichypercube" <- function (a, give.answers = FALSE, func = sum, boolean = FALSE, ...) { diag.sums <- is.diagonally.correct(a, give.answers = TRUE, func = func, boolean = boolean, ...)$diag.sums jj.semi <- is.semimagichypercube(a, give.answers = TRUE, func = func, boolean = boolean, ...) answer <- minmax(diag.sums) & jj.semi$answer if (give.answers) { return(list(answer = answer, rook.sums = jj.semi$rook.sums, diag.sums = diag.sums)) } else { return(answer) } } "is.mostperfect" <- function (m, give.answers = FALSE) { if (give.answers) { ibc <- is.bree.correct(m, give.answers = TRUE) i2c <- is.2x2.correct(m, give.answers = TRUE) ipd <- is.panmagic(m, give.answers = TRUE) return(list(answer = ibc$answer & i2c$answer, rowsums = ipd$rowsums, colsums = ipd$colsums, majors = ipd$majors, minors = ipd$minors, diag.sums = ibc$diag.sums, tbt.sums = i2c$tbt.sums)) } else { return(is.bree.correct(m) & is.2x2.correct(m)) } } "is.normal" <- function (m) { if(is.list(m)){ return(sapply(m,match.fun(sys.call()[[1]]))) } minmax(c(1, diff(sort(m)))) } "is.ok" <- function (vec, n = length(vec), d = 2) { return(sum(vec) == magic.constant(n, d = d)) } "is.panmagic" <- function (m, give.answers = FALSE, func = sum, boolean = FALSE) { sums <- allsums(m, func = func) jj <- c(sums$rowsums, sums$colsums, sums$majors, sums$minors) if (boolean) { answer <- all(jj) } else { answer <- minmax(jj) } if (give.answers) { return(c(answer = answer, sums)) } else { return(answer) } } "is.pandiagonal" <- is.panmagic "is.perfect" <- function (a, give.answers = FALSE, func = sum, boolean = FALSE) { d <- length(dim(a)) putative.magic.constant <- func(do.call("[", c(list(a), alist(a = )$a, rep(1, d - 1)))) jj.is.ok <- function(jj, jj.give) { if (length(dim(jj)) == 1) { if (boolean) { return(func(jj)) } else { if (jj.give) { return(func(jj)) } else { return(func(jj) == putative.magic.constant) } } } else { return(is.semimagichypercube(jj, func = func, boolean = boolean, give.answers = jj.give)) } } semi.stuff <- is.semimagichypercube(a, give.answers = TRUE, func = func, boolean = boolean) diag.stuff <- unlist(lapply(allsubhypercubes(a), jj.is.ok, jj.give = FALSE)) answer <- semi.stuff$answer & all(diag.stuff) if (give.answers) { diag.sums <- lapply(allsubhypercubes(a), jj.is.ok, jj.give = TRUE) return(list(answer = answer, rook.sums = semi.stuff$rook.sums, diag.sums = unlist(diag.sums, recursive = FALSE))) } else { return(answer) } } "is.persymmetric" <- function (m) { jj <- m[,nrow(m):1] all(jj==t(jj)) } "is.semimagic" <- function (m, give.answers = FALSE, func = sum, boolean = FALSE) { sums <- allsums(m, func = func) jj <- c(sums$rowsums, sums$colsums) if (boolean) { answer <- all(jj) } else { answer <- minmax(jj) } if (give.answers) { return(c(answer = answer, sums)) } else { return(answer) } } "is.semimagic.default" <- function(m) { minmax(c(rowSums(m),colSums(m))) } "is.semimagichypercube" <- function (a, give.answers = FALSE, func = sum, boolean = FALSE, ...) { d <- length(dim(a)) f <- function(i) { apply(a, (1:d)[-i], FUN=func, ...) } jj <- sapply(1:d, f) if (minmax(dim(a))) { dim(jj) <- c(dim(a)[-1], d) if (boolean) { answer <- all(jj) } else { answer <- minmax(jj) } } else { if (boolean) { answer <- all(unlist(jj)) } else { answer <- minmax(unlist(jj)) } } if (give.answers) { return(list(answer = answer, rook.sums = jj)) } else { return(answer) } } "is.standard" <- function (a,toroidal=FALSE,one_minus=FALSE) { if(is.list(a)){ return(sapply(a,match.fun(sys.call()[[1]]))) } if(one_minus){ ans1 <- is.standard(a,toroidal=toroidal) ans2 <- a %le% as.standard(max(a)+1L-a,toroidal=toroidal) return(ans1 & ans2) } if(toroidal){return(is.standard.toroidal(a))} a <- drop(a) d.a <- dim(a) if(any(d.a==0)){return(TRUE)} d <- length(d.a) corners <- as.matrix(do.call("expand.grid", lapply(1:d, function(i) c(1, d.a[i])))) corners.correct <- a[1] <= min(a[corners]) jj <- 1 + diag(nrow = d) adjacent.correct <- all(diff(a[jj])<0) return(corners.correct & adjacent.correct) } "is.standard.toroidal" <- function(a){ if(is.list(a)){ return(sapply(a,match.fun(sys.call()[[1]]))) } first.element.correct <- identical(which(a==min(a)) , 1L) jj <- 1 + diag(nrow = length(dim(a))) adjacent.correct <- all(diff(a[jj])<0) f <- function(a){cbind(c(1,a-1))} ind <- matrix(a[1+do.call("adiag",sapply(dim(a), f, simplify=FALSE))],nrow=2) octahedron.correct <- all(ind[1,] < ind[2,]) return(first.element.correct & adjacent.correct & octahedron.correct) } "lozenge" <- function (m) { if(length(m)>1){ return(sapply(m,match.fun(sys.call()[[1]]))) } n <- 2 * m + 1 out <- matrix(NA, n, n) jj <- cbind(m:-m, 0:(2 * m)) + 1 odd.a <- jj[1:(1 + m), ] odd.b <- odd.a odd.b[, 2] <- odd.b[, 2] + 1 odd.b <- odd.b[-(m + 1), ] odd.coords <- rbind(odd.a, odd.b) even.a <- jj[(m + 2):(2 * m + 1), ] even.b <- jj[(m + 1):(2 * m + 1), ] even.b[, 2] <- even.b[, 2] + 1 even.coords <- rbind(even.a, even.b) f <- function(a, x) { x + a } all.odd.coords <- do.call("rbind", sapply(0:m, f, x = odd.coords, simplify = FALSE)) all.even.coords <- do.call("rbind", sapply(0:m, f, x = even.coords, simplify = FALSE)) all.even.coords <- process(all.even.coords, n) diam.odd <- 1:(1 + 2 * m * (1 + m)) out[all.odd.coords[diam.odd, ]] <- 2 * diam.odd - 1 diam.even <- 1:(2 * m * (1 + m)) out[all.even.coords[diam.even, ]] <- 2 * diam.even return(force.integer(out)) } "magic" <- function (n) { if(length(n)>1){ return(sapply(n,match.fun(sys.call()[[1]]))) } n <- round(n) if (n == 2) { stop("Normal magic squares of order 2 do not exist") } if (n%%2 == 1) { return(as.standard(magic.2np1(floor(n/2)))) } if (n%%4 == 0) { return(as.standard(magic.4n(round(n/4)))) } if (n%%4 == 2) { return(as.standard(magic.4np2(round((n - 2)/4)))) } stop("This cannot happen") } "magic.2np1" <- function (m, ord.vec = c(-1, 1), break.vec = c(1, 0), start.point = NULL) { if(length(m)>1){ return(sapply(m,match.fun(sys.call()[[1]]), ord.vec = ord.vec, break.vec = break.vec, start.point = start.point )) } n <- 2 * m + 1 if (is.null(start.point)) { start.row <- 0 start.col <- n + 1 } else { start.row <- start.point[1] - 1 start.col <- m + start.point[2] + 1 } f <- function(n) { ord.row <- seq(from = start.row, by = ord.vec[1], length = n) ord.col <- seq(from = start.col, by = ord.vec[2], length = n) out <- cbind(rep(ord.row, n) - (n - 1), rep(ord.col, n) + m) break.row <- ord.vec[1] - break.vec[1] break.col <- ord.vec[2] - break.vec[2] adjust <- cbind(rep(seq(from = 0, by = break.row, len = n), each = n), rep(seq(from = 0, by = break.col, len = n), each = n)) return(process(out - adjust, n)) } a <- matrix(NA, n, n) a[f(n)] <- 1:(n * n) return(a) } "magic.4n" <- function (m) { if(length(m)>1){ return(sapply(m,match.fun(sys.call()[[1]]))) } n <- 4 * m a <- matrix(1:(n^2), n, n) jj.1 <- kronecker(diag(2), matrix(1, 2, 2)) jj <- as.logical(kronecker(matrix(1, m + 1, m + 1), jj.1)[2:(n + 1), 2:(n + 1)]) a[jj] <- rev(a[jj]) return(force.integer(a)) } "magic.4np2" <- function (m) { if(length(m)>1){ return(sapply(m,match.fun(sys.call()[[1]]))) } n <- 4 * m + 2 f <- function(n) { if (n == 1) { return(matrix(c(4, 2, 1, 3), 2, 2)) } if (n == 2) { return(matrix(c(1, 2, 4, 3), 2, 2)) } if (n == 3) { return(matrix(c(1, 3, 4, 2), 2, 2)) } return(NULL) } lux.n <- function(m) { lux <- matrix(1, 2 * m + 1, 2 * m + 1) lux[(m + 2), ] <- 2 if (m > 1) { lux[(m + 3):(2 * m + 1), ] <- 3 } lux[m + 1, m + 1] <- 2 lux[m + 2, m + 1] <- 1 return(lux) } i <- function(a, r) { jj <- which(a == r, arr.ind = TRUE) indices <- (cbind(jj[, 1] + (jj[, 3] - 1) * 2, jj[, 2] + (jj[, 4] - 1) * 2)) o <- order(indices[, 1] * nrow(jj) + indices[, 2]) return(indices[o, ]) } a <- apply(lux.n(m), 1:2, FUN = f) dim(a) <- c(2, 2, 2 * m + 1, 2 * m + 1) out <- matrix(NA, n, n) sequ <- as.vector(t(magic.2np1(m))) * 4 - 4 out[i(a, 1)] <- sequ + 1 out[i(a, 2)] <- sequ + 2 out[i(a, 3)] <- sequ + 3 out[i(a, 4)] <- sequ + 4 return(force.integer(out)) } "magic.8" <- function (...) { j <- array(t(expand.grid(rep(list(0:1),16))),c(4, 4, 65536)) all.rowsums.eq.2 <- apply(apply(j, c(1, 3), sum) == 2, 2, all) all.colsums.eq.2 <- apply(apply(j, c(2, 3), sum) == 2, 2, all) both.sums.eq.2 <- all.rowsums.eq.2 & all.colsums.eq.2 j <- j[c(1:4, 4:1), c(1:4, 4:1), both.sums.eq.2] > 0 n <- dim(j)[3] magics <- array(1:64, c(8, 8, n)) ref <- function(magics, j) { magics[j] <- rev(magics[j]) return(magics) } fun <- function(i){ref(magics[,,i], j[,,i])} return(array(sapply(1:n, fun), c(8, 8, n))) } "magic.constant" <- function (n, d = 2, start = 1) { if (is.array(n)) { return(Recall(n = dim(n)[1], d = length(dim(n)))) } n * (start + (n^d - 1)/2) } "magiccube.2np1" <- function (m) { if(length(m)>1){ return(sapply(m,match.fun(sys.call()[[1]]))) } n <- 2 * m + 1 jj <- array(1:n, rep(n, 3)) x <- arow(jj, 1) y <- arow(jj, 2) z <- arow(jj, 3) return(force.integer(((x - y + z - 1) - n * floor((x - y + z - 1)/n)) * n * n + ((x - y - z) - n * floor((x - y - z)/n)) * n + ((x + y + z - 2) - n * floor((x + y + z - 2)/n)) + 1)) } "magichypercube.4n" <- function (m, d = 3) { n <- 4 * m a <- array(0, rep(2, d)) jj.f <- function(i) { arow(a, i) } x <- apply(sapply(1:d, jj.f, simplify = TRUE), 1, sum) dim(x) <- rep(2, d) a[x%%2 == 1] <- 1 i <- kronecker(array(1, rep(m + 1, d)), kronecker(a, array(1, rep(2, d)))) == 1 i <- do.call("[", c(list(i), lapply(1:d, function(jj.i) { 2:(n + 1) }))) j <- array(1:(n^d), rep(n, d)) j[i] <- rev(j[i]) return(j) } "magicplot" <- function (m, number = TRUE, do.circuit = FALSE, ...) { par(pch = 16) n <- nrow(m) jj <- sort(t(m[n:1, ]), index.return = TRUE)$ix x <- process(jj, n) y <- (jj - 1)%/%n par(pty = "s", xaxt = "n", yaxt = "n") plot(x, y, type = "n", asp = 1, xlab = "", ylab = "", frame = FALSE) if (number == TRUE) { text(x, y, as.character(1:(n * n))) if (missing(...)) { points(x, y, type = "l") } else { points(x, y, cex = 0, ...) } } else { if (missing(...)) { points(x, y, type = "o") } else { points(x, y, ...) } } if (do.circuit == TRUE) { lines(c(x[1], x[n * n]), c(y[1], y[n * n]), ...) } } "magic.prime" <- function (n, i = 2, j = 3) { a <- matrix(0, n, n) return(force.integer(n * (col(a) - i * row(a) + i - 1)%%n + (col(a) - j * row(a) + j - 1)%%n + 1)) } "magic.product" <- function (a, b, mat = NULL) { if (length(a) == 1) { a <- magic(a) } if (length(b) == 1) { b <- magic(b) } if (is.null(mat)) { mat <- a * 0 } if (any(dim(mat) != dim(a))) { stop("third argument must be same size as a") } ra <- nrow(a) ca <- ncol(a) rb <- nrow(b) cb <- ncol(b) aa <- a aa[aa] <- seq_along(a) out <- sapply(mat[aa], transf, a = b) out <- sweep(out, 2, length(b) * (seq_along(a)-1L), FUN = "+") out <- out[, a] dim(out) <- c(rb, cb, ra, ca) out <- aperm(out, c(1, 3, 2, 4)) dim(out) <- c(ra * rb, ca * cb) return(force.integer(out)) } "magic.product.fast" <- function (a, b) { if ((length(a) == 1) & (length(b) == 1)) { return(Recall(magic(a), magic(b))) } a.l <- nrow(a) b.l <- nrow(b) return(force.integer(b.l * b.l * (kronecker(a, matrix(1, b.l, b.l)) - 1) + kronecker(matrix(1, a.l, a.l), b))) } "minmax" <- function (x, tol=1e-6) { if(is.integer(x)){ return(identical(max(x), min(x))) } if(all(x==0)){return(TRUE)} #special dispensation for all zeros if(is.double(x)){ return(abs(max(x)-min(x))/max(abs(x)) < tol) } else { return( abs(max(Re(x))-min(Re(x)))/max(abs(x)) < tol & abs(max(Im(x))-min(Im(x)))/max(abs(x)) < tol) } } "notmagic.2n" <- function (m) { options(warn = -1) n <- 2 * m a <- matrix(NA, n, n) s <- seq(from = 2, by = 2, to = m) jj.down <- kronecker(rep(1, m), rbind(1:n, n:1))[, 1:m] jj.down[, s] <- jj.down[n:1, s] jj.down <- cbind(c(1:n, n:1), as.vector(jj.down)) jj.up <- jj.down jj.up[, 2] <- (m + jj.up[, 2])%%n jj.up[jj.up == 0] <- n jj.both <- rbind(jj.down, jj.up) a[jj.both] <- 1:(n^2) return(a) } "panmagic.4" <- function (vals = 2^(0:3)) { a <- rep(1, 2) S <- kronecker(a, kronecker(diag(a), t(a))) A <- diag(a)[c(1, 2, 1, 2), c(2, 1, 1, 2)] N <- t(S) C <- t(A) jj <- array(c(S, A, N, C), c(4, 4, 4)) return(force.integer(1 + apply(sweep(jj, 3, vals, "*"), 1:2, sum))) } "panmagic.8" <- function (chosen = 1:6, vals = 2^(0:5)) { a <- rep(1, 2) a.01 <- kronecker(matrix(1, 2, 2), kronecker(diag(a), t(a)))[c(1:4, 4:1), ] a.03 <- kronecker(t(a), diag(a)[c(1, 2, 1, 2), c(2, 1, 1, 2)])[c(1:4, 4:1), ] a.05 <- kronecker(a, kronecker(kronecker(a, kronecker(diag(a), t(a))), t(a))) a.07 <- kronecker(kronecker(a, diag(a)[c(1, 2, 1, 2), c(2, 1, 1, 2)]), t(a)) a.09 <- kronecker(a, kronecker(kronecker(diag(a), t(c(a, a))), a)) a.11 <- kronecker(diag(a)[c(1, 2, 1, 2), c(2, 1, 1, 2)], matrix(1, 2, 2)) a.02 <- t(a.01) a.04 <- t(a.03) a.06 <- t(a.05) a.08 <- t(a.07) a.10 <- t(a.09) a.12 <- t(a.11) jj <- array(c(a.01, a.02, a.03, a.04, a.05, a.06, a.07, a.08, a.09, a.10, a.11, a.12), c(8, 8, 12)) jj <- jj[, , chosen, drop = FALSE] return(force.integer(1 + apply(sweep(jj, 3, vals, "*"), 1:2, sum))) } "process" <- function (x, n) { x <- x%%n x[x == 0] <- as.integer(n) return(x) } "recurse" <- function (perm,i, start=seq_along(perm)) { i <- as.integer(i) if (i < 0) { invert <- function(perm) { perm[perm] <- seq_along(perm) return(perm) } return(Recall(start = start, invert(perm), -i)) } perm.final <- seq_along(perm) while (i != 0) { perm.final <- perm[perm.final] i <- i - 1L } return(start[perm.final]) } "shift" <- function (x, i=1) { n <- length(x) if(n==0){return(x)} i <- i%%n if (i == 0) { return(x) } return(x[c((n - i + 1):n, 1:(n - i))]) } "strachey" <- function (m, square = magic.2np1(m)) { if(length(m)>1){ stopifnot(length(m) == length(square)) funcname <- match.fun(sys.call()[[1]]) f <- function(i){ do.call(funcname, list(m=m[i],square=square[[i]])) } return(lapply(seq_along(m),f)) } m <- round(m) n <- 4 * m + 2 r <- 2 * m + 1 out <- kronecker(matrix(c(0, 3, 2, 1), 2, 2), matrix(1, r, r)) * r^2 + kronecker(matrix(1, 2, 2), square) coords.top <- as.matrix(expand.grid(1:r, 1:m)) coords.top[m + 1, 2] <- m + 1 if (m > 1) { coords.top <- rbind(coords.top, as.matrix(expand.grid(1:r, n:(n - m + 2)))) } coords.low <- sweep(coords.top, 2, c(r, 0), "+") jj <- out[coords.top] out[coords.top] <- out[coords.low] out[coords.low] <- jj return(force.integer(out)) } "subsums" <- function (a, p, func = "sum", wrap = TRUE, pad = 0) { if(length(p)==1){p <- 0*dim(a)+p} if (wrap == FALSE) { jj <- adiag(array(pad, p - 1), a,pad=pad) return(Recall(jj, p, func = func, pad = pad, wrap = TRUE)) } if (is.vector(p)) { sub.coords <- 1 - as.matrix(expand.grid(sapply(p, function(i) { 1:i }, simplify = FALSE))) } else { sub.coords <- 1 - p } out <- apply(sub.coords, 1, function(v) { ashift(a, v) }) dim(out) <- c(dim(a), nrow(sub.coords)) if (nchar(func) == 0) { return(out) } else { return(apply(out, seq_along(dim(a)), FUN=func)) } return(out) } "transf" <- function (a, i) { i <- as.integer(i%%8) if (i%%2) { a <- t(a) } if ((i%/%2)%%2) { a <- a[nrow(a):1, ] } if ((i%/%4)%%2) { a <- a[, ncol(a):1] } return(a) } "apltake" <- function(a,b, give.indices=FALSE){ if(is.vector(a)){ return(as.vector(Recall(as.matrix(a),b=b,give.indices=give.indices))) } b <- c(b,dim(a)[seq(from=length(b)+1,length=length(dim(a))-length(b),by=1)]) f <- function(x) { if (x[2] <= 0) { return(-seq_len(x[1]+x[2])) } else { return(seq_len(x[2])) } } jj <- apply(cbind(dim(a),b),1,f) if(is.matrix(jj)){jj <- as.list(as.data.frame(jj))} if(give.indices){ return(jj) } else { return(do.call("[",c(list(a),jj ,drop=FALSE))) } } "apldrop" <- function(a, b, give.indices=FALSE){ if(is.vector(a)){ return(as.vector(Recall(as.matrix(a),b=b,give.indices=give.indices))) } b <- c(b,rep(0,length(dim(a))-length(b),by=1)) f <- function(x){ if(x[2] <= 0){ return(seq(length=x[1]+x[2])) } else { return(-seq(length=x[2])) } } jj <- apply(cbind(dim(a),b),1,f) if(is.matrix(jj)){jj <- as.list(as.data.frame(jj))} if(give.indices){ return(jj) } else { return(do.call("[",c(list(a),jj ,drop=FALSE))) } } "apltake<-" <- function(a,b,value){ do.call("[<-",c(list(a),apltake(a,b,give.indices=TRUE),value)) } "apldrop<-" <- function(a,b,value){ do.call("[<-",c(list(a),apldrop(a,b,give.indices=TRUE),value)) } "fnsd" <- function(a,n=1){ return(which(dim(a)>1)[seq_len(n)]) } "apad" <- function(a, l, e=NULL, method="ext", post=TRUE){ if(is.vector(a)){ return(drop(Recall(as.matrix(a), l=c(l,0), e=e, method=method,post=post))) } if(length(l)==1){ jj <- rep(0,length(dim(a))) jj[l] <- e l <- jj } if(post){ f <- switch(method, ext = function(x){c(1:x[1],rep(x[1],x[2]))}, mirror = function(x){ rep(c(1:x[1],x[1]:1),length=x[1]+x[2])}, rep = function(x){ rep(1:x[1],length=x[1]+x[2])} ) } else { f <- switch(method, ext = function(x){c(rep(1,x[2]), 1:x[1])}, mirror = function(x){ rev(rep(c(x[1]:1,1:x[1]),length=x[1]+x[2]))}, rep = function(x){ rev(rep(x[1]:1,length=x[1]+x[2]))} ) } jj <- apply(cbind(dim(a),l),1,f) if(is.matrix(jj)){jj <- as.list(as.data.frame(jj))} return(do.call("[",c(list(a), jj ,drop=FALSE))) } "do.index" <- function(a,f, ...){ jj <- function(i) {seq_len(dim(a)[i])} index <- as.matrix(expand.grid(lapply(seq_len(length(dim(a))), jj), KEEP.OUT.ATTRS = FALSE) ) a[index] <- apply(index, 1, f, ...) return(a) } "sam" <- function(m, u, A=NULL, B=A){ if(is.null(A)){ A <- latin(m) } if(is.null(B)){ B <- is.latin(m) } if(u%%2){ # u odd if(u < 3){ jj <- NULL } else { jj <- 8 * seq(from=0 , by=1 , to=round((u-3)/2) ) } JC <- c(0, 6+jj, 13+jj) JD <- c(1, 7+jj, 12+jj) JS <- c(2,4, 8+jj, 11+jj) JT <- c(3,5, 9+jj, 10+jj) } else { # u even if(u < 4){ jj <- NULL } else { jj <- 8 * seq(from=0 , by=1 , to=round((u-4)/2) ) } JC <- c(2,3, 10+jj, 17+jj) JD <- c(0,4, 11+jj, 16+jj) JS <- c(1,7,9, 12+jj, 15+jj) JT <- c(5,6,8, 13+jj, 14+jj) } S <- C <- T <- D <- A*0 i <- row(A) for(r in seq_len(u)){ Ar <- A==r Br <- B==r S[Br] <- i[Br] + m*JS[r] C[Ar] <- (m+1) - i[Ar] + m*JC[r] T[Ar] <- i[Ar] + m*JT[r] D[Br] <- (m+1) - i[Br] + m*JD[r] } S[B==u+1] <- i[B==u+1] + m*JS[u+1] # 2 T[A==u+1] <- i[A==u+1] + m*JT[u+1] # 3 force.integer(rbind( cbind(C,S), cbind(T,D) ) ) } "is.antimagic" <- function(m, give.answers=FALSE, func=sum){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]), give.answers=give.answers, func=func )) } jj <- allsums(m, func=func) answer <- all(diff(sort(c(jj$rowsums , jj$colsums)))==1) if(give.answers){ return(c(answer=answer , jj)) } else { return(answer) } } "is.totally.antimagic" <- function(m, give.answers=FALSE, func=sum){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]), give.answers=give.answers, func=func )) } jj <- allsums(m, func=func) answer <- all(diff(sort(c( jj$rowsums , jj$colsums , jj$majors[1], jj$minors[1] )))==1) if(give.answers){ return(c(answer=answer , jj)) } else { return(answer) } } "is.heterosquare" <- function(m, func = sum){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]), func = func)) } sums <- allsums(m, func = func) jj <- c(sums$rowsums, sums$colsums) if(all(diff(sort(jj)))>0){ return(TRUE) } else { return(FALSE) } } "is.totally.heterosquare" <- function(m, func = sum){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]), func = func)) } sums <- allsums(m, func = func) jj <- c(sums$rowsums, sums$colsums, sums$majors[1], sums$minors[1]) if(all(diff(sort(jj)))>0){ return(TRUE) } else { return(FALSE) } } "is.sparse" <- function(m){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]))) } m <- m[m != 0] minmax(c(1,diff(sort(m)))) & (min(m)==1) } "is.sam" <- function(m){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]))) } is.antimagic(m) & is.sparse(m) } "is.stam" <- function(m){ if (is.list(m)) { return(sapply(m, match.fun(sys.call()[[1]]))) } is.totally.antimagic(m) & is.sparse(m) } "incidence" <- function(a){ M <- max(a) d <- dim(a) sd <- seq_along(d) out <- array(0L,dim=c(d,M)) f <- function(i){out <- rep(0L,M) out[i] <- 1L out } aperm(apply(a,sd,f),c(sd+1,1)) } "is.incidence" <- function(a, include.improper){ f <- function(x){ all(x==0 | x==1) & sum(x)==1 } out <- is.semimagichypercube(a, func=f, boolean=TRUE) if(include.improper){ return(out|is.incidence.improper(a)) } else { return(out) } } "is.incidence.improper" <- function(a){ f <- function(x){ (all(x==0 | x==1 | x==(-1)) & sum(x)==1) | (all(x==0 | x==1) & sum(x)==1) } is.semimagichypercube(a, func=f, boolean=TRUE) & (sum(a == -1) == 1) } "unincidence" <- function(a){ stopifnot(is.incidence(a,include.improper=FALSE)) a <- a>0 apply(a, seq_len(length(dim(a))-1) , which) } "inc_to_inc" <- function(a){ # takes a proper or improper incidence # array (0/1) and returns an # incidence array, randomly chosen if # a is improper. If 'a' is proper, # returns an improper array; if # improper, returns either a proper # or improper array. storage.mode(a) <- "numeric" randint <- function(r,n=1){ceiling(runif(n)*r)} stopifnot(is.incidence(a, include.improper=TRUE)) if(is.incidence(a,include.improper=FALSE)){ proper <- TRUE } else { proper <- FALSE } if(proper){ # choose a zero jj <- which(a==0 , arr.ind=TRUE) pivot <- jj[randint(nrow(jj)),,drop=TRUE] } else { # choose the (single) -1 pivot <- which(a == -1, arr.ind=TRUE) } jj1 <- which(a[ ,pivot[2],pivot[3],drop=TRUE] == 1) jj2 <- which(a[pivot[1], ,pivot[3],drop=TRUE] == 1) jj3 <- which(a[pivot[1],pivot[2], ,drop=TRUE] == 1) if(!proper){ jj1 <- jj1[randint(2)] jj2 <- jj2[randint(2)] jj3 <- jj3[randint(2)] } kk1 <- c(jj1 , pivot[2], pivot[3]) kk2 <- c(pivot[1], jj2 , pivot[3]) kk3 <- c(pivot[1], pivot[2], jj3 ) # a[kk[123]] == TRUE ll1 <- c(pivot[1], jj2, jj3) ll2 <- c(jj1 ,pivot[2], jj3) ll3 <- c(jj1 , jj2,pivot[3]) mm1 <- c(jj1,jj2,jj3) increment <- rbind(pivot, ll1,ll2,ll3) decrement <- rbind(kk1,kk2,kk3,mm1) a[increment] <- a[increment] + 1L a[decrement] <- a[decrement] - 1L return(a) } "another_latin" <- function(a){ #given a latin square, returns a _different_ one i <- incidence(a) anew <- unincidence(i) #inefficient but clear; anew==a while(all(a == anew)){ # iterate until a different one is found i <- inc_to_inc(i) if(is.incidence(i,FALSE)){ anew <- unincidence(i) } } return(anew) } "another_incidence" <- function(i){ # given a _proper_ incidence # array, returns a different # _proper_ incidence array out <- i while(all(out==i) | !is.incidence(out,FALSE)){ out <- inc_to_inc(out) } return(out) } "rlatin" <- function(n,size=NULL,start=NULL,burnin=NULL){ if(is.null(size) & is.null(start)){ size <- n n <- 1 } if(is.null(start)){ start <- latin(size) } else { stopifnot(is.latin(start)) } if(is.null(burnin)){ burnin <- prod(dim(start)) } out <- array(0L,c(dim(start),n)) inc <- incidence(start) for(i in seq_len(burnin)){inc <- another_incidence(inc)} for(i in seq_len(n)){ out[,,i] <- unincidence(inc) inc <- another_incidence(inc) } return(drop(out)) } "sylvester" <- function(k){ stopifnot(k==round(k)) if(k==0){ return(matrix(1L,1,1)) } else { return(kronecker(Recall(k-1),matrix(c(1L,1L,1L,-1L),2,2))) } } "is.hadamard" <- function(m){ is.matrix(m) & nrow(m)==ncol(m) & all( (m==1)|(m== -1)) & all(crossprod(m)==diag(nrow(m),nrow=nrow(m))) } "cilleruelo" <- function(n,m){ matrix(c( (n+2)*(m+0), (n+3)*(m+3), (n+1)*(m+2), (n+0)*(m+1), (n+1)*(m+1), (n+0)*(m+2), (n+2)*(m+3), (n+3)*(m+0), (n+0)*(m+3), (n+1)*(m+0), (n+3)*(m+1), (n+2)*(m+2), (n+3)*(m+2), (n+2)*(m+1), (n+0)*(m+0), (n+1)*(m+3) ),nrow=4,ncol=4,byrow=TRUE) } "bernhardssonA" <- function(n){ if(n%%2==1){return(adiag(1,Recall(n-1)))} out <- matrix(0L,n,n) m <- n/2 j <- seq_len(m) out[cbind(j,2*j)] <- 1L out[cbind(m + j, 2*j-1 )] <- 1L return(out) } "bernhardssonB" <- function(n){ if(n%%2==1){return(adiag(1,Recall(n-1)))} out <- matrix(0L,n,n) m <- n/2 j <- seq_len(m) out[cbind(j,(1+(2*(j-1)+m-1))%%n)] <- 1L out[cbind(n+1-j,n - (2*(j-1)+m-1)%%n)] <- 1L return(out) } "bernhardsson" <- function(n){ if( (n%%6) %in% 0:1){ return(bernhardssonA(n)) } else { return(bernhardssonB(n)) } } "is.alicehypercube" <- function(a, ndim, give.answers=FALSE, func=sum, boolean=FALSE){ stopifnot(minmax(dim(a))) n <- dim(a)[1] d <- length(dim(a)) jj <- d-ndim out <- apply(combn(d,jj),2,function(i){apply(a,i,func)}) if(boolean){ answer <- all(out) } else { answer <- minmax(out) } if(give.answers){ dim(out) <- c(rep(n,jj),ncol(out)) return(list(answer=answer, alice.sums=out)) } else { return(answer) } } "eq" <- function (m1, m2) { all(m1 == m2) } "ne" <- function (m1, m2) { any(m1 != m2) } "gt" <- function (m1, m2) { jj <- m1 - m2 return(ne(m1, m2) && jj[min(which(jj != 0))] > 0) } "lt" <- function (m1, m2) { jj <- m1 - m2 return(ne(m1, m2) && jj[min(which(jj != 0))] < 0) } "ge" <- function (m1, m2) { eq(m1, m2) || gt(m1, m2) } "le" <- function (m1, m2) { eq(m1, m2) || lt(m1, m2) } "%eq%" <- function (m1, m2) { return(eq(m1, m2)) } "%ne%" <- function (m1, m2) { return(ne(m1, m2)) } "%gt%" <- function (m1, m2) { return(gt(m1, m2)) } "%lt%" <- function (m1, m2) { return(lt(m1, m2)) } "%ge%" <- function (m1, m2) { return(ge(m1, m2)) } "%le%" <- function (m1, m2) { return(le(m1, m2)) } panmagic.6npm1 <- function(n){ if (length(n) > 1) { return(sapply(n, match.fun(sys.call()[[1]]))) } apx <- kronecker(t(seq(from=0,by=n-2,len=n)),rep(1,n)) + kronecker(1:n,t(rep(1,n))) jj <- process(apx%%n, n) return(force.integer(jj+n*t(jj)-n)) } panmagic.6np1 <- function(m){ panmagic.6npm1(n=6*m+1)} panmagic.6nm1 <- function(m){ panmagic.6npm1(n=6*m-1)} panmagic.4n <- function(m){ # returns a square of size [4n x 4n] if (length(m) > 1) { return(sapply(m, match.fun(sys.call()[[1]]))) } jj <- kronecker(rep(1,m*2),rbind(1:(2*m), (4*m):(2*m+1))) jj <- cbind(jj,ashift(jj,v=c(1,0))) return(force.integer(jj + 4*m*(arot(jj)-1))) } magic/NEWS.md0000644000176200001440000000021614200263305012422 0ustar liggesusers# freegroup 1.6-0 - emphasis on high-dimensional arrays rather than magic hypercubes - sticker now in vignette - new README - minor bugfixes magic/MD50000644000176200001440000000774614335056755011675 0ustar liggesusers8b1e20d7cd9e6816e8a64e924bdca445 *DESCRIPTION c42e9e1c41c2cfd43f60eac75b363064 *NAMESPACE 4fe4a791d9b552b96dd265e999a016a7 *NEWS.md 5072acdbe9898fe6c8eec73f163a6692 *R/magic.R dbdd944505ed5ec37e8cea6f9cbc618d *README.md a9e5a2afcf58bd68eb1ea1f9db1738b8 *build/partial.rdb 1368f9c0b9ae92646d3b352fa465107d *build/vignette.rds 18f1f33a5a2a75f51884de549f865802 *data/Frankenstein.rda 7e22613f92181194b7ad56e051eaa470 *data/Ollerenshaw.rda 970f31c153eba27aaac0a4a419d60c06 *data/cube2.rda 5687b555da559aedea7cb58998599d52 *data/hendricks.rda 04467e007e8185d81146c5bd196fcb11 *data/magiccubes.rda 39ed9bc6c0b495fed555cd9a181fdac1 *data/perfectcube5.rda 122358550a84e239dc366e259b4c9a75 *data/perfectcube6.rda 482019b15474422d86f5f43d5f68160a *inst/CITATION 92fc6082ed54d5e94a5b25a943315a71 *inst/doc/magic.R 901b8c1663dafe97db254fdb3db32e0e *inst/doc/magic.Rnw d685e4152846118235f7ac3745c104f1 *inst/doc/magic.pdf 8257b3e235ce7741292eaa1081fc8103 *inst/magic_stickermaker.R 4e3d404c8f3fb4120584bf3f6362bfb6 *man/Frankenstein.Rd bf87aba8a850136d2c93ba98b7413e04 *man/Ollerenshaw.Rd fe71f01ca379056a3c9a2bd2c56f4239 *man/adiag.Rd cf0171be054b3a2ef34af9a719c9b747 *man/allsubhypercubes.Rd 1860378deed71690155bb840548c2437 *man/allsums.Rd dc9537a43d70691276bedef41ab8a789 *man/apad.Rd 9c40ad3a9c89961a5419346f1acef832 *man/apl.Rd c1e722b8cb38c3798e382575140ed3bf *man/aplus.Rd b2f77aec0b009c8041175f4c599d7be3 *man/arev.Rd 5910cda9695195a81a43ca0228fdbd94 *man/arot.Rd a9f5c3e0b17d21e8211dd8fd8a17885f *man/arow.Rd 4f66928317752e34f725d621c3938859 *man/as.standard.Rd 3706ac6f713c9dd8bf4e55a659b5db70 *man/cilleruelo.Rd 02e6720328660a1e6be0c1150d82ad1b *man/circulant.Rd 5ac22980d468c3e64f8b4b355a79dca8 *man/cube2.Rd 046438996d74e80db4ecde365eee01a7 *man/diag.off.Rd ec5c9f2ec0473674be86928006de58e4 *man/do.index.Rd afc08b80497851056bf857c2a0c08e5d *man/eq.Rd c48cc53eb111fc867e6b86240fd5fbe4 *man/figures/magic.png 9dd17632180871eb56ed5f8183074fc5 *man/fnsd.Rd 65be609dde4b8a7088fea4f2b8a3fa98 *man/force.integer.Rd f553b3bab23e807614b2f221a55106a3 *man/hadamard.Rd b67748749e93fa9842dee82a7a8f3849 *man/hendricks.Rd 1ea1df8ae409b24a2aeac9c945d984e5 *man/hudson.Rd c97f95777ab40e6bcd30f481304d6dec *man/is.magic.Rd 6520730710f120cb610f5853005ea927 *man/is.magichypercube.Rd 0a429e8fc806279557c60eeba2c1e3d9 *man/is.ok.Rd 0738a663871be9240aaf128e034473f7 *man/is.square.palindromic.Rd df497728f31271ea389eaf88331531aa *man/latin.Rd 9f8c461fb316586f8c2a3c0d3d4c99ec *man/lozenge.Rd 20fd822537d74e2c571383e25404cb0f *man/magic-package.Rd 79cb89ef0951f1579b8b1e12889343f9 *man/magic.2np1.Rd 51842f8dc94a9f801bafa69c522d0e24 *man/magic.4n.Rd 6c0bc2c4ae93e5ab4fa3326922243156 *man/magic.4np2.Rd f3b5e5097411ce5f210010c4d38e8182 *man/magic.8.Rd 9bb61afa97d1db48037155ed272391cf *man/magic.Rd 22a70aa896b569828fa63df9df9759bc *man/magic.constant.Rd 2c825142f600890d4d2778aabd4fe38b *man/magic.prime.Rd cf2f1f9024f2ea114b0ec6efb50e563f *man/magic.product.Rd 6ccde43fcdfd32e78097663b85616748 *man/magiccube.2np1.Rd 212fc08dfea6978863240e792c1ebe79 *man/magiccubes.Rd b6cb7cf2c7d2113336a7ff8b635307d0 *man/magichypercube.4n.Rd fb9468272f1dac07b1ccad81ead16cc8 *man/magicplot.Rd 2ec5d2ff2b0cca54de7259e388fd664a *man/minmax.Rd d2df649c04a32ec0c1a151e7faac368f *man/notmagic.2n.Rd 3f240181a13848ac4b55a588d009ddf9 *man/nqueens.Rd 1ec1da409ba6a6602b0a739c0a519a38 *man/panmagic.4.Rd 3a844557c3eedd75dbbea22894295b82 *man/panmagic.6npm1.Rd 572bad8caaa75f64b0784e9a78bf8c26 *man/panmagic.8.Rd 69184d2b60904b82d4770857c98359bd *man/perfectcube5.Rd bf07e11338934ffb26842f13b36b50d7 *man/perfectcube6.Rd e397c1c0fe5258bcc8bcdafb45b4704e *man/process.Rd d17acca2f2e1b87a8e038500f8c6bdc0 *man/recurse.Rd 6318077b1e70e04a0672ab54699a1eaf *man/sam.Rd 0a928c36ad7289ce5bfa7f577233beee *man/shift.Rd 4ed2b202a03d60dad4f0fdee1631d07f *man/strachey.Rd 69527e30a220e996bd8136b32bee545c *man/subsums.Rd ca323c7cd939c02941ae2fce04f3583f *man/transf.Rd a56296b235cf29805cf3fc1c8a88714f *tests/aaa.R 901b8c1663dafe97db254fdb3db32e0e *vignettes/magic.Rnw 41e0fce0f6bd8650feebe45bce63e25f *vignettes/magic.bib magic/inst/0000755000176200001440000000000014334512426012313 5ustar liggesusersmagic/inst/magic_stickermaker.R0000644000176200001440000000145414136346326016272 0ustar liggesusers## Notes: does not seem to work on linux; knotR.png produced on windows ## Function magicplot2() is a bespoke version of magicplot() library("magic") library("hexSticker") `magicplot2` <- function (m) { par(pch = 16) n <- nrow(m) jj <- sort(t(m[n:1, ]), index.return = TRUE)$ix x <- process(jj, n) y <- (jj - 1)%/%n par(pty = "s", xaxt = "n", yaxt = "n") plot(x, y, type = "n", asp = 1, xlab = "", ylab = "", frame = FALSE) points(x, y, type="l",lwd=14) } png(file="magic_icon.png",width=1000,height=1000,bg="transparent") magicplot2(magic(4)) dev.off() sticker("magic_icon.png", package="magic", p_size=24, s_x=0.975, s_y=1.0, s_width=0.83,asp=sqrt(3)/2, white_around_sticker=TRUE, h_fill="#7733FF", h_color="#000000", filename="magic.png") magic/inst/doc/0000755000176200001440000000000014334512426013060 5ustar liggesusersmagic/inst/doc/magic.R0000644000176200001440000000335614334512426014272 0ustar liggesusers### R code from vignette source 'magic.Rnw' ################################################### ### code chunk number 1: magic.Rnw:101-101 ################################################### ################################################### ### code chunk number 2: magic.Rnw:102-103 ################################################### require(magic) ################################################### ### code chunk number 3: magic.Rnw:109-110 ################################################### magic(3) ################################################### ### code chunk number 4: magic.Rnw:123-124 ################################################### magicplot(magic.2np1(3)) ################################################### ### code chunk number 5: magic.Rnw:175-197 ################################################### shadedsquare <- function(m=2){ n <- 4*m jj.1 <- kronecker(diag(2), matrix(1, 2, 2)) jj <- kronecker(matrix(1, m + 1, m + 1), jj.1)[2:(n + 1), 2:(n + 1)] par(xaxt="n",yaxt="n") image(1:n,1:n,jj,xlab="",ylab="",asp=1,frame=FALSE,col=c(gray(0.9),gray(0.4))) abline(v=0.5+(0:n)) segments(x0=rep(0.5,n),y0=0.5+(0:n),x1=rep(n+0.5,n),y1=0.5+(0:n)) return(invisible(jj)) } jj <- shadedsquare() #a <- magic(8) #text(row(a),col(a),as.character(a),col="white") for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } } } ################################################### ### code chunk number 6: magic.Rnw:206-216 ################################################### shadedsquare() for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } else { text(i,j,magic(8)[i,9-j],col="black") } } } magic/inst/doc/magic.Rnw0000644000176200001440000003476714316715255014656 0ustar liggesusers\documentclass[nojss]{jss} \usepackage{amssymb} \usepackage{wrapfig} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% just as usual \author{Robin K. S. Hankin} \title{Recreational mathematics with \proglang{R}: introducing the \pkg{magic} package} %\VignetteIndexEntry{A vignette for the magic package} %% for pretty printing and a nice hypersummary also set: %% \Plainauthor{Achim Zeileis, Second Author} %% comma-separated \Plaintitle{Recreational mathematics with R: introducing the magic package} \Shorttitle{Magic squares in R} %% an abstract and keywords \Abstract{ The \proglang{R} computer language~\citep{R} has been applied with a great deal of success to a wide variety of statistical, physical, and medical applications. Here, I show that \proglang{R} is an equally superb research tool in the field of recreational mathematics. An earlier version of this vignette was published as~\citet{hankin2005}. } \Keywords{Magic squares} % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- \Address{ Robin K. S. Hankin\\ AUT University\\ Auckland\\ New Zealand\\ E-mail: \email{hankin.robin@gmail.com} } %% need no \usepackage{Sweave.sty} \begin{document} \section{Overview} \setlength{\intextsep}{0pt} \begin{wrapfigure}{r}{0.2\textwidth} \begin{center} \includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}} \end{center} \end{wrapfigure} Recreational mathematics is easier to recognize than define, but seems to be characterized by requiring a bare minimum of ``raw material'': complex notation is not needed, and problems are readily communicated to the general public. This is not to say that all problems of recreational mathematics are trivial: one could argue that much number theory is recreational in nature; yet attempts to prove Fermat's Last Theorem, or the search for ever higher perfect numbers, have been the catalyst for the development of many fruitful new areas of mathematics. The study of magic squares is also an example of nontrivial recreational mathematics as the basic concept is simple to grasp---yet there remain unsolved problems in the field whose study has revealed deep mathematical truths. Here, I introduce the \pkg{magic} package, and show that \proglang{R} is an excellent environment for the creation and investigation of magic squares. I also show that one's appreciation of magic squares may be enhanced through computer tools such as \proglang{R}, and that the act of translating `paper' algorithms of the literature into \proglang{R} idiom can lead to new insight. \section{Introduction} Magic squares have essentially zero practical use; their fascination---like much of pure mathematics---lies in the appeal of \ae sthetics and structure rather than immediate usefulness. The following definitions are almost universal: \begin{itemize} \item A {\em semimagic square} is one all of whose row sums equal all its columnwise sums (i.e. the magic constant). \item A {\em magic square} is a semimagic square with the sum of both unbroken diagonals equal to the magic constant. \item A {\em panmagic square} is a magic square all of whose broken diagonals sum to the magic constant. \end{itemize} (all squares are understood to be $n\times n$ and to be {\em normal\/}, that is, to comprise $n^2$ consecutive integers\footnote{Most workers require the entries to start at 1, which is the convention here; but there are several instances where starting at~0 is far more convenient. In any case, if \code{x} is magic, then \code{x+n} is magic for any integer \code{n}.}). Functions \code{is.semimagic()}, \code{is.magic()}, and \code{is.panmagic()} test for these properties. <>= <>= require(magic) @ A good place to start is the simplest---and by far the most commonly encountered---magic square, {\em lo zhu}: <>= magic(3) @ This magic square has been known since antiquity (legend has it that the square was revealed to humanity inscribed upon the shell of a divine turtle). More generally, if consecutive numbers of a magic square are joined by lines, a pleasing image is often obtained (figure~\ref{magic7}, for example, shows a magic square of order~7; when viewed in this way, the algorithm for creating such a square should be immediately obvious). \begin{figure}[htbp] \begin{center} <>= magicplot(magic.2np1(3)) @ \caption{Magic square of order~7\label{magic7} in graphical form (obtained by \texttt{magicplot(magic.2np1(3))}) } \end{center} \end{figure} Function \code{magic()} takes an integer argument~$n$ and returns a normal magic square of size $n\times n$. There are eight equivalent forms for {\em lo zhu\/} or indeed any magic square, achieved by rotating and reflecting the matrix~\citep{benson1976}; such equivalence is tested by \code{eq()} or \code{\%eq\%}. Of these eight forms, a magic square \code{a} is said to be in {\em Fr\'{e}nicle's standard form} if \code{a[1,1]}$\leq$\code{b[1,1]} whenever \code{a \%eq\% b}, and \code{a[1,2]a[2,1]}, take the transpose''. I shall show later that expressing such an algorithm in \proglang{R} leads to new insight when considering magic hypercubes. A wide variety of algorithms exists for calculating magic squares. For a given order $n$, these algorithms generally depend on $n$ modulo~4. A typical paper algorithm for magic squares of order~$n=4m$ would go as follows. \begin{quote} Algorithm 1: in a square of order~$4m$, shade the long major diagonal. Then shade all major diagonals distant by a multiple of~4 cells from the long diagonal. Do the same with the minor diagonals. Then, starting with ``1'' at the top left corner and proceeding from left to right and top to bottom, count from~1 to $n^2$, filling in the shaded squares with the appropriate number and omitting the unshaded ones [figure~\ref{magicsquare8.halfdone}]. Fill in the remaining (unshaded) squares in the same way, starting at the lower right corner, moving leftwards and upwards [figure~\ref{magicsquare8}]. \end{quote} Such paper algorithms are common in the literature but translating this one into code that uses \proglang{R}'s vectorized tools effectively can lead to new insight. The magicness of such squares may be proved by considering the increasing and decreasing sequences separately. \begin{figure}[htb] \begin{center} <>= shadedsquare <- function(m=2){ n <- 4*m jj.1 <- kronecker(diag(2), matrix(1, 2, 2)) jj <- kronecker(matrix(1, m + 1, m + 1), jj.1)[2:(n + 1), 2:(n + 1)] par(xaxt="n",yaxt="n") image(1:n,1:n,jj,xlab="",ylab="",asp=1,frame=FALSE,col=c(gray(0.9),gray(0.4))) abline(v=0.5+(0:n)) segments(x0=rep(0.5,n),y0=0.5+(0:n),x1=rep(n+0.5,n),y1=0.5+(0:n)) return(invisible(jj)) } jj <- shadedsquare() #a <- magic(8) #text(row(a),col(a),as.character(a),col="white") for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } } } @ \caption{Half-completed magic square of order\label{magicsquare8.halfdone} 8} \end{center} \end{figure} \begin{figure}[htb] \begin{center} <>= shadedsquare() for(i in 1:8){ for(j in 1:8){ if(jj[i,j]==1){ text(i,j,magic(8)[i,9-j],col="white") } else { text(i,j,magic(8)[i,9-j],col="black") } } } @ \caption{Magic square of order\label{magicsquare8} 8} \end{center} \end{figure} The interesting part of the above paper algorithm lies in determining the pattern of shaded and unshaded squares\footnote{If \code{a <- matrix(1:(n*n),n,n)}, with \code{jj} a Boolean vector of length~$n^2$ with \code{TRUE} corresponding to shaded squares, then with it is clear that \code{a[jj] <- rev(a[jj])} will return the above magic square.}. As the reader may care to verify, parsing the algorithm into \proglang{R} idiom is not straightforward. An alternative, readily computed in \proglang{R}, would be to recognize that the repeating $4\times 4$ cell \code{a[2:5,2:5]} is \code{kronecker(diag(2),matrix(1,2,2)) -> b} say, replicate it with \code{kronecker(matrix(1,3,3),b) -> g}; then trim off the border by selecting only the middle elements, in this case \code{g[2:9,2:9]}. Function \code{magic.4n()} implements the algorithm for general $m$. \section{Magic hypercubes} One of the great strengths of \proglang{R} is its ability to handle arbitrary dimensioned arrays in an efficient and elegant manner. Generalizing magic squares to magic hypercubes~\citep{hendricks1973} is thus natural when working in \proglang{R}. The following definitions represent a general consensus, but are far from universal: \begin{itemize} \item A {\em semimagic hypercube} has all ``rook's move'' sums equal to the magic constant (that is, each~$\sum_{i_r=1}^n a[i_1,i_2,\ldots,i_{r-1},i_r,i_{r+1},\ldots,i_d]$ with $1\leqslant r\leqslant d$ is equal to the magic constant for all values of the other i's). \item A {\em magic hypercube} is a semimagic hypercube with the additional requirement that all $2^{d-1}$ long (ie extreme point-to-extreme point) diagonals sum correctly. \item A {\em perfect magic hypercube} is a magic hypercube with all nonbroken diagonals summing correctly\footnote{This condition is quite restrictive; in the case of a tesseract, this would include subsets such as $\sum_{i=1}^na[1,i,n-i+1,n]$ summing correctly.}. \item A {\em pandiagonal hypercube} is a perfect magic hypercube with all broken diagonals summing correctly. \end{itemize} (a magic hypercube is understood to be of dimension \code{rep(n,d)} and normal). Functions \code{is.semimagichypercube()}, \code{is.magichypercube()} and \code{is.perfect(a)} test for the first three properties; the fourth is not yet implemented. Function \code{is.diagonally.correct()} tests for correct summation of the $2^d$ (sic) long diagonals. \subsection[Magic hypercubes of order 4n]{Magic hypercubes of order~{\boldmath $4n$}} Consider algorithm 1 generalized to a $d$-dimensional hypercube. The appropriate generalization of the repeating cell of the $8\times 8$ magic square discussed above is not immediately obvious when considering figure~\ref{magicsquare8.halfdone}, but the \proglang{R} formalism (viz \code{kronecker(diag(2),matrix(1,2,2))}) makes it clear that the appropriate generalization is to replace \code{matrix(1,2,2)} with \code{array(1,rep(2,d))}. The appropriate generalization for \code{diag(2)} (call it \code{g}) is not so straightforward, but one might be guided by the following requirements: \begin{itemize} \item The dimension of \code{g} must match the first argument to \code{kronecker()}, viz \code{rep(2,d)} \item The number of 0s must be equal to the number of 1s: \code{sum(g==1)==sum(g==0)} \item The observation that \code{diag(2)} is equal to its transpose would generalize to requiring that \code{aperm(g,K)} be identical to \code{g} for any permutation \code{K}. \end{itemize} These lead to specifying that \code{g[i1,...,id]} should be zero if $(i_1,\ldots,i_d)$ contains an odd number of 2s and one otherwise. One appropriate \proglang{R} idiom would be to define a function \code{dimension(a,p)} to be an integer matrix with the same dimensions as \code{a}, with element $(n_1,n_2, ..., n_d)$ being $n_p$, then if $\mbox{\code{jj}}=\sum_{i=1}^d\mbox{\code{dimension(a,i)}}$, we can specify \code{g=jj*0} and then \code{g[jj\%\%2==1] <- 1}. Another application of \code{kronecker()} gives a hypercube that is of extent $4m+2$ in each of its \code{d} dimensions, and this may be trimmed off as above to give an array of dimensions \code{rep(4m,d)} using \code{do.call()} and \code{[<-}. The numbers may be filled in exactly as for the 2d case. The resulting hypercube is magic, in the sense defined above\footnote{If I had a rigorous proof of this, the margin might be too narrow for it.}, although it is not perfect; function \code{magichypercube.4n()} implements the algorithm. The ability to generate magic hypercubes of arbitrary dimension greater than one is apparently novel. \subsubsection{Standard form for hypercubes} Consider again the paper definition for Fr\'{e}nicle's standard form of a magic square \code{a}: it is rotated so that the smallest number appears at the top left; then if \code{a[1,2]> stream x[Ys8~_T&R#NۉGvI*MȢ#9)d٪-"@@u7J3ŬcYaNYfYj昈%LXʄL-1 2I)52 (&SIL 4! SN &,ӱ6L" 0"!\"08$RP#)@&NbH`̠eIo,X@FU&̠e%ѬAJ` ZVx;j-+Y[,Z Z Y6ɿ !x }0& dtBq~=MlqDZ-), eڨEZ'#B={R La1'"cOP/q}tN9٬O/p;. 1 #Q(d|7̿66v~?WÉp g}8RK.ޡB,ב0IWHo'#4ۃ@YqIP8sL?0Us@t%$L?g4C_f* ͥIoMŷs_|{| #~w=ȇ|~2~lER|߫!?φ7n8:.y6s~N#e|1pJ. /|̯Oi Ïg+zW2-S>jelf/Φ!T*1E >#BB(c."'"R}bBLtH:AiLD&KE^:!_ȫ HD^ ?~y^lX֗n!;o| a.UHB˾ -݌gCj0+F{5ؒlK6&[m9$w5)+w|'D(eK06=,=> stream GPL Ghostscript 9.53.3 Magic squares 2022-11-15T08:20:54+13:00 2022-11-15T08:20:54+13:00 LaTeX with hyperref Recreational mathematics with R: introducing the magic packageRobin K. S. Hankin endstream endobj 66 0 obj << /Type /ObjStm /Length 3008 /Filter /FlateDecode /N 63 /First 538 >> stream xZr8}tu$v`k/mOvZv'SyPdfEܒN~qL;)/H˹ h,Kq+Ìg09Yh2h\㜞jƵH5;{/uLx&.ah\9^{K$pi&}OL1pU6@KySZ*X+kڄd0-@ cr<(x",I$3D7B%zZi%c'h0XYC%sU5HoVMV"%xZc+\ osAir05$,h GcG$ްD X_X|LCGF,zr DEf3ſ_פDaԛ2[fEi:&IbR[6U/_ /0 ^ZI!#픴eKNaǵN lK5#- ?14o=b?'} i<]?kв:\|x]{aNv"=JW$]1Zm*6ĸF<vT7Vf!66r׹͛ v?XRijݗLv4wAz7 u@pb9iɷR~[.W_WiPŇ_w9/^.f,>O&X6(xA2_/*} cO6QKBue[2?/]0?_wDt_-ZddN$l]K!I~ԢMQS,n|zcJI8nn.Jx/ޏU|ţ<ǟI_wP{>uu,t+I[z*ب6jۖjӘAmk `n%QIuB@&硃 is@g _]^<+{eXk tr U8xuzR.H䳺tq4#/eƓW"`֕mEMI~F+ʩrʲM} B]\ރ׷Cu+b&khOI>-3̛z!K]!ZԢj#R=n 5o[#;z# AF!h\"sCC գ fhbfRI7ŤbJ|B|P|x$id[L[6W<&^e,e yiG@USlHyd 6bjC.P Que;+d],ǃo{m .&TyI*mM^;ؿ]a^T;lA&޴!_DR72Fz3*}m?IlzgҨJ?ΚM0 ~j{"G(xYٍ05GZOE]2T)7){ lN9`7&[GG}X~N"ڋT RU$|}Sl!6ZSdm5^4-uj 6>Gf...> SSRC!Љ. +ɻDêϝEA-At b$H5ѻϧ{RٮlzZCڞ\@V장bbl>{*ӭa͵0It:^5tQmX#Uv._o`ja:zCm(Fy@#sM'm5``]nȵwrW5 qԼWQfHqS_ٖɦh $4tyŲqZnRYFtV9)/GBۣ@?vBZZ;Q6NJ &O.VpWFYDֻ9oGT]Q^ּ]?"Qnpt=K벽q1ؼ uU4/d)E-p%)me`~{>ǏiwmJ:_c_,}}'}ٷ&8G4:~Blx9GŧlMw?Y5:4ri0xe*`9DFʉg0o}diJߥ$l:͈T0Y?h::4 f-ڵ45Y|v?Eendstream endobj 130 0 obj << /Filter /FlateDecode /Length 3627 >> stream xZK)݌Iē}r$ةT칭SKX4//HwД4jG$F_7aQWrQˋ.ҟ~Ͼ~!JIkq\x_5EdU7zq_]^dSRߎJ7k#vxu[|i*!忮L5ux9GUu>Ny/>OTRK7b7|nۭ%%*)_I+ #ؕ6/Z9X.[:pl ?۴)+ŏR \Y +Z\U9Cmbco~uZY[P:ߟ/yat*ux\]|FYPr&T֫}E_lwc{eW>.Lē^vj|LՕsaP2/2~ߕ;der7RE0F'&}և $c2}%g-Mj-Ӽ]<8Ɵ>9q}A(p򸯜ӝ8<{cM[5Z\^63v:lVK!FCI'"ߒQˑEyb:vb[NߖnϞc[N&b44y?8Bs z#4JvU#^IW'}{qkF}dOȐdg|@dx)(7DPqע6(er^N뙷~ط*`jjfִ@C'IȜ)-B {,N;V0.s,czL'q 6wyZGLti%rUt_!.) 8Xf3ϧɽ8?,`2ю :,@[Ae C}mHրxkt Lv%Fl7QӚVL/S:Mj?)``ӌ&d(e?Q3zYEH r-3̽ӀGѢCFyFx6W22K0 z{ędYϥwBHD7^4f /?8Y@^~| !25*, Eng?xh$Y<7% _/py"P*(Jtc%EbBń "ƫr쾔xmZv9SoF\ P͌_vaXw!@O4֙y>4MA`F"hCtو}1kHImC-xb֕5L1G#qAkQmRK-L ;1!>1n4P3G6^7viU (88Dڳ]a b'PC訍Nsk,Ƹt5z5Wlmf<'LƁYK,fZ3hZd`-Ev9!:7ȴ")<7R}G-=S1A{a!LA3 r3E5LKXPفZ[o$CmS0%z)&>2OWhvN^~NDmJ](Mu=OK9vn,e@DL "rb=ĵ(+C@ Tc3\c¾>Ȧ\f<g+P;<yѕ*<-y "_:PڢB,h;f<~2X*.mpfMdF닔`qDhyAc\|`7nӾzFgj.'zM1 )i4|*켏QS{`yLu?EkϪ<ԙv0NyEk}I %1C&:kL0 GCu$Ը)tj5'T+5:͖ ,ⷫDI8mTyPM]kSjհe U:P0ӺFR PQ%"sc XvM EBTχJwVtLuUD)ge RI(I pB\,0YVk^BjKe՛9t, 2agas"!6p{!xѥfieJ[! pPB"!G)  6Dݸ=2 @bF1666B/t]#H;5L-n&6עsԚ/amjr|I%?ˣCaeP 2(FL3E)rwh ޸N;}B9B@:Sݦ%6d.xA[)3ͱ<" lCz|@-M5NA]c$_>PV N¬sXts$nrgiF+@YgѲq8Pmk򷉺<1K\jdz8 H+DKevϼwim,j;G%rc%li#bڂP_r%s)wܺrhǗy5EhR5/TBi.W.B6\ݬ#=U%Ztgu,icU|tS\mF+N]Hi^Ndࠪp ɑhQ So ڢT6IhZ3a ƟfȩURZ|b&d܂OH a״nPĞ.Y6$e;uxP.Qd rO<4ݔ]b%Ć\)P3e4>ǘ,r::SDFgGeS /#u8Qefl}l@׳Yl5OXkx|s|*b Qc){ZIN`F2{*Z~' #a2aZ=0= ю16Hgj5L{tan<>0~y1YOaVchLu(`E}!{2kpԵ9b{{wB@="KK !ZVPN5A$8}. Na@諡L!:tk6$3{2]>j߯s7hf>X#3{* MbsߏlԦSˀϾ3b_@endstream endobj 131 0 obj << /Filter /FlateDecode /Length 3358 >> stream xZI#G B7/vp@[hi1~?ZZKvVV._~٭sFn;cWvǛUP<<#|.\Ֆz7-vf(\YzXJ)W/ȇy.Kʸ"_vō쇛aJ;)ψ^k7 +8u~.ɹPP݌Q栏j K2 <{᪢Rcf\R{B2k,ג{*}F1O{:#*V3ŅJs RrcO4 n};kG9rԼڍgn`^ȾF-8*fQ&G.90ˍ:0 ],<D\pcқG.8\|܍YhčyLBY7F͕ !b[1Dl."b+9Y DlEAD*DlE0 ]UЭX&B ,tUA£h*DlEGs`u`,7$teDTLt+E DqT.X-Tc.k>Mֺ* wy-IFpO"dChz>.Jy 5qǚzjW<k1,^ 5Y5cj>f7*rF76aPi%/S>배B6KE>9=эK=CK Z*#ɯʳuWk3>zrS=&4mkUh7@.<_g7%_VXm)W]WKa/`PY:pS<ʜyPٲCmG(M<`<Ú0z!?tJ' <C_: eBτ_%W]$z )vV+Ks> E-tb;9q^Cv ;TϕvITZ!a߼]ƲP1hB( c~8`( c0Љ`(ڃ3 cy}cT|8Ih&=]ݶYo>UgNz |Lk`x}̈խs6I7P0]U=G;Lګ)Y:PR '"`("Y%"h:~8 n YhQVx!F sbG 57bܿ@1Y` Iθ` 6/LXY!j-RHn3yzmMU[%i@ob_{}u}(AMWC%pfQJ`4#?bx We)r|)k9, ?@$g uN9f7 -{yT P\EA 6mu(0L*x?4p#9kHԢo>-:1SMT52YsΪ1M<,/:lJcd P2LL_?𗡐k<4GU :VWSKP*šh,Y*P W0L*hg` y[Qi!tJ \I1pڜS(}&+l.Xj9)R`P5cUC3L͠m܉ ;W+z_N&5*ؚ5sm4"!5NԦ;,rB@c $,[>Jg@_:$$1U.[Jђ)i~ 5ЗO"-~x.xtXeG pdLRz$˺ca gl*WǨq /4p\@rivCC-ׇvBB쭐X  IM-O"nl+šp@6i.X~9'9.eu\yDZo88D@%yBvyaڮqqXrԥ _ұŲ<>zH-Bat:8\3%THGxSrG-p9{Z"> stream xZKsd|Kxl…1ol%ˏ):9:@>(t`XS.,0=_݃e!KK/6G_ӿWgG_ (ʚBZu/g7tnVƫ l*xikzE{YA?뢔F+Xru(Tő_˖:7Fϵ-*7DEq"HO"߈V`l+)nVr)ر|\UȉPT[wMB8ZtWuBeD;9J|)Ͻe ^&F|eͼ`~3WbwF>6ˤĹصpWD^0ŢDN9J[>8wv0fK]Xzs,L~f ̀v؁%*X/ ZwRZ G'꠳ԳUU ll{}M9Բ'.AJB*B'NsF)c38>@`pfHF@/..BǶl>S,]UhgҦ7vs.&":1˔<2lŵˬe=R k`|=jx 6tueV<Fxn3!CXڧF@;Qoo#MayN(Ю!UAFaI#yqd3u(*cPy A|XN&ϧr^$ !301.^bTpI$-CRZ]87 2A6(@6`VD{d+ WߣtK zMMB e@#'N *{/nlvDBB'H0!ˌBɮ],s1Cmԫs8=$īx3 ⵓ;xB\5EBh'# L J|;▴e›6Hk&$Fif4nEc%n Եu)! 0 ߜ9<V!@Hj LNj~Z+$cD($XKD2@"?a~"K0bcY@5 L 2q@KSdxu._Q߰DbS^,Z@7H_:yXϥYhj]Es7S8 ї,~q"ӳddLS?gE0saes@!ÄF;Ea4Y4Jx#~V˼"j*RF7)NnaH#'Q:h]; [!9$…5V?gXьUc23bwޖTb [Xa4=;\TXԹGS|DQJ*,n<|J|R\{ylϛ"g`Sك vjO~S›:V1T#SO]܄D׹ [$ض}$2Ni70 A{d.AdCKUOG"X'+c7I%'\,KV B}1O*jPmH-5TR@DK:CzVF" XXXN# 9f:oEXbNmuA~Yo+6H߿f,;6'SMF[lWtYg/óɺM+i&d-ϒT M -Ť"!rHAQ0Q`~1;0eĶ?}ʹA""o&:|cYe =2s({3qp;ʀg|Nx^asB)MM;y 6z>;𧅩>Jܙ޲6}8%zu$hrxG폹|i{LdNMTVniΎ>r@Ca ,};jqOVt;]K4Qlc纂ԈF$~C,i[X#`̒UrQ7͠RK5Rg$fͥCVgު5?1 i;DmcgӂMzJO )<9bU/Rӷ2ivuGb@+g'~h#`xS4B-b)&nnQ1AC/`yl[,)G#P|[^}F^<(bҼRQ5jawIYq#z{u5n܇@.їFv\uz^| LۦƏ!`W?WBC K&K8;,,}>%ieJ`1UR\u`W8ha "nݯˋصs=NP$wB½/K*I|+P(X"V|ݐ<<=徖=ݽ_Cju}W%o6_nR߻}L9/g_C_b/-bendstream endobj 133 0 obj << /Filter /FlateDecode /Length 641 >> stream x]n@D{}@$>,n\$E- Y.)R _ܥvo2jn9k{|\y cw:ϷϦ6mӷigk.h˽4o/MsNk=}}\kSp|^:Rf쇹UA=zUP kTXUYx!\ԁTԑUև=,ʠrSTBx*P l/*aPIUƪXUP)XΠ:+`>/R(T(/R(T(SUP'VA=MFH i4A! &H#i4 @h4BMFH i4A U0aL`\ V Te4rظFa2r9l\FN#iu1;.f' |qکyhCA`2 A!! d0 z/F{pBP!R*F{pQ#=8Cc=/$ הo7M&\SI߄k7pM&})ߤo5M| הo7M6i:#͉7¯}?׶޴[j7&x^ۿ ulCvѬOendstream endobj 134 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7754 >> stream xywXTrĜw+ bE" 3̚zCw@@{5X"ĒX7_~ߞ^oxp朽wk25Uv~'sq2\[ A&BW}#o7`6 =w>ȱ/%6x.b=i„Ƒ3]­^o[#wZvqtqw^;{%vkG#@Q~8xIe92uUĎnv;y;x[ljm&M2ߴ3fΚ=Q[Yq5RkaZj65>:j$@S j#KmR"j@ލPI[ѹ ^Xڤhy s_ _3tM|E42i{9, dߤ/Nbt,piҏp~zi9n/0s뤨Y-J{JY?A'nE{Z7#^^h,13r32Nۜ6vp* 8t.@4Up r{vX n *T6N/G6E =F8Z`V{ tm{ NH5ѠRGBLn{cx2ގ]4<Fӟ!)b9hGW Z-ؾ|#vsl:)4BO0CV˝oeEffuIF8| 3${}2խ9.50(f9VsƅpA j!D X{^E9CK7r׉d8ԬB|fN[D 2"J9YD dj{py!lۀBD Dk#`C`> 6"\ =̩0א>P]!ۊ r^܉6vSri6I3d4=1ךx;b pfꇈF=~}ezt5BEh: rCV۬Q61Y-;]~=MZDSe>(,"4`)S!GfS DkS|?qOKGs ɁH~~m Eivߤk@ᔪXdKtE9 T}=:LTaCׇwUl#;El<>UkoCU3<%Y[/EY]@LMEi"vT=Eh4T`U d:M1?ؼ(r9rԂQ1U#9>{i.c+ ԉ>N L.K1hR2pJE\BVQ$5ݖ{WJk_E3 ^=]N8{7UR,# 1;U..4t>*%u@+ a#DTPnԕim(V4Zҏ2w b69\oMu<(B_kN$^I;)x2qdBF-RR?'9$@*0G+J28d m|ܗBP=jhSD֣L(cl뗹xQv$s}0U|9ݠɾŕEJp#?SF|=ʂ^5&u壓8tL'գzt~~L#,-KLW9ɱ=}mmPN\~zb 7&%q у@z3zmcL)N} tX.#0Bd?ULJ|FUvdB6gH)B eeqee}5>%HaIҢ5I@LB$ᕂP Sdw͛ d M[b3L7BxJ6ٯ!rXvɜ= %RvQh') 6mqf6 e5ts\:z/ T lmPCI0jJ~ 䤘 8S2*rTHjP/uY1lSqd,*I!oL麗2:}r9.I&Ѥ$/qcp2o%E%FtzTμrzO Pi=6H.RJ# -ѸiS`f.v\[QY]TRTU-?] ̱;&IO+} N +4ҕsה*#V'Ĭz6?ҊfοCBkؕ{G%h)8u[TzCqHvޯJ xKHWI ,Ņ4b ZK3c wq >t} 6 9ڂUׄFg߾c#j;W^&fK3b"$W͕%>d93K K2M)w:@kV}G[Hv۲vM. OՕRB??T?t5uf$CIXbX%陔 T{-TB L[H]֊4ĻncFwX7XA7\i5Xvy4ܓmqruĮiA.4:3p*]vn3#P:[2j |c4/":Lz/EHps;3GV$Sκ@;͋#?^UA8UrRX%BSd%ʫlУ${CyN /8hhduOo!?gŁh<<hSTRbʒ=_kS/|$Z3PTF([{+ P%c˟)I$x[+qvuӢn> TI5$5&2)HKn.*F헤/4h ȡO&"lIq]N!>FMp V}*i/ q("m/dHN'A?;zt, W,X7Wl;>_Jëb>D.#EĦɲm-t!wefYhFC}uZ۲#ȩ萴j~f5w3+p ϣk >GMاF%|URL{NMRRX*Yyq \4+ZN c>Fm4zBb2d)q44껊V;Z6`^ 1ڎǐyq9^)؅xZ1h2 "?<>{4t4bM.C'@W|/Dmm}ču?~09>w𭿘n"wC ѣ*c )/)HC.eܡ2eehMnZG ckw9]9ꜝV/IVKPoOlWD[C;ej)+,ioVի#ʤ {R|ZA)dDdqx J wf (RWH˲VÈ)2i!vXiԇO:LT͌egtN ";A\AGt޼y+ -qd >QyfH8c]Iu늟߾;<_3w~]rӠnQ!. ~>\Gۅ8,^< 爠 rt,M *p@|>-HﳈT -S6Iy!͞>ϔѽD[{Ud*wgP@Y%\Gn_УYՂO/q,h^,7KV8Mk/Fuxƶ4N-yv眈'D*6qiDF8}f+N^JܓX^^̢M K=[{ZyYՠJe׸h՚t@RwJC">C&Ҏ%}>/#7y i5-~ꊤ SJ򠊩 / ٛ/?mCL1ջzef_W-2y[Wgn npݜ@xP=Qcm=vCF눻W ;o,s/F &OEӖ@&g DH`iDX:Uv8MH-^m۶Iv%n 줪4FF=҈R 3B)x>`i TZ#MHIqGmm6.@f4=eUj2]Ct/JAwtwiÏtn5EϢ(Bۖu9"2ڴq0q@RTi4%H>8G(;j[ً.H^0'θLi[h< X5fΓ/XY2k24,XHQ~TlSn#;a>nA0ehe@= 9e:!rR/7z4ees9r Lb"5Ds|EP y4jWxR+4y.D!X`?TEo}Z$K̋/^L_sLxEdBxFT+7c PB4koO;հ'Z@!slT$D5ĸEkibh+ M*CkWҝZ;% . +)/ں 37T JxqQxQxL&Wp'WƢޙِcqf{_tŕUaqr9JNV0RեfFˤ'$fm˷/4P]D'hjEB~;!Iw=g.'ͅ0?ebnMjކ;̌1%Qc|XS<<2\8]z̬:^<2J~0Q9LF).Mjd6JsNV2c'rކ|o\Ὁ2fMM!DR BEo~gc .7).*1ai ^*z M@&ŽG쏃>23!TJӍy|`L)94g*{Id/idVrB?!@y+'{+o-WuO|8vnwDWs8+DτNM^$ݲSJP''B*Qq, {KFA/SZ>!/;iː~%g S G[iJÎoi惊66.8I\h 2A{z^"仙cE&ƴM:d3]:mN{-} [Ũڲ=ӃCh)%Z>)Sl7 KRo[Jf ;&h/}# !RᐐѦpP5#]';pJڟݩv|Vʶ+(/L*eK%SFy3b F>}+uh>'|]XF|F6ԕ&Z᝸p*il,ɻ(٭ߠZ?I~HY-#Gl;v1b'K7n i2m8Q"ߩ\aOy`Ofy3pl8 fяR 7$NTa lJJ=/?w]QaXa#l6%in," oB{Cr yaYrsnC.Q"l'MV^X -`p(;A홌)ey^DVNiRq[ AHyPs ;ֲ42k+̓Ig'e3>\őˎm X7F2_. ;ݎ-]=P\rb 3.z#3z_XmiAr;&.n#6Bf^gy,`Rҿ{:$oAZ1ܖ^됙-38` \ g#ɀ<0y"-ї;Lrӝ ~3~Q}`4lï1,gޱlBG Y&!ڰX4X_R¹$!).++ٺF,DNqⲿdIDRu%+6s'7EhXlԿufFIT C_q20AUdXx'2kXnޙN'0`+l;;C:д4XNs BK63w#?:t|J#9 YM$*w_Xt"}=9={C1k4 ={V4k4iZ65-g/@/mendstream endobj 135 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 332 >> stream xcd`ab`dd N+64 JM/I, f!Cß^ N.[u0wM{( ̌E% Fƺ@R!RIO+19;8;S!1/EKWO/(>1%LW}xÌ~u_Qo}ZyRwVߍؾZcwo.*g|Waq6EtᏀ9^v&KHH<g7Y=@DSyx\^{endstream endobj 136 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4098 >> stream x xSONA(4SAP8U&(lB6KZ$mIMlM=M}Fu8_:wfDBh[!;ӂ< a9`A NfL!ۤ6KHf HCѕH#K uY0ѧrн*-`*3PZxF %檠n<ч&Ƿ˔=@Z$ϕ)5U`Y,;UzÑASˍ2~=aқ+(Pu'Ջ~{@;wud.v"V !wflo}Q:q =9ί݁hCr}[vn2=3 O]gyuz!xRe#ےyjh֫.fy#;9ZcYPkW8[p5[033^ ( V\gisq 4;]W&mrfY]!ѵS $JSӘG%e+7- TZQ/TmہdmC% ҧ- }Jl65J5FgtVx|2tYf whϴ ~}*yUh6$u0DTIǗkp_2 f:糶)ڝm.+uXl'ءj*H[U`EXFP q /'1(ԃ#y(Q:qZCHV׮}ӡ򀭷A8dU-9-5ydw]&.5q&F_\Y)$TZ`xT`T%Ts¥@>ͻ"@{2cmGޠRYo G+^^:42-ÇOקY. ti=ȠT;Jށ=٨pQѪh5HOW~LN\OR_sPn4_C Xp3KTg7)Z':[k:Duy` 5 &P:8r t4nVfA ֎~l18ٚ\fƳb=H Zǟ&:pmFӚ`E ʕY~^. w8q%WCytw(ya6;O?Cku% |>c,أ+邸eD>:wľ&>q@]o w{_]:gO?s 3ߩ ):j*0wDю-oRZG-D;ȇ/AOD1/Eskpb[o2 ;lxգ˵W7.3LKdȞR!Yg5[ dw`_sP7VLpw> (q:] exܨӢ΢ChNijq(% ݖ&=TBXtb\MLo`YsoNO9췚]Pb=Ac~&W|^7/pف zoH'0SQ觼ltT1J_+Z/<МfI%y6Y7wxk7W9eQ9U!v6*mRe:i$F(!Æ+Avt[ ()-+oك1ћu~7{tV]F4H_rACJz;Gz>нgĶCOҍr;\a{=݉C4 v \aVb&tQxjØua%A_Fbػ&;C( Q Z7jf#5O2 U1@FM*d_xx w9lC<֚ƶ}@s>lJ=;/OF0/J\2Z`6kԲJL,:m0ALASMV=$cy=-M#]ko_άg:4Ww 'jH;tR+#KF$0C ƔS*2T;M\2:AYcsWgQћ Ԁ HXxgG>;&jrnܮq{@ހ3č[lTۅ S*PZ0;]Vޘ3C7Pݛr(M,-݋1,yiry-VvښMG\-Kb6o_M] vC\Zi '/'(6?&YIVhѽ̥[l,$nI5%ƭq|s5κwG.fſ}vSZ ޽bh  # « GR/d'Q6"rh.59(:M^" IYM]nnF2PR%/,ft}Ӈ2;1kyuU=4/<'~O[R^SInX0)9>0k*k]V٥HgmdIdv{ϒC+96ҒT[| mGSbO+o((Qu\Wm( ;Mz(!AFFE8|{Uٹ9[h[7dVScв{Zn GW@DdJgdz놳>;M\2R "Ɩpd Ҷ[ќ>ϼΠغ_-l}m>/HDW(Zàݷ\CL&􆅉y[V9rNi C+wDN:5;_՟V(O Vai :|]LU/Dp*9s_񣯺;jEuNF.͜0f7ށc[l,+刊k%mp(N|o 9֧c" =T)]ai,%F#xR(?pwcK묾6 AW&78÷q[wʥ%5xض[ۜ#`ێ AR&5\JW%(A:s?$itG^^Rhsh4cS]Y)/hqC`\"D|ę} |}v{|*z0GST+m &<*AqEr|2ON+UU:>ՉJl` 6݁(jZqYA{^S&m޼kjLY*G?=uSo;z;AVendstream endobj 137 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 294 >> stream xcd`ab`dd M34 JM/I,f!Cܬ N.[u0w'=A{,(fFBʢ#c]] iTध_^竧_TSHJHISOSIP v Vp p \E̜}+W:ccecs֭3gn.<{޴ Vq]b ^3ϒ-}{'Mjfendstream endobj 138 0 obj << /Filter /FlateDecode /Length 4617 >> stream x[Ko$I8R_0]T3wb3nn?<___̪zس,]⋈ E\"-~yooP.bWeB./em}UV@ۋz,WJ8\{BQ~[_.e7wyϳ֖NJ[ Vʠ++*&ʚȲ&E](w4 z#}6WRW r%-F=j_xn)k%ES{[6TnUf$Õs8X tcٝ-pIOyÐz (HNDq.g+JRiCKU.iߧ :aR1cH83G*A O vXBe,QZT~qKZunn?q{mGR`Jee= {)&) >K@`dժ!:ŹhUy2E0/SQ*;)@%`9Oy8| >7luv0`U%~olp |tB/(6 BCe RC_Ӷu+שc8 j0(  HTW4Fl'YOx4%*:}w5CXOn0y>[z+eNn{=~6EcZdbn}3Ӕխ-_J]ExȴtdN Έm38jtl \ވw>wko5(lU[*JBGKPdu蚘QtUωoΗh% PFKT``¨VJ8di`'a\'mGCJ%|G{hΧ} @oC:D~s6gDv)LAk)^i{rIG\R* Jn{xf^u6a| vuPjH͐*$2˱I:}]6}i3BB+51r%a'A_*y Jh waCKʁ yv`yIёŭ-jD"PL҂}w;%XU l*5Ss.kы'fHCz+n.8͸s ddIAC~z(_7Y>( w^N(#J!l*f3!pv\ PF:0`0h6  ȉ5mEL4LE[IYQ Fԯ4UbN3% )d]=7OY1qwA;% 7{6e%tǀ:RNw| )MZd6-eBMܹ0iY M=mʑs\sAS}VuG湻:4>IhrVlP?Ith퍏 ҩ99Lh ";]÷id! -3ly>..V`q'"8*DKU\6yrX * K`@RGFOdI5bFtQ8aCSSUWD˞H1 YzoSIcDBw&! BtE DIef1 TdGIZCA=]^w(I#nX۴.ˁp|?&i$E3KŶ&F'M +2*2g']JHaTZƸ0sQ3 ܨ:ZQ/ԅeÊsK;(P,mkFx } YUc-!@N}Hv1`*-Fן WZ\5 >ul9KQ>rFw+zjWoEE)#W8 b>~̅*zɂcL &n"*c(M$"B?;/)(L.{Al` 0K+iIX1ԂgZJ0xCM)]}ְ~]̈ K}(JdžX|LjȈRUobo!Z)6Xb <1-ƾ.ѧD/%$;L$?UJa}iR>JLѵN9 ЮN{[*S_[z޿{S_+7m »Rl)4F^ҕ|a cvy/_X*@-)(rB}Lg= aZA%^CA _VDA Rq{h2H"}/hㅰgRO|%Ȥs>M4C13Uô>mFS&qD= h:,g^ѕ>7| RNiRDlP'-OiQ|au:Y6Fg}.} pQߌ$ TR`` PX'BkMZX >bps FF})]ɓ_%S3 Iob!xFfH~ &hk.i\b1ԁ}&ŏ͈ZTЂ [eJ;S(MZG퐁,WUdk-1%r|񦙩m'GdYP/'yRc{Z0ymP1i84F DHF42cKCl _sPChM!KG.|K8WY3sh`8}4X&w/*g*M*'lLvP 0=˿LSBg7s lM$,{?v--3=viRoV*gZYCWZ‹j!d%g;k^s`@[ge8n=]hozRyׇ93)`G`s8~(PE. /\R@vN<2B} 5=ߊCBqa) x:GlҜzmKTq'KF*LD0nMB[O6I~Lܯq%;,1#y#`ߠ7RJW)&|/+$& 7 =J "c73Na]\ Ҭ{?BAH1>M̗.Q frx]ԧ.%u=ut' >N(+ 6-YŽ@84 'gZf?1p+?? cW馿"IDf}Z\p)^L-Mϗ]\Oendstream endobj 139 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2772 >> stream xV PWA)b;m}9FkE J EB^O6 !OQַZZ[85zOzDڙ{g:s> Z&"+3Q)N͘NDH&Nz?s<}$"Hb1&ˆiRbJ ‰Y*b6CÈxȑr~ipo*x+y>(~y57 nϭp1D9<-A fEkqK;hyf=AT5Rٿ(4+PR$N@kĈ X{fG5k/1J-ֈ)=ӝ hGh`;lgXh$рF@9*PQ̸fHdǎG*Y:ʺOq@̞`O(^N!iǜ%h7L\/s=%l`xe=wS<?zҕya!, )2U[o!ÍMJ2:tKΐe-ʎ(m5;4VF9ZhޅATggܒӔ %ؑ g']UWW `1f7o;рBU?FN/krY +--shLsЖ㷎s=c8A2%ŚdSqz. (JμQ3Sm(S` ZBѥ /To̪r՗w;%_Z)1ys!@XPS ZaL;S*?'+λQ;M!Q KyOOOR[ B™:unne& -m* v?^HjI&X.{dg (ŴEiq1q'' wYǜ`Vo<ÈDA)͆(Wn=wۀ=[@ ҽ4JJ/@WM&T:LʲR9 ^w0W?zqnJzN 1v2j,芐}<󏞯k| h gSDq(b06$4Ik@KNuJM*Bw/w=j>{w ń֍so; ${RbF5:íq_7~tCsIlŊp*ur[J脺n+d{f +RZ\aTi5V:flem;@܍8 jD#Zyt.ˣ>e^)X%1t|1_qvh+mTQScAC&4K+ds ]g$sn-pq_zZAO_-aǸe8]y⹛WGjp෡-j7UPW#ҦC3¤Yv;v-B+AդrVek k%cN]4w*J G,bڎ֧ a?y6= x9+*d zb`h0>[iw0`3uE"Xkma[E]rs-OK_9O_` ΋+u; ;Zi~F#?qі)Nh$5M MdYZ$65( G`0FC9_X1[L 8endstream endobj 140 0 obj << /Filter /FlateDecode /Length 201 >> stream x] <o06%K/zAc`P atߟ|@CԟgYh8KM8K2(| JZo8[GQ.:>?%=@ÚʵȌ &^(:swլ^ 0JQX%i ij!YR$m*`̝x4,)ay> stream xkLSgi9hfrI%Ȗ,qy0.ZE.H mi[JRZ@i %8lnKl1[}Yx\q`22}y?<%yqE_=TV&Jh%gdKU66nd_C8B.`jD9H½ts馜?_/A]>Tl@(zŴGjP˚Z)*bd]L$*F!#%RT\VLV٢ܦRRə&RDV7ɚ}U򚊪7Ϲ HR-is#Und"B#zYh9;g.(<7x) G "2_p_}ك˫jft%#M[p ̞ڃZ#Y?v vIY0{?}~?‡&Z:r1yn- q@pSWCص~\I^V˼b:E8>+a'WLía< zsҧ/X_f?ȮL*FŢZUk?7`Yʁ\CqgsQ )pvn,.^M+0hD]0Scdbrl_]nlN/n*꽐p#?ދᐵϨ1{qôr$\fƁw3DX2) }C$,c6u&u޸|m'?&>؝,"f^FM/LQ!n~@b~mĝ>X0k S.;՗3efƌ+{+.^$:mqc*9#upH~X"n(M\? a8s؜bXQ#ű,5ǦN,<:N8N2锽":tuoK{YYZ\U> lf--i}1*>A =hznIFO>Ujx/)RTB`&!v2 t @x%*k0kGc' !C.^5)RQ*St:J`Ju! \X| ׫UK@(?+|KrflӮ`W0z[>ͽ%^5,z *:"6o7pYǟ0qV!=QO-\X4ytvO4-zmfW]]uPqOp!v!AwFSendstream endobj 142 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 487 >> stream xuOoAgKWZ6(0G=@POԪ1!m Y-4+E9]C5$Y<-f7K[%=|! Nz)x* XU7Y:+NNs'`vj漘}L:͞2q \n OR]L$.b_FZ$!2⫏P2;etN|WH(UΠ[29O\)j[|,p_/O);ED,kU (Jɹzr&ɲ"5DYY'+n$S1uB(ܱ)}sch',+u?ݠS5f[RdٓJ mt/^Ij}3"2OmX0jM A4 7ϣ<{WpӘ}C%n_%9n w ccendstream endobj 143 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 625 >> stream x]_HSqͻ64Ҽ>TC& Yij19UyL9A7e݇ -LB w-s|9Ҧ!m G_u J>&j(JZ QNuUᙖe0`qҼi(:]\ZRrbQ)6 .軎V|e>׉y'nhM6;]lj߿/=}!2#1(]}i% {i*@z%PA#$!'bl[ew1u1x/b3:W̺'xgX>%nε]Hmn/Z}7U-+hR@ 4>rs9|ՓC#knP+G{|7[dQudsIK7|a|0_hÞ܉Hvǩd&"rn # z \Hs6*Tb?!'%S@n Ft"xՔPQ*@#jGB$̒YӅ#)м\#~fz2eF&ki"U&,X`* l~ endstream endobj 144 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 729 >> stream xcd`ab`dd M̳ JM/I, f!CGOsVY~'YyyXt&={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻g```1426a`bfae`z!*ck3 ;0tzr`阾A~e=rIa:Y˺v]g*{ZG\Fۖ;QawvЁ/|{%.Gwwfnnlߥ͞u왒';;߂ryl 6\jFyr+[nse'\y cTY$C ↲W3);sR>G}೸Ï<.: (+Xڧ-^jgm=ton7ЁכU\kssJ:+8jtϑvkoA߂.ia!dȭ_h!% u>~g.{9X_藯1n!FGeu]]r/If vr%YlUt)a똶AߓؾOWS'/`[u[%${yL;Y&N0a"/1cendstream endobj 145 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4826 >> stream xXXڞ̎#dh,Q$hD(* ".,mۡޛ{,)+FM}1<"g3s术gE% 7n$ .Z'"]H. K7)oy[i"=o1.JS$#]- Q||/\dr]n~@anki 3w4wdi("7JxzK]vossr6_yw,±1EQKCBeaQ^>N~A{Xp%-]>\j;vϧj+D9S.6j;,]jʕZCQkuzʞZB9P&ʑL)eHQ,5i1eBRftޤxJBMt(]CJZJBLiQ*QF&bk_-fF 5NO/l:yՓ72%fn kfz[S>b4[_h@JP(~Qʘ=%tp2ûA,' Uzt  )<6>%tE P)q;m>x fGy絪-'!;)+ Ur`h ka-˹?[hE&kMwgn감' `UO8`"Ī׷vS X}Drb@JNo`Y5z+M~P):F!uй Z狢-NZ,0 ~7N6Kp8VP>+I\ba|Go{j=?!O@*1PtV;7(6WixA^[&41(2J2Od%U9e|Ŭ6]ߝ5R|1 60jPvd4))1Ѕf $XEu$h"@UJLz ;ߞWwQZrj-XBI'}p_G}V$|xhz*αczyvO@N=~jFj2JQ vk ,# )x,a$UVG絳錖 3K}Q hbDf3lzkH.{ϋ=LeÜ&.ы'委Eנ2ԋIGe4:RMrBbݓ Rx il+QqNN]nEN9*A̗H]& gĵ~(<óց gOok [P8T0ly>2}ӁCG~Ya qJP?lEB !pggf X'YBdžR P +9Aͤ^EӯD)&9ӎ{~wdZEo#_ 0RMRaQu&^j7:O >J Rmm~}& sBg$ Smi(3.1mPx!?pOx*Pd!T ɕ`v+Z`^.cL1oLF~i@l:6>RMDDŽI 2? e"dxædf3\Z7+jd<{"$Z~ȣ)0)͗n|\wT6)xk Fi1IYQ|Z| b6#(Y[ׄ;3>l4 @rEqC$?NBߐbڿ@~B%l6x4_[xG)[j՚ͷ}.#섮}y *s!EJ<ع-Y8Oע^7as ۋ y̯+\&d%o3cC¯UCS.q>@1}8ofNMd6 ꟡}:Ϟƪa(OGׂ_T^z%C1k@ (ܖguڽ^ڿR.aETbLrD򭐕$C͖p0qo*Aw3h(s+ORo4W^}_^宪#tP Cge)YRtuT'Ǖ2{k~>x6@w<2Gm2 ( 9ڀ꠶Cam뾭 fܲ5>7J1:cȐfB FDH mm mEIzC`܎/hqڑb}sjWoW iR(!767'"-:2<":g?Yާ<;5Gx[.)۹yᏺHw`;Lvaf9^/bLq{:AY'[AjD3*՚cX7U&&1-zt_cO('E"uA=|!i? @Aqa mGVRLe=X>}8։پcg5VD;8N,ݿL/SCٚSzq ju$d$e*Q[]%P'Jr& RJ>q^n[9[LE%]]H\/J-:2 ܢzP 5% :٩6A~9HOwMF(TQ]PTY^w/U TlJHT JnGHn k`9 ;`߱19Ri=3pזrxYt`.V=so@o]u>\̻-,<<}j;׭.SQZlG ig2OjmBs_~{qz2q8\j쾣Ӫ(1~(B.qQġTC5mF?{K`ZWKvœ<\G'#hpզS}2s=p]_- [=Y`/6lS~} |[klųNV*?>qTM2f_~ATY`V$TŠqBS|6X9w>JF>9UiRԅʢjdBpiʯ8mNV+1[OGRb/-@E^k-^P̹ɥ j:kƻ_'OֶՆ 3/N,Gȥ՚6b3x|{$ŧ )"3ˤ"9/BUmY0yP`xc~FyVStY7~ln  Y>+zGp@)IE2+IFL&$;aEĖdJ *Rxc 06)%2)Q@ds^ ":c? kLx%5(?N%96J2sa)ƺ7W ==6!klL:Ǧ`v3Dp+9~ރӟ?ur \SN(ʑUIYQyeQ V|MKP?Oα 1u=$ "ӨxE4$BS[RPi >ʃl{lQwI{Y-ϻ{kL.*FL]yMd\aH2˙`1e?Bn&kjQ752c̤P/d4ˎx&|{(a&ȐRau),/:*]^GE7 *Q zsrjs^>7ּendstream endobj 146 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2463 >> stream xVkTSWr E +JN Z S Ą!C JŖj5WؙUGiuڙ5kΝu1'HΚ䜽;{;NjYXYbVESe /yҋ[ D fF?j ~>=f#L6 ߐg*S!!K-"a=҈`id *7#]$ FUd3]@%ݓ(KSqۤ7Jn|o|d(Q<;G795]8tɊSF*Dmbxj APH*fRK͡QөT ک{^Gý?I9/ WLЌic/P6pw;=WdS@10wG^u-=a~ٵWA 2Cf8ފGDKh'tw*\/Z-d{5|uxXrX%Nvpڢk AWF_< ^#,PJE}+ `ֈ+a%lsu}{ӫ9TxaF=tp WpE fF{; d cgT**~d˰eT0#;h@␾V2kja񫑫%vQ1;[QݥK{pCB3e|5#/t;}?#d͖tIʓ{R6O4E" Dpja vZiu@G@~0"+o\wnp_zA z桂ApHss.?-6XW~m@r}֊t z4W;Ij`7M[.{ 1ڠzp(.\ %}(@dn>0(Edbս_g m! VךL-Nu8&Ӯ«XfBխѝd>9ǰU%)HJ?EƼ eb!9X J%Q6`{~ zK" ڝDJtΕ 6^q}[{$ Bސ֨ho0]! ?^~_<̓?/9x6JRzcIAXaʿ1hnf 6#z8/iJ@t @fn,'xD?PIL|p պg0xMd.lr+yS~7tCWAf^CKOK#@&o9i<:bѯol琯geOMJH!d[HB&$OK(Adh UY)pMq*(p']' IQLqq qr 6h te@2d ~8 }Fgc oKg&@LuYNUIW)+ EE}U_isqNdyDZHyy!l4z0N-dApfYyJ8DW@iMۇsKtc6a+J FA91[onйQ'h;Ҹimvx_M(wyע.i5}mjgEhz&GejɁ,J,&F}|s(`buĚO _7'F%W*TˬFhR]dx~!DoTWVR"dgu zaqfXl~~S:'(<endstream endobj 147 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1064 >> stream xeRmL[e}o/@Pru^ X`d2Ad26>0V>,Pd(H>XaJYDufdfɦ̱%&y7yINsC!/(JJZ"Ra(.+@ғB kI5 j9e-b @4E唼l*-.9.D+"ԂB|X*TR#"& ሡH0 Y\!;sOF7#=`消]ɏ||趼gziQP07AqH|e =L&@ZEbIqN)΍9)q49<^ f W^9HkϔNW}|h0[ 0;Ʈ)2LZ ++WK;3wVA)'qU;---^j`>?9ȫğ(ʜq`wznT;k?\gbuAkqYi$ +'Rl%Z2XαUʓןB)Kexp))cYpsFsFJqp`䭔uOiF) R>LWp}~S_{3~Ĉ:Ʃ*b2!}U_| AѼpuKm{qu釅d~xw$sm~|᧳<ğ=[n8I}N=nLC-̓Яn10#zɜ_X6>t6H]b:i@ۉF|p8Oqz"&6G%A\h$4Qn`bף^wa_VcMb3mmVh =O$@o7ʟje[;ݿ~._bE/:h}"/ٹ$!,͘j/)IJ f 2j7,oL `'j3)yWGwWVa7}G:l6[G&^TGE.{NBKCendstream endobj 148 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 716 >> stream x]]HSqgG]9Wyv."(?56E,;åb5IF~hҴ:}&( ʋL+‚#آ^x}xal2]AS'<`ʅuN)".fvbPa:*25T*ʨ;ɒ29ԔVQJRcԒّdU +HUh $UN4LWS}E+cbRd-x1/Zr2.$n_ӎ{N8꫚Q#)$)# 1rE Y&G8j:o"yNzF)Hxx-_&2vDF_\7ȤETo]#|yylvMf^۟:l.+:o2N2Mendstream endobj 149 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3584 >> stream x Tw'2#"(cooPQBE`@H "Gw8*H}XmuJض֭[Cvtgpas~w !ƬYQ-1L(*7gsu!!?l:e:Gp wFcP6 [e _El2R>g֬3g!>^(Er|T4fZ/wf"=$,B*wWo޴|&w64#|7A1>8e|B⪤diHjaᲈȀ(y Y:b@l$6fb Il% —N,# XI"5Z]bD! p[($ȳT Emml-vREAe1#3Fwt,Gq.{NӝQG:'l^ZŽ?%@PP Yq,)lx Jn槨ܩUWNi(ӞP,JOE?|~Ge1|ou_8OLuF4=] MAbxǛۿN˻2^ԧWKpj &h%գ/%t_h劙 ?Z] 'o>k_Nb[<]E;4-Ԁ6 NL{W#|A8Oj} RPLz;Tw~,?rBȉyH Aع3Y @jJ8gўNhKg>hKUY/%෰h =ne69Eu\h(xC˜+$f1gd fܛ4ǵ(4u&noS QsB3u֘T:HcɽUj骫|cIYA%Sm…t $͢5?*zzɅ}F/)6K2JxXŠh OAkv^dO5$_"n9v * gg )p %_rm۹z$',t7PE l Bx$kJ[%\٪/ØXQvB DgȬ,dgrQ:t:!>7YWM>?lP@Cumy,$C&G&ops737CwC (#P-I/R:7՛Or*pS5 79GS ⿣G3UVb\.m/S1$39&+_aXG⋊Rd28] _ SKP{*5otvTFf\ +Cn,]B)ZM{/43Y1t⎄9+MKw|?FƊ }ej3p dº:(vc<~;"btҺAl".(΃ςÎ-qQ!-a m鵠 [0˪+l<9owC0CtTs]f`]r MA2L\y[T2 je:՚X4gtUOnJ[S󃺦-S*iAt|xA%z7ۗ?ƽZ47 )RUٛ$jͺSv^l$%C Wl6b?^~|.?v;?U83܍S,qr$n6}IS DI ٩|UW>9Pb_撱,nl>V%RCڟYVEE \{eӢ5zኚBiu&,S j ^R&Io]+DH2tn!V]'iT4橎*j -$6 L  B,qtϙOigρN&5R0.gXр CU)5feL9}4&BEuP0s?w9v|y=l #cGc' ΎEydv7Q#z2g(>v4//^'o/׋(HzS =5elJ*:XUmfTiDkiDٍ_DZ.c .{C\ΆdLlr)P3|Uh4 T~ L ڲo7So`63FF}1̔ϮV/lRUȅTJUR_^Y\TbPN|8!::>>:!dc5-|ca(NFv?d>ѮITk'f FU.c7MdvEd3hUMɉPb 0jPxr{XWܐgj3x4E'wnpcl\d4dJ\Iu$4 n8ɫ]*f@[:Cn]B1djWg- {5D.8LJ .)M/L2 kh QSCRh]ؒQh<۷&Dt [\ڽ?Q]:~Iڌ7 Q^)ձLx^B.k.,ۇ/>D7Ǜ0ʘ_e%l|ʱGb~yW6:X<=jE; VZ'|MfPoa-\ċf*!|S]G,v酚GWZ8\I* fx0W(O-F^RluIVd֮~d27Sd:ËJ EYȍbM͌a`7㣭I1_{ ;J`>Ccb{ŔD㑌m@@p٠+~d0,4f69endstream endobj 150 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2304 >> stream x}V TSg~!XDMF^EZe\:.c+]udh$lAPreeIDĶZ9L]:Huj=:ZqFmsI;swrw{_$%HF,_BΞCs{l(pH ^l|1>/t̂ Z|G >ox(i8Z7J$땻k3wRӦL>y2P VmQk)xvM",xEbVOEtjNBT۠\0bbqĪ5Vˤ(*@095m{z\D|]LwOmZEPzjZDM¨eoJj5@j IyQԻ5ASJ\v4D1ɣ ]I_f̲(F͜y;d@@*G'Ńr["mHOcQ[28rP4BgiAǸw۠f5x߆ާٶuԤs8E-V~?ޙY+]$Ez(- ,c]zF=Lt::+WYYJDfl!Dzhy}YS"7sGe`}9:L״ZK7*](Tٺ 0C<:/z?}$1Ik\]<0CGhlL<c"9dDHP;H[TW\`H4Q&HbT+h^G ,!ȐPE#7|ZiFf=rCok]=+$tI(&o'iPΡn`Ŗqiʰ-;͵J`nJX9E? &0lnOx/dž[{jC%TH3-sVmyv (hD4&14" k[.rcoژHpY_衇ogus xG mHrJ:'4MŒGRw/a T'cDheeĥD,\X 33$] cIcI?G@O޷!(H[_? WĖP 4ݶy({-!XX~L N*EZ@z Mڵڵt-3M΅11{f]br,ܫ_O h5+E7EsgZSrTBj@VEA)qR uPPoӛ -0X P@XV}]^Tbѐ?pbͯ"Rs  k KKsXlĀ|Put@GEY(jK7.PQޮ,O|H6OT`ʏ\*K0w( ]9r@hX> stream x}K6:%gr(@qftuRy雇yZg-LR1_n[,QQG#bXRƂ֫Vl㨕tܾfp=8fg671hU@>WƂ<7O_vV$8'ޤp8Ł`@S;^[AETAk.WWAdT˄\4)[)a r:) nRPR&ft]B&/Al&u2BPlyTO? W~R]MЬ&5vFE)dY=eə ce2fU> Pzc6x1fͲ˥μ󗽨)q Tjnp){Hh׮2lV[Nfeڳc~u sO\ GMv7}(=%~$"\;xQ0`:T,!pV,K@krHL> stream xkLUK!;u:qȸˀBƥJ&Ea1535L04R\&BHRL_rP QeP)/AqV9V a{npFGP{Ž_IO?UQY_,.Q%ARqA E\u UEe\}JYVP[#>_^_BICGB^ G9!!rF,ڇ\+rChQj@Tu2ZZ5Zm J7VT:U̞Ies3䪁p ]OzJZ9C r}䛐95/(И4ƴUb"z&мčS\YÛ#f2e~p\iQbݼ3&e;on c0"Ky+bQ`: => vT3;q"sE8U^;yRIZO>%Q}-U-팞*`WMd(s/fao EWLtsϮ1}\v^U yʩ&9<.P` Œ(DpSے[v%4T#N@#EyTneVt>tQ̬x%9PǛ֤VܬHeM@N<  D!vCI= ^/~6ݱi G+N &ڣ= <-hӪ2fx'pOh8Hp$dDxԊy|¸xn0K9!MdR U /C&HAz뚅S9 M"p#;Z@ck&d&K,09ҝZy?VP8%@^TlvMO͉CkxJ49Ur$iץˢr>yJgݺ`Y-9^Ӻ̈́C|wEcwe!~DL̇>Q;pjʼnDihoc"u;wcHՔޠGboKF#endstream endobj 153 0 obj << /Filter /FlateDecode /Length 3672 >> stream x[Ksʑlx {IʮR9H>`EJ5Aj!қͯO03!n\.[9˦&?E|Z|Xt!KMJ0_ݾZ2Z @YUlv5cn$^>W^0ESv?5RW/H릑7oV?}$ӚZ+Ek&j-[2B+M* +M๑UǬ/Xꆉ_w(ƨOQmv1}_=ի5Bw Y 0$6FTק?eK? +Em~K~_J)0qOFUߞ>ű?dU a,nCYY>5hX0d{.fs!Զ4zt7W݊UKx p ߊ5=#DUoݞt:vsӕ]8\5"ƹ^)K!AE |Fh-utWZہO wUH/)OQ5dEO*xFnOɿp ~$xhw#ω:{T.zW[`ۻv (Νi>pT8gt¢Nn&x>8 $]/ lR(Qw_f~ۧ:]piE,M'iԜRSUzO՜]D` qs0(Ibò},Rghv0ҕtA-=(h+/' e^{ wU0O+P&ۋKG~ h@x@\[j\H{OgB$Qج46݄U4/nX_3N+CUjEz 6"nΔ.4Lٿx 2)U5+|CL7p4`fT ̄RbBA1Rրe %.e0~!ity{0)fz8"ۋ1`ߎüu]ؓ .d;l j+(DMWymQ3aC\f 0 N]fP-*f_P+> O^3u`x|܇UDr;@}%m lݪ cU^E ֪0H&4Fn5 Iʞ}9W"W .dO (BjI)ĮuVSWS[ ̤CrF.)C' j!Muq6 R#Ԅ븰T_Qwg{:[FEh@ޮڭE,㮺RB=^C*aɜi` ck) wv8(@VUoE-n4j<.:`c .;*|}#yHRܦ :jV) vXlfm❽-6nr4VQ=COr*Ws3L* *j YWM ?%vosF͋RC7 (Et}@y8\I!a>.ǎT)}bάᒢc8]5ځ_93ړ6cg[X$}EW7]{w q$EPns0L<0vg6|te#id=L8bέKS@. pH HbRi؜tP\e.BUҕoh˧>1 7%z<渜 7q6m`ks7겿\XfJk*lLℝyۋmIXׇ'Wj&>a+_769/O(_RQsCGql*n8ԑ:vs0|T|\"J$%Ljbt6hG4x*:a*a!\vS5zHAh4!J{7OR Gc(Ȕii y3H6w ul_^,0n Na4oR%Qlb i1;$J_ Tn!!K H=TІJE*h)zOxrEH"%㍍>vj_JLlN48-,]"N3O)|λ,Wc }78x'Ǿ߾`  +W6.3O0dMkГO/j'Q0EXhiznNB;q+]@e4?V0UK޽O{/Z n(Y=&s䶁4E+?);?AGD5 ̶0 \2nFendstream endobj 154 0 obj << /Filter /FlateDecode /Length 5508 >> stream x\Isuvȓ}Ă;G}BF*] U_- $ eB\_{KYUY߻E5[_|vmg|u7]_p1WzefWۋί>A[uUV@ufJ8|yw|t֢uqv*[;|>?wG< am鄜-)kkqyEիJsUeMd)qяs#JXn6z< l'Skl*6Ū^-e :N֝B ?z|!ܵEF>y7q # Sl3\Ѱ@،F}k &|tq?ϱd>25`zGnJk+ "BH8g 8JhvUH`bEy^ӊmQ@ mI/اo:ŤD*Wsd )<oԮE ._a+7-3:dh|xK{E-&n3vUg[6[zM&҉R(i].oSRiVG A mE r}]n$GXՐkֵP@"OM /mK@hW7b.l쒛sR־ Ƒ.Q=z 1NYu?p;NO Y>)jHHw`J~L0Uhd]]둅Iz$LJ읶y4P\>('zb)m;[(>2ǣypuq?|!A#hRd5eh3dFD 2:Ax>w|`6kWYbh6FifYľCaLg3!;~2%ӉmD&FC2yd Lof]ʩT Vo`BjR{vBh:r=$uod%AʠD= @%(U8ĐWJ f* v,Ny0 tA '' V!t!#gkᄗ +?\"hif !m AfTx|Ƃ*_%.G`K` ʮ]+-~ jY}n6 _Ra91dHZ~Lia2ʼnpyS^Er "8zh#;pGZ80mœ!iT6U ufv/ShKHіCĭlNtP^"f.g%PE;2͖uB,Kz@ꀚ:-I~Zd>ʉbN$x/-ݸ!ݿ<G-k+٧Kr‡ QkסY$#NπȈy6%sY7_`ڟo q)/_\Ēto&J9yrrVPA"KE6,M:l&2 `D 4v?b~%szj^A0pN$1 ¸0by\qܝS5`M(qT paVو:kqT%zӃ{LKڕF f̻BɐVsAJ}r*()(_lᣳq'q(nHLЂw6xPIZ ,bbR@G`tdX(n?ՙ#NP^8?'}*EH#f@ 痭.Mrfz|y=!ۯ M@a;1 ;07kpé7HwqhK#AUxmŌ('71qU.tF-c<\Ʋ$ڞӟm$lkGm߰r2j`EV9=&%%r)ͨU h!l=ø8w,g#2af. <?eaIheY^˟& $V:6qsbu-cV %ՔuSl~(^j_rT7hÉdQ{ 6(C?[xpU=6<~ᐽI> rݴCC7ԯZ-FTː!#V`x F_SaъdJøEd>T~Q F=DDCWY+%B~QwjѯvM0wx6r/Z1ZiAݠrH`$N{gV k)IaM\>jxTIOhehͳ LQ &0be('U#`'N3amb*s6&pE2@7.1 Hr~!. |JIU^w(݄f*J*6%fJ: t[/ ?|~a\e7 x~Ev6lxFNJtCx7"oJ;n"}0V> #`/+Ml5]/T)ئr%w cne]:⒏b* F('fЇ~jadbHh#ozz 1}ֻ5Eq~ӯ5ȗH"ӠO~+ OXc(cE5艩 F/lFh y\Ip#i9R،ܦyFҟa%oZC? 7?\T}-+ھQ ZNh36N(|*]fg+o2.d2`HLzp`~aY 5r%ƙT)l1^@~ǒ +Bã"M*( yt #O)@cn&ѠjazwUDhyO4rHhOhX̨ X!MC<ݶ8HgRsrkZU1:aqrvD8VIϔNTutxey5][x{%4:O>@QŃ\RX0wBqt++iA '5塕T htPB $Z_n txA S b/'@K ԣ{ u܅-pIKUU}uɺ"_4xd&bfc3G%ކ&)ńFx@(@@'CɎ~l-,ʇ_z$GЄJXD_ ը/')`@p=e -Oc-3f -d 64S8$0ޒ'xC N.vTmFl|Ӈ({"FW2>Q|A a*zS`GLzv܃[I1'Lij/-4RZ^ _]:t GJ8 5Pa@cכgs*ߧdrz5EF#cqhJƊ4ŬZi<씝-UA<$ 8Zd\C^rbbN)S~Z[-_\JUyzJn0 UWdҩQXh5]U)K+Uj ``m9Aa*R9\cFgy+m@Z:OcSjB=h#9>uLLc5`G3|Gz`?X׹\E:_DѣL9C`J;c _|n֫GE7u 鱊tN#v$Q}8v><$x^آ.Cء"^8x_"2;{yDF#s\c\נdMe$^ #,i 6h[!DϺ> Z(U%@4z'\;SVfY4t:HI8.B\%} |t&Me|n(JU=ش=cY86g0H0vQpQj&$(p4?Afs׳!,8?E@&)xn:9;L$nxVR"Vos3UJMj4$_/bv,֕2UDN!]]pIh&K hk`KqNTD-r%l2m>Uz0#?/Y:FE /~x|7 V xQ [RaF' άj419G|-s{,Gmu@X> stream xX XS׶>!sD0z,8k:HEQQqdR )YdVd28ЇSkZZo[TR]7jwK>׿cmd!KGEDN8vvTxej*^ɁZc32{氹?;9YyovK/b\5d~AsGlWO4v,ƫgS/  T/=NvT UTkB76WVW=ҕ>bcVdԜ1.,o Z98dyoXxĸ 'M&0pf)ø3_fyYŌflf 3Ye1/Ɠ,`2Edf ͼ ayQ2H5ƚIfeonX-:.Z{XYq9ˮe?p Z64 +{B !S/yq(4,_f`@DOQ'tǰ>԰/\O2{8CTFtF:Q6}Pסl,ATaV>L٧X?@#1MI(p5bmv@9pʜ|Qb[jwPV k2} *򱗆4]w_udnt6 Xz޼? :X'9sV/h*N /u=]y⬲YvIoadGx4Cb~5+`ER௒7~MnC<(s.NA}N6F8ͤ:Va "^C:J9+ .-{Py&!3!ϒrȪT}AT$3)iQśs 8ǡi4sj6&FC'V/)R3w*²; `  ˎRp9/%#}cEseB%P?vaDdRRFt;QFep[(oz۝n;w><ܒ"2tGg;Xd# jC &N󘔒[X.7 [kzMtW+,5z@Jfy3 oO^}V,_$vGOnmQȜ(uчy>(k E60 thE5lyiX'eeir_&g [STTd) Jl9+*Ve"s{w*Lp*9`vE=}" 4ZH[.$pl󞨈1t٬R b -=yYF,0Atű/gTK!iޡXZ~T@VNn)ι%Y[Vg5HRs<K2*9 g̾@|mڔ沔ҝ9 ʀ4U%ɤD\Om?vHů NEyTRVk>dg 8 !o8[ٕ/^gL Ȫ 0M.8#kK[ `NtZ4lki>W:qe'#,蠺_O mXCa~Ζ\uVJOx|GPTX9]Ṙ{*8 w9UC U$҇en&t@BFF1}%p32"rӧX'2-E!kC"sLuE̙c#ct|p̍c rd]{)ʎSh+B(vEzHe4& );.qs|&:SyC *##a7Ds;˛C؜km,y8'#K~}/؏<)u8O :HdI=LR#ɔ:ڼB)) hܖo3]4o_lgb"PIg3Y}OT.%Sz3-QԘnyY-"[X*c3ՒX^|t-XES2cQW]Ξ,3X~k d( fU9-([J}k-`x<NR,ݐ˘*l[PO09Q?U@u]'UуAGO|_?D5]$Yajl)o*k8R!rȧ\c%_3=Cl"tTJ !zhC$V:q;Q7xELdI}{Ӿ&oYwۮZyڗ?n8Fp2Ӗ6T m!'IR$ #fin۟B$d/ MFC;)y'M +}Y߀l Qw?ُs8#KʪVxJڕ+ޚ^mUBUDS|I޾evͯF UaDFH&6S1 t ˜ѵ| p%B求P>ui@`+Յ:rꎱTA\aL l 5/݁*/ẝjlpY=%3WFd!FIZ m onk04ԜѯZer133@(,_]; y6PD Qi. kTvA3dg71~(*(̿j q/lؔ,"6卿?TIʗJ_Q/Og~f^Ȁy}Ru}WT]\nX?z!X8mCz[({T,5'du}ט<#v<_Okuv >bxu\Eۧ.'U_F愁GDw]tkʶ-[µZsxKm@hKq2܃6r)ama¬DnFД)\oQiX\emts>\2a2@Kٝ7e:]bV`~邶O3x*qwe}Slr9g9ZDda]vJo1[[P@#w&FjFEBw%k9"Q>ִ:\{DeR\ w""ׇiUB 8c!5R ۙZë0Y*1`=qmZO0JS?#/m[LV8]hi[m̎7Dt.Q 2T=B->) (g3l%w޽C,_ *S]iui6R}:qĢ 6A\8oi+z;g7撄𕪀cˀ$bCFT*R)?cWeDnD.oGOBn6*i0EO>n> stream xcd`ab`dd N+64uIf!CO/VY~'YyyX}-=\{@fFʢ#c]] iTध_^竧_TSHJHISOSIP v Vp Cq`R} }'}?}{CgU|./.SqoNz߹qr[؄7yŞ>~nSg>;3wߛgO^-ymԆ-w| 2wn9.p{n&Nnt 6endstream endobj 157 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 922 >> stream xuQkLe~~J;YJ~f6edqfjTaeaҵ#^Fu*qem@ e·cL9?'ysDQTڛflk+,vm)hLno /fh,~V Tp*u)txl&7Wje th:Nmt:Ցmn3YFUYjJ`šu_ BHd4[m":22$N숄ȋ~jUA=D=18> 5 I4Rn>pX ɏ$Q6=^qa6ˑ%:-pe!z3̾?bxJC V3;M MdyjdH\HR ;/=F>bDŽg3w!]ŰX;~p vK ? Iߧ'Ӂ\4C1س7b.(#h`V3{TQSkcsmЕARʋ_=q[0{q'٥:Sxנr]YDʾ%nNϤ1ˤ97-fp y{niۨ'2Œ{T5by.e7OQ5y~eiis<>ox&q>2qx;+!0/wIନ^r7hjIZl[ƨF||t~\>| bxR3oK.k8ž@ qyHTLVqS@%-7F!A)H/G!q<w*, v>?͈L[8> stream xU{LSwo^+R+^Dܜn .FQy(nY @AZ`pJ(J(˜#>1:rd&$q+|(L6vvqVdxi~)MI!^Do(~w]|"56&zblʙA%y`Tu_f]JSl<ޜI1O8cԼ)d{](`vh=Ha6U9)P A!pXrqӈޟo԰aR䣾ܹ..m4;D>+k.R-*gGx..F`iLj<6R.[Х깇E4Eӏ; ՟mq-Zq]6`:`_;nr蹬4` ֝|_zQV33!wRPWV_mfW%4qH9h{L^ᰈyЊ8J԰o$/jSei j D-]10;)9~ν!N)]8UGаZ| xA;ym2-(rDWۙ&{%wqݺ(>W ) [<?>O9ı`_܀ tdj)i!;= Q65#*5lj EĬ79!wmDږgL,mCuU]\ysTg^g+;;N_`޵$~s{J_{x?q^r?BCQF!t/s!tQL hw5t?4){{2k&lg2MGznnN"!d> /Filter /FlateDecode /Height 173 /Subtype /Image /Width 149 /Length 229 >> stream x!@ ^Yذ&,`FYtzbaչF }QzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգQzT=UGգmǮf`> /Filter /FlateDecode /Height 173 /SMask 159 0 R /Subtype /Image /Width 149 /Length 9269 >> stream x]w|Tڞ-ހ@RirU " H BT\PQ@Pz i@Z!@Hol7fvfl#9ٙ9ywޡ?fP4MFEQoΝ]fu?X\YYIƌ7n檏Pswwɩ/^޽)cT5Ѐ9guȆ fff^B\=gUǬR: .]l2SX 9991SEd߿3\b/njj?H$pd:qU޽{Z2Y4q]vᘦNF*L͐ 6;19995&ȑ#Ç'cfJE E?B4QSkf؅p ΠGNׯJ4"0grmvB=&ZxY hj}P9X/m,~w}gn0]bG,wkh6 sVhlĜN>czuy>?sښNL&v|GA㏴Μ`&[luYԳS3 J6/-V<=$ZU EQE֎ PBCCcDHH`gHupt8f…V37Oߏzم&6W ś~D>p@.7?TTM4tCg\]]sss00  hBS Hj~viK"k͝;w;)0+޾[=`y-Eana{Oz/Oa>RVVfcSY+N8Ot~FH[rVv*jUgLÍ5Xa_aq%8k&) lUNX+;𗝝= $ڥ4%xVZљ.6AӲ"3x3XhHJQ{&=C+ֺhiTUE _>ewOy6% /H4'~cM4]vN =ݬo5@JǬya/i\kZ<3*PRb "##/^cqX։.Ԝv`uK ͋nᴌ]{'@Ws{tA ^bؠn />[c _  E#( V&.e2Kq8 sC-8}kgy bXS͜Zm`eT-X=1X|(UѼ̂ 5w0o@/~ Wu !!`&E(+[#U5y\Z~2Ɵ ;4.2aFIjSb %`Q&Boko?9aL@RA55)w=ԷSkMO<z/U,K3,ۻ#[__;XI9eɰe$_qDs~nʁK'_JFv=`sq RDG70 _!!!gO9ء "XE >YϾ݋K@&g>~Yq`482ES{PBpZ)fPOSph&d`yPO-]%UaA1% tK?Fg9e@j[a(x} Uy1X|o9o=5 >';'C&M@aXDpw#6A@?LL 635 vOe% ?oiZVTw䑜iOEv1D)'6+V@Q9%`[*C ])`G5ް ң3|}}as.lXA@Hl}A$@B!p]  6`ݜ UP-vjzT*R*3E0-a0^]Vt L@DXTSM6, wI6s?-lVYuQ*c~‚[Љ 0ޟ: aXԒ NEG^`cplYd}J i hKob(PCa6XAޖC '`1"1XU-^}73bb0O6o޼9#=wj9DA7?+n`6=wٰ!sF7i) =kg5?wf7FƼ0%{ev'A%?E|qXi6gJoFِGsL$"$*', |||pm˰O_b.#~JeVzҙ ĬC FI"3#D"6/ȽMbRi7kЌe-Wc#9 *7نx [R2O,pRDZΗ뫮]g2(cZ9AİbfVnN/5ղ$MNwPsS'j]?,:WנL ^:Vޝ c \E|gWYܹgG p@HeŜ[X8X;U _ BF'0meG:ZQ d&p;Vշ~A˶4: &o9a&FA]F3x ݟ:ԇk8GBLֵN B,Gc;8#NX/%!W$w΁c9d2+_aS!lO*|M}O.eLZݒOMX(iy` ź :q'O/Q8>!>ft&[v#OQ7Cx\xɘ7ntQm'|"zj,[ءJS!XySvNI+I+췃#l3esb:aKaKb$wsm'dc8t`ͫwnTXQy))ƼU\E+6ٕ2/4Ww{e&KsifHT\в"Cʗ4Ҍ0U%M 5TCK_ ACZ|5kեgKaKzTW`m.M5Ui :+Ba)f͏H G-1"@ l/~@[gzA_Pzğ2<*֖6(Ț5=8F1<#B75 )r4nX:/9d" zL~v=̫9@_GR6q5lz43:{3daDM{W<@> ~JFg΄`otT^? vC%|7}7n9?tS)j%m[NG.GN&mJG4?8/Ty&`3]b}!)ퟫA`*9 wx NRY̐"@ tO+:P.5?Ł!j k%zhsCqT](ڔjG7 $[G+`/d[hC1m5&=gu8@;rG[0.6-\/M|{]}iHlʫЅN ~SOP^iľqɔȮ܆sE*R]#cp`!\zjjzcN [=K*_0*lN!rI jt?zVZ؃dK;eۻ/JP<k\):~qPVNk(zR7 -+w$"|# < =-L 7%8uNju OpZ 4s0iV$v~Mv%Gc\?zA2XXAj;"QiUe 9 O;Qw-Oەtϗ9~{1 N%N!bmA Z|ëas=)qcamֲNg7,ն\+=<)Rr@~A|1RQ 4bj {-,:zHq{ݞ]Ea57 VY+MU}88Y8Tv83yMꀭ&ᠦJvפRU״~7͈ ~<X"-2kGxGR&`:"hU85lR(?/>yR) FP|+gn;v!ѐ~ͨ ]Xۆl둛; 7R#ƴ; 5l (CN3UH`7?dMn,#`mqdp(*͏t~OW#AQʙ=A/EjQFԛe9ͅA;",yOMk3e%Mr5FNNj>bN  :}6fVZ1H6B`LdxهiK,9jzmMp+| j)6Q#BESo~8}*֧6a~R^`pC[}og~J3_P X/:{LoX`v2մY$_o4s_h;rIud%Y_^9ʊ1Yv =7?_pٔMiFayTp6+6~ȋOkIX hfI :@Jd4;XvQ@' VlrXa|lHj-ǎt O\;H ё~ N/D˪oľ#'m N ׎p#iMc<4t̢vx i򤉛m+X̼\BOi4H8ۙ!bVj\FW毃7mTFT7,W=?k`+' LjHeOyJSl>!G@Zd5Ƈ/qg1/f\ia9>򥏾ӌ5P.P'-|*5sf?qsmrȋZ%"7P լ 55K@;~(\S[K`e4c$߫*5TOkOx0![ <ꧥ Cs) 2Z+O{U0,?RL]g[mprZ*l4%W2 j=Ir0ϩon5`Gt:d!-~=6&yh\pjG€I:{=2jL]H67GV(H0'-c> ӿẑ$Ȏh W 0XZ9G&VbCy/jJ8zyW~Hþ 7'Kuiah*ԁ`bӺu͓hnX0+ԗjN 'e0^ x2˰w%C, ɯp~Kp9}afC 5d(q[lJ8W fUzp/zn5${yS@[Q?:ǫϢ Vm *֥NuٹhѢH,ѾEٶ\fLU\Z}y_3"]Pɱ/w_jNm.kaa{.'Ksᔞ!@Mqh-ٛ{6㶱#.ď YF=s6H_OdŊ!m<)k h6J5emϭ F?5j)Wwivi_P 3JN4gkM|kCV!@M+iuÏ5J C UhB=i] љ?TԩSw܉k BH у }CH$`a?é~|@^^{Io;GoqaQrJR a˖-Ï]}tG2DʲW[@'?!&&&G#X#8>u&Gjjj<4A$''Gܰwz|n, 6B5/_ddd4jԈ}ii)~ k'#bX*5=ڵkҤI r_o@2kt04h[:; mpv`LӰֶ\upzeQ $I`wL/^ W֩`jkecctVĖ<מ%cLܞf/ٿ3gҝmf:8.۟d+k4o\B Nu2Z> WHOOWL1 ̟, Hr)!ZAݳgsΙfS b̙7oƏ"݂R]aN,!c`re:?MI ^dLRR5#,? pgIM7pm1N~'`+u)Sq9rCȘ6BS~Tp?:;;yX(pJNVm#tg?VI9O>M\zK.F/XwX4dC.jMQQQF*pX .$c6=U+ I-!a.o[cX1`!~?R@0;TJQBs>hTRwdLQQ ذ&&@v"VP\t%K,G ~~~dLsC[)DF+`=zp/54?.cccmn8tB |Sz!U4 ? @'s*5lX7ȟ_r2C'iA8/F:dF u떵LujQG8vؐ!CȘ0ϩ}|Ѭ*YƋK \s"^&qREC#g̘e&u?OuMendstream endobj 161 0 obj << /Filter /FlateDecode /Length 175 >> stream x]1 EwN Vj)bI  `""d Nҡ÷lu.SHA SI5i#LqV=HX7Dew5{+ǖL:XҐZIy3v߼ԂDl*DvHD`yC.ZD0Yendstream endobj 162 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 840 >> stream xm]L[ewغn.@sNƈA1 me+rҏ5}zF[i8& DlFcX^c2Ŗx\{! ^lc9`sM !*+ iŇGJ*Ёڊ3[*PA-Žql<qs7[\6yͪat.N4.soa{.0& s_ Mas3t\c`Z gm-'oB5C$Ch?*)"0]EÂ@%wŇR 6k0uӹkQ)M[CvtK nhy)>\"b4wQyA( + sku wYI5C\`fq%OSr 0;-{77Fs˴3B<38szH%UIN߿N6C_aRLa\n~'=rcdE6@O}zL_}#~vW7w'mXܜ0O?F3M|"KOoCxmRY|0I~snNT9Pljqd25m^&WkdQ1ZbDFAaVj6(y`޸?.Txylο GUWrDh*dt&: GŸB |endstream endobj 163 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 537 >> stream xcd`ab`dd M3 JM/I, f!C럺 N.[;yyXh,={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻g```64e`bf!85|7t9mJ`W鞱F.ݹrު)Kv_=NE.!P@xP;԰ߟgxwS?0X_4ѳժ?wk=9jʕ[u_.oߢfZ-Y1wºrxa[+'Woߍss$g^qw~a҂l5݅g b{*%ݵrjKr˺g` (WS'/`u[%${uOoO_O爛yx6n?w*/endstream endobj 164 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 388 >> stream xcd`ab`ddM,p(I+34 JM/I,f!C_ͯnVY~'Y|<<,&{ #cxAcs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kt)Dqinnb YZQR} ~5~nfUY,ͭz7[8N/:A?ؾuj۟c :ֿ r0wscWgwdÔr?/5N2Ծ\XBy8y3o <<'O3|Bendstream endobj 165 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1051 >> stream x[LZBievd6K.m,:uu[qjmQʼ0@@E."x!f^vݲdMjIeْ&KǝѤ]e/{3V`0r?mHT"|/Z$VKʧB fT}yHNy֯6kPڗ)Y%~ a2kɰA JWjP2곍L1f@]Jcl5'ZS,}&%Xd ^7p.8'x5E77n4S= @;`ސL>,͟{IpRq:7E: h)zFy&ʼn^$dN8~~nI@N眹x~Xԛ p?E YwyX8~YwR)*J>>C橙=b23v`7 ;;knٽ ggNOf9~" `endstream endobj 166 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 711 >> stream xm[LRqG,Xy8e%Ym6Z^ er!D9^ se[mmj^Zͷͨ^t{C= r+v׊%2\!9혩Y h@ v`eʅbtslV%PZ\#mh1@K$ Vͦbl^!txM~ } R$ P]ߊ=6Ak)$VS7_j00U̩&R [aܥyо([Zh|D9 I&Kh;5]]{5H6ZC6\l%K? ܚ٤Qzav*J̈́y215?-+ec'<~K]t` a\xSp.f%G-Z> stream xcd`ab`ddM,M) JM/I,If!Cg N.[gu0w@{ ̌E% Fƺ@R!RIO+19;8;S!1/EKWO/(ݕ @EVi w2]'Ve3\f{<_~ -ߴm'Nn9.p{n}&L3gy_ϔ'20p1endstream endobj 168 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 371 >> stream xcd`ab`ddd v541 ~H3a![OVY~'YyyXV"@{.,FҪ.ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UP=ZZZ\_ZXSWhR߲ ~g;ODO4{Ǵ) mMrY,23$fvusL2eڌ |f@Sju:ۻ%뛛.twlo-b>s, e`~endstream endobj 169 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 342 >> stream xcd`ab`dd M34uI f!CDzj N.[yyX~)=J{8fF<ʢ#c]] iTध_^竧_TSHJHISOSIP v Vp Cuh } &mٶ+gqwFĶi}g{M#zo&|7cwv^;{n/O0{ٶq}gb ^3yҴk<<[wN;eR_~^endstream endobj 170 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 457 >> stream xcd`ab`ddM,,IL64uIf!CVY~'Y|<<,~ }=Y1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C58U15|N|ch^Cb=o?kάnokXؽ`%S޲;gav˜]j, N/+M/J n㨝=eZ rݽ̿pnY ګK +tԶUtH.YΕg韱Sod;,[p͜K7F欈o(h<}2^m=7n9.zn==}'9gU{&N6%endstream endobj 171 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2771 >> stream x{PSwoU)XӭvWmζ*D @ޯ;!`!ŭTc3vw~a3݋tnOfrNr~|،0`<%~`oξ5+7Ƅ~=ZRٓ㓻as׽(6}`oD2!rg $2ǘ vp@X. K9k׮\I-[ٜW$99ͫWq!\_S\pR9onKlؖ5yŪ-xc@(*)-q xE{19,ۊ%aX a:l=boboa&l %`Oѓf`^f7,+N UxlDD̹3E3j֢Y<=ݏŢΨo&> r˭,36=یeרkn-,NfhF*pE=v3$!`nsۡ2ihop4X QUzTi2%HNvv.CuJR/#GmvxTh%*+9= JU:B$^=;p?]z]{}; JaB--UdMþL'#QA ckZ}+1u3ρ=ȊLR))A8NZa%BqT? iPSQ˺֖qj-<?e՚|` U a58\{/:ꄪ8/9ؿㇽ̈́bwMzaz. hPϝ0MF:ϐ޻gu8i_\x灍`ɲѨTi_L' ^ꮋ'C"cJpWpԍ$|kK?Beԝq7\jYH\hTgT*J)e@R􆄥&խGyЫS ]?>MʛC^;( h^]:}P@!mV|>NSqc!Epu@^G׮3C&z߈|5!["*5 5ee[S:[{l`2gEiinOiax_с:]zm$5BFE9EF27-#B pi@#>QR8ZTҟOl6Z /ߴu8<Ј7(K%_M\!:BXYTjO«NU9q7#^ һmAFAI~Oȑ(./ &s駘4S{FՎCu~wihXigK(g! n3XX훟}"Q\ }Az*l`sM}EܩtAWP W 4賨0zڑen.Vڪ}W2Vp@ʅ]xG^w0* Jݖ `5Db{n&c={+4{m҄lk\G`v%k`LԖe4{|}݃}CdkU"K|>w_zxiY\"yDUG(zI~"(z%ld cKzz;ZwWßBq!~IC ͮ^WWVgV$O.j=AC;p;Hv6^Ɉ)T'=gRxNHb^/I6B޺Z/sͺWJMT ݂j(B띨=:=#E9 "Fekt"#;M-4͵&Sb/)endstream endobj 172 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 479 >> stream xcd`ab`dd M̳ JM/I, f!CwʟM N.[yyX.={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k;g```5f`cbaa`eddQ- Rww}j~+%CV.g^~تlvf_[$ߝ͑>Dfue簭{ҽv@h,m4~[_ 6fW}Zo} +~omvҲZߛ~ob2KuϖUwW,\н`M72Jp=oąlrqpvp/==,[2yR yxC(endstream endobj 173 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 298 >> stream xcd`ab`ddM,M) JM/I,If!Cg% N.[yyX|_ =_{LfFjʢ#c]] iTध_^竧_TSHJHISOSIP v Vp JTQF ^Ȣ} f]X]-[mYwY?\н@q ?oZȶks=g7޾i='NY;wƴ zxx{oendstream endobj 174 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 354 >> stream xcd`ab`dd N+64O,,M f!CgO/VY~'Y|<<,+={3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻g``` b`0f`bddI?SUe/>0K|o﷾3{i V[Cs/~7b"Dk\~sU> w5.| pB\OXBBy8yAoMټ~e`'֋endstream endobj 175 0 obj << /Filter /FlateDecode /Length 285 >> stream xuQMO0 W䆃T4ߜiHrb:(ekn$Y'2R|ӖD*Bӻ@I qDP'4 /ȕN"KxmװJJ؏ZZ=r3sݐ54`/LSu"Fg̑I%rUz£NGW Z.te5  lk]Y sQv{_^:[Q úp}톛6`/9l2endstream endobj 176 0 obj << /Type /XRef /Length 200 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 177 /ID [<4e3ac2b6bf93dd9dd27870b9ee700515>] >> stream xcb&F~0 $8Jҕ/|fkXXP_)(2d>"喂He R nB [D2 H6#Xi0i "MA$/ W $#"[tWA$` RUl,XS1VY6Y,~Ln`ٖ`rH ? endstream endobj startxref 98904 %%EOF magic/inst/CITATION0000644000176200001440000000116313434564446013462 0ustar liggesuserscitHeader("To cite in publications use:") citEntry(entry = "Article", title = { paste("Recreational mathematics with R: introducing the 'magic' package.") }, author = personList( person(given = c("Robin", "K. S."), family = "Hankin", email="hankin.robin@gmail.com")), journal = "R News", year = "2005", month = "May", volume = "5", issue = "1", textVersion = { paste("R. K. S. Hankin", "2005.", "Recreational mathematics with R: introducing the 'magic' package", "R News", "5(1)" ) })