magic/ 0000755 0001762 0000144 00000000000 14200603137 011326 5 ustar ligges users magic/NAMESPACE 0000644 0001762 0000144 00000000463 14010105251 012541 0 ustar ligges users exportPattern("^[[: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.md 0000644 0001762 0000144 00000003360 14177342723 012625 0 ustar ligges users Manipulation of high-dimensional arrays in R with the magic package
================
[](https://CRAN.R-project.org/package=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/ 0000755 0001762 0000144 00000000000 14010105251 012230 5 ustar ligges users magic/data/perfectcube6.rda 0000644 0001762 0000144 00000001071 14200425030 015275 0 ustar ligges users ]jai-*.\pQDDDD٦3&M)"Rz)^^W ~BUjlEhf'_gJSLte«/y|M$v},>~ =z]>\?ПoS~ JW> <¦zF 7wW=+_ӿ~&}2w
̏'Go;5r{s7 c{4sX}9qV_E_að}#{&4Cy {>7)v{ޫKg
Bo]:6g oؽ e
tW~#
_
;=:cG9 a/$k}傗wؑ__Ч>0/NnYa/]z%'jN SLWöwO?;Uܾ!gIVw/G2WpY~~BCN=W>~{ .q.N>K& magic/data/magiccubes.rda 0000644 0001762 0000144 00000000407 14200425030 015024 0 ustar ligges users BZh91AY&SY sLLUU @>
@ FF=AC 2 "Hh 4d F6H)YR-
- OFŐ
i<؞ *D`X%Vf4rHV`a˝ќt`u`v[.}jtLaX4ӅGm5 n
.. "څVBЌN0펓\*
{*G2+# %T Uc :^G_L+"(Hih magic/data/cube2.rda 0000644 0001762 0000144 00000000346 14200425030 013724 0 ustar ligges users ]Kk@Fob*.\pQjflc ʵڅ qb109sp!Ϭ2"&sOҖacr} > c!%8uzK<'yW ~} 8R| 9§ sp_`/guaHCG^t>7zܻ9!Fg7 L_ magic/data/perfectcube5.rda 0000644 0001762 0000144 00000000564 14200425030 015302 0 ustar ligges users ]JPFoZT\pBDDDDMtmIDVp!R|$@5XHO76|. !4g4e孮ɿła:yM mYfƪG3e6RQ?1tsa ˜ׄ P!'xMO~=ǰN>Usy CgoW#?{;CM.=G5"L x̞kw>>}s<[xΗW`@}̾]"o!s}!q |[%/ɯ= oM9;q>:ރ
E}oS/]_Ws0I} OK[yg)N magic/data/Ollerenshaw.rda 0000644 0001762 0000144 00000000622 14200425030 015204 0 ustar ligges users ]NPF/Bq .\c1(#EF[(JH Ѕ[ GQx '0ޏMI9)!D\$cqOD_#&b>Bk2_ [ZF F[]FSb n}w!.߃
y50vu
Oa ~xM; >p"\9X'Wx+ח& \.ns=
9' Z:9W/x9M( mrX
W~>SmE+x} _C\U nm x 3RS%1{ 3 ' magic/data/hendricks.rda 0000644 0001762 0000144 00000001731 14200425030 014675 0 ustar ligges users BZh91AY&SY sDDUU @ @ @ @ @ @ @P@
=MԚ ~PީIMCMSj=@4SLFǤʟTSz=Ph0F1h4 ~*TU R$T *RFʏ 2C# @
e$I$I;4p*Y UUB!Bdq4S(QMNSRI$I$I$I$I$I)n:$h fg= 33ə{>. ) 廻̘-Sb
$F1ƜWuYfftT!AZ
A
,IH>I'$x !BF
cIm q)Ӧ
R%)JS 0VjΊ(Ŏ6lwXo;=vڏvݹv MfkjlޘHC I6lJI2@ ^H!ް1^_^ٌi"$=:')DDDDFѹv˦0ΥV"""#,iH,M4QzpAEN9*Ar4MiM4i9swF1yAI"tz `(((((((((((,c ""
(@PP((
D u],U׃-fhI<ρͭj| (c162I/1̓$3Y%)$Ԇ [!~m·c% Y c6YekZ8 ' n>Y!BRS)JS.\E)JRk[B ffffDENV 5oUUUUUUUU͈cZm@ kZTaq0iՖes9s<iH
magic/data/Frankenstein.rda 0000644 0001762 0000144 00000001277 14200425030 015357 0 ustar ligges users BZh91AY&SYT } 8 $0 E4
F=ꪉ4M1244ɦ щ 22ia4db@A`2
!h !$OJ I @& 2bh0b@ ^,gev) Y;n; ¶n6nMa7Ѓ
*#PbYi ҂4g~)> )bqgqS~Ē` ?'h$@ 5@ ' (>H 7H $ CqN-LS2>ϔ O aS
v)6)8ZeZu06N:.2"" @ Q $ QDDDe>h:_.묲,CJ֒YJR%R)DTR¨R(H`+]v$Y*@ D @ D U ojz +R ?[ DJ4Ez\
l Okbhp*x5Aֹ⼂AA @ D @ DAA @ D D E]BBR
magic/man/ 0000755 0001762 0000144 00000000000 14136345461 012114 5 ustar ligges users magic/man/magiccube.2np1.Rd 0000644 0001762 0000144 00000001410 14010105251 015053 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001141 14010105251 015027 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001604 14135463325 014576 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001136 14031301364 014232 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001547 14010105251 013340 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000000731 14031301364 013616 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000000610 14010105251 013756 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002562 14010105251 013666 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000003136 14010105251 015123 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001060 14010105251 013401 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001745 14135463143 014334 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001074 14010105251 015672 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002374 14010105251 013513 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000005152 14010105251 014065 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001241 14010105251 014120 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000006460 14010105251 014571 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000003235 14010105251 015740 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002452 14010105251 014523 0 ustar ligges users \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,
\#N8
}
\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.Rd 0000644 0001762 0000144 00000024236 14010105251 015771 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000000411 14010105251 014731 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002462 14031301364 014051 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002376 14010105251 013451 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002607 14010105251 012773 0 ustar ligges users \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.D y |tʌ:z8b@r>@\ G \}qt@J(8Z&|>_@VyD )#aV<YE|>_ +Mp*|>_QKCj,"SS qvWCIhS,N Dzu>L̺
?9 G) Dũ"LǼ(Lڰ1l_@b3C D 3Lʺ
@r+.l|U'@Dja0 R@O7af݈j-QV
ۤՃM $*olŸ`Ȉ w`gJ dUHQ D9J|JW(<:cCR|P }n W))H2ARlf߃)97܊ 8 ޮ{WZl`@d3P upVΏq^HɐQ5rvV&#"1H(R+^ ʌ&簮>t5I+} l 3 O<s،WGo#>-
"R&&"{0YHf H9y0-fԸ=@}U.DUdEd-"H; ~LȺs Gr)eVѴ
eoBS>ie"dLI,L:Sxv1eEd." 8`1&e]-LTcMٸy L +S0=6ȻD)eڥm#*}ie"H"!ϼs GzHIe 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(LGx 2yFkO
ީ;Woٜ $DmS0=6ȻD "rڶP^ mI):`0 CL01J)|)qy#r v4wN46d"8iW)3G=6l{;m H3 -%8d(cm<ޙ,`@Q$L qf݅4 "-QV
ۄbsOZ0А \2NR ;66f"`0d0x9SK$Ԉ:cCR Lb0IYC&2ɡO e 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յoBYTS vu1h
(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])phog 7GN% <
WpvZP 3ўڰ1 ؽp`0 V Ca@P8??R
=U?ï n9S "$[?ƤaV( ]VJDtOר/3a 9)vs#RC.~
'Iv*%_ҏ:) ?;8a6ŶƗnhm0\]. ŃH(M> 8Dbc8p>?~Vbs'}nwVr*Ad )6 {?= 8 81 [p ~0a9*ooTj!;8j FP}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`X5>i+H^eh A:b 2J0&mp &=(q j
\;a'R5=nOܢ'06"eqG
#ھ) y{ς c:C3`M*̸r``4$d`v2F}q 9n-P0kwȿ ss~p n|\00| /gd]
rɇNǀ`
KuhM]09MS:w A;WbMh6^ʀ7Q3(k[[pǁ[01*\7̿B3h H o#ߩk0"LCe5={*| It8
J
cďqj楆 $Aʅ8
f-2QGa`.5O5di ޱ W.āt 0annʿx=^
ediqDrl4b; {)3֑Ć 5njqlQϦzjeOI51~O Vw4ixLVYJk~<9&.N$Oٿhi}', ZULq@"4M%d'NwZP ]1@rUyFyE#a6.'Z4% d y8@';P _$6 - hH b kI;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) y r'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ܴoqkz쎷^H$
'qvpᠳ?C ho]EN ذVi:,\pOh * t8 |SJ׆ 0bD/bݧLzѳa%4MM׳hJC;bƈ9!?/zLN d` xU}30 |j Nw{h^Ɵg0YwD3rFG̾C@4m`K w/3kEd bch{ׇ>L+ZhQv
ҢWICU m?6? aџJ__ !Lm_4%{%>+dо۬;,hNlZ;{0U O . 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 ZzZ r?zww~, ǯF)3T㣯`jּl3
uFٺ h3\ٹ`|!}7:x ?aÆ
ضmjkk܌vyN BӲCecu? C$*MLz
`ݺu¡CpN:;4zR4 A"4`HJ_o
I`@7 }?Ec=
|l|a
4 p=3 9`9a*))AII^loi L7aDٽJ/>,tN VOv
Xnx/ZhYW)X!"1'=UIgYE X 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 " } c 5|`ZKDx5
O6foBg! @ Gx饗 6m¯~+ CwfvvCCM M 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\@ﴁmw L(~20:i`@$ovnR:&VHfoofvfXfbݺuXj)}/4ͤ&2q\c@$@¶?x衇L|[ްy1 1"-{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`3 8ʟדuDz%a5kD 2dznQ?Psn4BCsʾ7E`` TV؈S$A1Xb# yPdz47\N`` (=ð"?8,Ho `(+Dy悺r
2YkaDM !p&،H ߸̸Y҂ wŊh%:5@PlJP8`m\eUdkC p3 k%T}bc 8pEq dŎ֛}80W{UCza5FZyr^ !p/8 G"Kkk
܍!s\/}+s0 F΅!Dw(ոFYS c 8SyͲs \;ԢBz@Y \;%CAn!NGO> c 8bRܹ>X+pѩvTq`r ꑹz3w P8ܹ` 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 H7N Sf( +1!NU DZZ}D8Z8ehme|he kdb0 a ae=<
v-PIj߸T ͦ5К:UcEs{'se Yr/nW$6ZZ6ڱߎU>:L;Y܊5K2No`ߌz~v ZRZ
lWeZ"UyYqpֿ
ĩYCnk\4i ӌkI#d)YĜK:Qx2Y3H6<.Xy y^$J [ٹ`|U9xȮUnN=L-)n 1 nl< atbb}Ujd]k|IEJ e
{nmĩ,G v k'+IT8Q ;z%YJN&u;c_ d=si̬գOɌkV{@©29saZ- ;ר}ΩG TV*盘 Y E~_k܉LaheieGCi*~볱Q%TI¹N\sY[iHݪkx 1 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 * B d]I D XF:xʺձCN5 ^oqü;( k4V@epp@1o\ V|ff< } CHf+VvKc c\ܹ^JPG dvgd^Z̾5,w(X;܇# I s5CCq+ps] 7.:Ս>c8܁S
` p6+n9l4;PYPP w.8 G lRK2˺fT
. 8\d7s,> 1CYҊk1R<ծY8 d d5kDqa 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˘ɣD tVuN_{@DCc0 r+v"S D`@pvw = r"Epev22 E1Q Y!1Stzy eSz wY \ \G-CW toQ,{m@ DD
:|f_'z"G a(9z@| D
-R"p*FVY; Z RG lb7e+OWԊ;bN e}"`0 G#@
U NO7"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¡-.Zc 0q`SUm'P
zqT`@4 F;< DGy"-T -Pi&w.`@5hew}~8z@$<ώPɮɝ DqWyC=ꝗ; DqĀ ݁;a0 O{A#0 i`@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--c0 12J :G = a0 :puJG) 5;]"Z^xQgg'
?gR
G vn 5εd d+8Zp1!
-z ɱ#$| `L MP&4u3\4 O*baF {3b|k%W.|bLܜŭ_۷r!Z5\
3 D"2Gwk˻NǞ7%L 8p6qmk:zQV =ݑ i
R+^ j$ƭk9@[úd d
~"Y9?y"!&CbqB%:::2W.]P+P0'b0+ Lɹ>_ZEP@ t(44'\8 ޮ{W źa'Yۈʅil]+fDDd[gk& +I`DJ04@yT'TûU@|z!3a J
$ՈT߁+]НpI0'FżI:]RHU_ \5u \ ^9~
#96GbHMPV M] .ԝH@HpvS>PDDC}VW.;Nw@|zax⩘W c2&FDDdF}[E0g w < x9%T#""2CgA?9;?t"""5j!v*cݤ >zYwr3EvS]u+4!TG
DBn(-^s%Ո;e v." ~2 g ?JRHc!ߎbeKd0'ɘ2F̿TI""Hʅ8P9
a0D4 aSw&":/ l!s0x9
RfHڱQ0D!|cBSRr%֊kC
JbTL˽3D/AR}+uP9a0AxQR0w&"Ҡk G_Bi`` lI""rU(\#]{af р; Di f|wrإc0D4 d%eUI5""R_g!}@8d@D
K#FDDj
{e b7& DB/ g\㝉ȕh)GyB4t*ݗ9 L$R1~= >%Պ >껰ke2dL/%O(J-FDDbcxn ]Be2 E3/ŜǑ ?RJ ;?E[OXY,``1;OϽ 3@?QRiۀi \)k1;tWaMϰq% ݓ= l$cȴ1x9F$!FDDڱxv1Be[DBs GrI""Ҧi#*ݑ "baF ;۷rZ ŮH 10<-zc3.P#"b} 1(JF@^yEˑ4QB lix! ďwY9?y !fZׄCGnGm cx)97狑P+"xm?8#Di
HUga [C +Tga0p Y;_P2NP#"r߭
屋q
$L qf݅4I""!o.]s18уԸ.;y
C& !# Lü(L%FD@6=8 .#x' _,ND v4wN4v#`B2F){w&rڶ(\bN .&# 㼂Řu]ZzN LQ1x破x9r&KY7ЁMr 2P !# xg"ghZ7{pY*c^9&-´ܛ㋗P+"}.]0xOܢ'16jDD:zAlixV8d R# ٸnG{ ("F?UBejU.DC6S4 WG0)* rF$ܬkkW枴`0 dM/LGi
̐R ~)z屙'= H79YWbNH˓P X]u `0 d <3N$Ԋșj>@yBTSJyl(&# d&CI#y9GkO
< I'Q $b^r$.<"Ux tǦ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כu T[Ac(,(W~K[jTMSwj`M" E1Y ʴwƬuHt:N1ruUAXjjhKe 2r bU7ikaU4CZg 0dO( rp
PP_KL2o)m֝%<+b ߲*Ei3Z]^.xt.
$
?;?aWL!Kd7U9^ 1DrUA^E&5Zu}I cbcU ڧ5
Ntd/!K r_VcEKWebv&#zK:ӵO!LF#r 9ͪ LwZJdbf. Sm bHD +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|b dzQU=`9S(6oh2b d8^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.Rd 0000644 0001762 0000144 00000001551 14010105251 015273 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001150 14010105251 015110 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001032 14010105251 013652 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002175 14010105251 013146 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001653 14010105251 014036 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001165 14031301364 014313 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000003340 14010105251 013135 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001157 14010105251 014504 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002523 14010105251 014205 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000000641 14010105251 014645 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000000650 14010105251 014025 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000004445 14010105251 013275 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000001527 14010105251 013657 0 ustar ligges users \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.Rd 0000644 0001762 0000144 00000002766 14010105251 013331 0 ustar ligges users \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/DESCRIPTION 0000644 0001762 0000144 00000001647 14200603137 013044 0 ustar ligges users Package: magic
Version: 1.6-0
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-02-08 08:30:16 UTC; rhankin
Author: Robin K. S. Hankin [aut, cre] ()
Repository: CRAN
Date/Publication: 2022-02-09 00:10:07 UTC
magic/build/ 0000755 0001762 0000144 00000000000 14200425027 012425 5 ustar ligges users magic/build/vignette.rds 0000644 0001762 0000144 00000000327 14200425027 014766 0 ustar ligges users mP
0 n( @w]kʴJ-s阝i}ɗ^| U*uR oJuTތr\OoWO.G+熁pES,
{?/_]\xHO[ ؤ _~EANQpTY =i3ҷe(^?[
C1U͈E]F ,8e?&n(8qz(n 5B_Q8T,HzY"| ?P<4]]_Y +f6
!jc5rVOC` 9`$DJ蟽G#خ7([6=# 8'!Pu hN!hC^4$R vTPy[V?!Pd$
#^+d%k/}~˟UhWʷ-~.ʷDG=βl]gVgǨuLrꚦAWWsu2=909>}; Dr)!ʞ*6rAjYvHe-zYc ` kc[O
) X~8yA* j 1y!ˣ1vo ݴ@ IeM,:@)z ZuڣpAZOZr%;5Z:Ww#0 ir5[X@l'#Dn7+b4BF(G}&ӱ@33"ߺl4z>,nozdZF)ΆxWr]$ic\ JϪ?o5sooi1ެ:Q n=958!û2GCKsS%?&J}nȊsDlp\8's΅|&5): 6pMw̔]xYܪi;O oFiLW#b+ӓE@3&g^~rfqMO'ce:ANN) aM_2MB7G*nn?<|`[[~87<93I|e):5TDӏb~a T˧]Bg?6?lrg#ǘ?I`6"X3\؈}Ё"##?GLS M`s1Y3IM|9s9:Wu]Y+*x4XlHvR$i3~jЊ4.3C\}.Kn=QA7mES])H ]L D:D)r4)%b?()-E:iI 4C֢` <щb> 5msM}Zқꛝ9 %σAGUb07y
T=gph'9;0R<՜2 c,H]q$O|0,:$ٜypCITM:0 QCJI5x5X4|p"l?,;, Fl1`1Ƭ=__F˖%!5AC}mVGJEaw9Yļ z$_ s;!}&B~Ѱju!𘪚|)`)hda)m-l #_GR#Z]lWLNQX3l߲aĉ3hܦ)|.ߓ!r`>|~n! uܑql^BQEd Š[zɿ0Cr^N{%W (t2yF D66* 6t(ЯTbX>W SY
-NU+VEe,<@FxЫUr٬ H%}Q=N8P;?:1܌\Zx&D=! 7[ 6ˌA;zo J*qU2k)Gzʷls'Su*-)ۿ%Һ#ExJ/ ;R.w7I\FF('5Ea\
ha#'&3:c]7I.CZ
4]^JC4%f[BEFNDޝE4zqHרe_}' dnpʷ.=6qLp OptnBa o]Dr+omVX1JKj p:˝'ILG> g)^J9)nl [%):!6*}s+9/t 8
}
PMl_p"j 2t3H_qxցJB79w6$3o2жkklʷ0Z zBd V.́R:ō h ? MX#^)!996mmn JyۅV]|.#(nz%CQԒ$M }z%1'#@0/w]u4 \/5:ӾrVD wxMGE7bK&9 J܉8xMGGO4'uM!u5MK6/.7V Y/j__s>' AwyM"p5K_IՒmc^v_H%X[.v)GtWfߦuD?9zW聒kg,,j\Is-'uXIý%( oTZ ܸl!RYx6خG5 q Ӣb"P`C3 L7l=P"5Wl 8R*G߄^5Z 51iI-q!C 3,~"R6\rN r4',AqcZ l~r3|p]MLuqrMRhd\SP5%iuGܒ? murl(91AyŘ2SdpY"ZgDЧsflğ(iV`f@J.U 6C, 4&h lJj.ǂ+ [ vШNldZ0n&Zj]yӳA5!GĠ"G4
My2jnH +j B*KiT3
D,q
Fd9qRkz !uROo {'
M 107bMP)qqL= `Is>ن֔jMهAM\ K E?jqM
ht_ p K]T_Y 5T bEhlblDwDL vC̓%ɁVn QJA_i%nHuubTe .c2ȫoA ]k0gʼ\nQ76y)g?H+g?0X3jo~
G+W
vP(*Iqc9q NH f{|xB)ti~e//</h:F Q-ϭXbm(tؑ s~-NO-HB\d 6Biy:! zGS wOԯ~A""5^^KMaN 8
{JńO-sF:/w*f,nd5
WXvx;_-7
x\[AOiTgrKD" ً(H:{KfK"T_rI(nU2Ұ-6a3?wRP&h_xb[#,noz.:Hr :T䴮 bPAĥSZR* FbZ:r?h]n@NNCTVǵ ^SyYM=RFHQ ƣ7WXHX6`PAU1/|b t͉ .wwr magic/tests/ 0000755 0001762 0000144 00000000000 14010105251 012461 5 ustar ligges users magic/tests/aaa.R 0000644 0001762 0000144 00000022110 14010105251 013322 0 ustar ligges users library(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/ 0000755 0001762 0000144 00000000000 14200425027 013336 5 ustar ligges users magic/vignettes/magic.bib 0000644 0001762 0000144 00000002015 14031301364 015071 0 ustar ligges users @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 ``magic'' package},
journal = {\proglang{R} News},
year = 2005,
volume = 5,
number = 1,
pages = {48--51},
month ={May}
}
magic/vignettes/magic.Rnw 0000644 0001762 0000144 00000034732 14200052116 015112 0 ustar ligges users \documentclass[nojss]{jss}
\usepackage{amssymb}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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}\hfill\includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}}
}
%% need no \usepackage{Sweave.sty}
\begin{document}
\hfill\includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}}
\section{Overview}
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 ``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.md 0000644 0001762 0000144 00000000216 14200067666 012436 0 ustar ligges users # freegroup 1.6-0
- emphasis on high-dimensional arrays rather than magic hypercubes
- sticker now in vignette
- new README
- minor bugfixes
magic/MD5 0000644 0001762 0000144 00000007746 14200603137 011654 0 ustar ligges users c3011ec6c40e2dc740776275e9c74b57 *DESCRIPTION
c42e9e1c41c2cfd43f60eac75b363064 *NAMESPACE
4fe4a791d9b552b96dd265e999a016a7 *NEWS.md
5072acdbe9898fe6c8eec73f163a6692 *R/magic.R
dbdd944505ed5ec37e8cea6f9cbc618d *README.md
a46a358e210aa5b138c5b28f110710bf *build/partial.rdb
917d9c4a6d708992350f833b25c848d8 *build/vignette.rds
f1c0f3d17620ab47d24b62e07ccb9c60 *data/Frankenstein.rda
69dc180ad85b0821d3525d66d16f7d89 *data/Ollerenshaw.rda
1e016788026f0a66ab5f5aa5068e389e *data/cube2.rda
a954877102d9564d4c37edf5b31f49b1 *data/hendricks.rda
2834ba00f09ae163aac392c7107027b0 *data/magiccubes.rda
e6964072598401519f462d238dbe5506 *data/perfectcube5.rda
71226f3cd990d9583bf36483959c8891 *data/perfectcube6.rda
482019b15474422d86f5f43d5f68160a *inst/CITATION
1c12095fdb65d231256aa02463cf0d1a *inst/doc/magic.R
5088617bfe2e42e17245ec12be49e9f3 *inst/doc/magic.Rnw
778dc8d1000ccc5280ef5d551434f8a4 *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
09171004d45c528a235b197d7aa5533a *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
fe95166908c03e14a30089d4523db43a *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
5088617bfe2e42e17245ec12be49e9f3 *vignettes/magic.Rnw
c17d2c04806d5e8efad4766ed992622b *vignettes/magic.bib
magic/inst/ 0000755 0001762 0000144 00000000000 14200425027 012303 5 ustar ligges users magic/inst/magic_stickermaker.R 0000644 0001762 0000144 00000001454 14121236021 016252 0 ustar ligges users ## 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/ 0000755 0001762 0000144 00000000000 14200425027 013050 5 ustar ligges users magic/inst/doc/magic.R 0000644 0001762 0000144 00000003356 14200425027 014262 0 ustar ligges users ### R code from vignette source 'magic.Rnw'
###################################################
### code chunk number 1: magic.Rnw:102-102
###################################################
###################################################
### code chunk number 2: magic.Rnw:103-104
###################################################
require(magic)
###################################################
### code chunk number 3: magic.Rnw:110-111
###################################################
magic(3)
###################################################
### code chunk number 4: magic.Rnw:124-125
###################################################
magicplot(magic.2np1(3))
###################################################
### code chunk number 5: magic.Rnw:177-199
###################################################
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:208-218
###################################################
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.Rnw 0000644 0001762 0000144 00000034732 14200052116 014624 0 ustar ligges users \documentclass[nojss]{jss}
\usepackage{amssymb}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 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}\hfill\includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}}
}
%% need no \usepackage{Sweave.sty}
\begin{document}
\hfill\includegraphics[width=1in]{\Sexpr{system.file("help/figures/magic.png",package="magic")}}
\section{Overview}
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 ``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[[Sܸ~?BoV,fɩ ɩ}0o1@tKbX\j0c[ݭ'
'!$DQDJHB$h!&T$& |GI 2%a, 4BBƠ&"Pn0*D2DF
1"ceDPCc|I2:oM"1E-ԋIq"D JrH҄RҨL/4' a "`:@$c$pȡ0H|10/
FhƄ:ȱ0I L " UA؉[C/0DDA\=se/f&I=8@"0O&7B"H !zIJCwϊh$T?QAǬCotTRMR\/ e$lrE ]0v>dA ;^Lh9lNI^`Zv hם6v>) d4"K ңb22&'hCtϧ#Ix~Bws//ugi=ӓ]BmLώ ߍWy.PBtV7;zog+b1=
`m0!x#NK)tz
)V O4%LSr9Jf`}09Td2E2F?}K'"ހ~# AU MYjiýó_M2aV>Q~+Bee}Lyڃx-K[] `7좸F_L8рak> 7r
hd}CURbp WkP`
H
<$l! xC;KO3
"IZO!pN!,EFMbU|ZE2}`lsh3Eڷ:rrԞ'K}sv<,LM xt6#i H,VbfXf@K"dAz7<9={ p< /#{7ÞfJ` B<㒕 QhnKy3 xDu])5İÖ:@&&[
:3u)]o4+E}|Û MO[/kKD wv;j M Fr EEʰ-ѕ+J[{_0='-Q}4{ DO$ܒ:.yJ:ӻ_ ^4E̾ѤX- !0 |9
iR/ Ђ AEXڐWK/+Um.jEUVm@ v
ÃrGsQмVC)^0 ˆ^,uwAS{P?LvPWIG)˻E."(}o?'KϾԩs֧CQjK F+Y;ބ.Ox$ X୯0\# x@8{hR@Sw3^ԏ& M,b{R1Q@& ;*Yݙfj+OhҀnà^Ub~ T nq%]LQ`\+2|4MB 2I@a4
#o5Q]x Hԫ]i(N£^
O|ۈ#; mRU[~Owi& MOфl6)ѢiSVNƉUXdGlWն]5|Kê7
S+̥\g'?|h\RꜴSHuVa;ҼϙRkKCEXxlBכ74Ȏ&ue텓$xWw=
5)Q\iWqBvpؕW]@kllwSq of>\Zok4~m9GoXl@ ^ ݔ"̻*Ym! t(ng/)/n9
LV|Dx< B`~ L3
bOG4E QԡhH<7I6. + FCeAMb"0 : ܆aOr Y;eS\xD$Q.'3 1gH}Ob߫YJ a ;៦7>
stream
GPL Ghostscript 9.50
Magic squares
2022-02-08T21:30:15+13:00
2022-02-08T21:30:15+13:00
LaTeX with hyperref
Recreational mathematics with R: introducing the magic packageRobin K. S. Hankin
endstream
endobj
64 0 obj
<< /Type /ObjStm /Length 2617 /Filter /FlateDecode /N 61 /First 504 >>
stream
xZisFb>&20QJd\KvQ>d&!k
pұk $.JlEz^ ƙLpˬc2(f=Z2U9 }p+SL s CW <$sI LJ縢\%J*.R \5s
SB;Lɔ:E=D4&`3PPZa !
UIÂf:ςaFpٙ 3U_`@Ă fBH'bh &=n "3R/@
fpq! 4Ep!2 yX3
H xG`5X,Sh@A aA Е! mКn40T[,>I5LX|F(r>,&(ZŪJbLO*ofE~(Muj 9C9 xk3}9i2_Lo1Dkď[AIg,MzNHEcOڮf -=~u?BV~WI-l.k;xI"QxBClًiP@ -ҚӫŌ]Cl)xP2j
)S2 w@5\D P oZj ݭرeybzgɝR;3 #OWsvngHS{fGD^9[nr<)?yzGyqz>Ms g9β"bEz݃χqpJH:[-v0oۜo> E:Erw4X(|V¦闧.bTHEKӫ "wkAcYxLlzz\̎+Ny$
`-1Fci
Pz_{1d7$Y`IrYqd]M{r!מGk]E{~U٫6SʙƳ*^7
%=ۊ*xC+ a4j~P!,
,T;>tekW&B,ݴdF-Ec$] D -ܪ"\ZaBLٓIH
~Jr cxDq?"w[40^cgsbnKUȬraX+IKRDak^PVU#ruSDRv +6=zh]wIm@@5rG5"_YFkGQHS>NVYa
}햝rs>^ωڸUUrP НGdJOZz9}ɪY9+u)c(O5)8~ƯA}Os{W8nn_3jꎶ.
+y5Q<)1=c.,$F({0$K&@\ܕ] _Z,֘e˘ زstkj1mY^rKK oT{R!,e P
{kQjo]y'rRHY<;Zh =dd` -7] 5wx$E! *+jdш'LֺJ[k6l L.^Nץ1c 3MHOٛNf< 7J
9}+yhE6*>FQDܼ&&e$} '# uDܑAD d^(LJV(@?FtRdaV&Π#CdVfp(_P: p#0,6M 3 K=' yчʾfO'D-o@ ;a 7w~5]kso~ !^\ {nl:=)z7X!ȞKcccv\m\]ؗQ]80oNgfm/
Vȁ0nr 3ԢWoN.+ (Vֻܹ3C6R)V>ᣗYiz|6:?wgG>&?~)[C;OHeMEr}
N55RY|d
zYa EȮ"b&4Ʊɳӣ Rآ hfp7 PjnRl.4m; o2h⯺w
o:Z ޏ>pގj{T趫iǠ D}F(CY9Dt hi@NxuC{
j 6 % E;j܁_v]|λ0w# <
c">
stream
xZKsd_|7SK99qoTk֩
DR$b%˿>=34H^Vì,r;grp#,YgLVnoV9j'gEYx7_pgSRݺEYok@CڥY Z{jqfi2R" *Z^) H ĉGFV%?vZ>YfvӖ薕ό VX/Ş]^- tvA& L*9 Q{+eu
aM.]d9x!=d%\
oJ-c1[JzX<;>9O&h
H \һ(c4_b (eA@OsZ ^-|HdЕ
RGED ]TP&A>y@(5J:nǃ ӂx{ Y/ P@ p9Z#4(\ Yn =f"z `NTݤ-Fw;iM; ⸩
^n
h4 p?Lb4! PȌ,d15PSFEu
* LNF耵 e8UpX7Z 9шc[=$`rZP#(Pqg9;xlz
0^ƕ1 H XҹB^roVIT'ex̌-KP
B7GZa
:j8ϛX HxߏT*kź{ U`e~*"P$
2 A"CrB߭s Bn
m G1]{HƵk-三;:r`Xв3f)1#sOloa & YX ,miPSp: 'BYtG]Bo RB zXVp~8]˼{F]SfLǻEh}{hH wJ 3⓮ 5 O4Oݣmv$ 1ryZ)g 05kҿ$GGc(' ߎ+/kZDP1UO16 d5Ic֬Z*C
.}ULHzJH|rOA#9n!yPǤ-+\Z|}=L0A p>TL2CBF
P >nAvF,.BvU*.p/ !gxc8)hFhV
)-(D_!ԭk k+;WIl6 O`\){`1~K(91$ 扦J-(W< e$"xH߇?;Xp9j" o.=Z 1PcN6-ܓcIP־ "M8##f1E-Eܵ池i$#cW41H:Zr:0DJZܳ &G(b{ IuC$mO6~t$ (͒ob/}e^>iENډ>70?s>05cȤAg,*;=S'24+9Mي9]IЄEbTlev%j6THS!gV%A
L T'EVB{ Cge{%Yf8 9"3+g vCbYG6 k,*4l8%AZhg״/&uendstream
endobj
127 0 obj
<< /Filter /FlateDecode /Length 4060 >>
stream
xZKs6d rKmf̮K 'd 8l $ (hx 2/p#۩xpZĿfss^' h*xSӋߕ
ũնpR^lN.zV
ǚl.(bSeYt^ˢ䊽ӻa,OewOԣ2-CgZ8˖*:-O/urKv?㾜,uŚ=)]يLJ^(JU:*XwuRe$,ՑaC+S/}w`;ۦkvqNn8h 9@α?j?ޯa$c~1HORlw
ֲW8 aC./~G0+*ԅi䒽Ad#MgX34W\J9De
Wlv kBqPzNLd{,C{c
Sx k}XaI`>ǰtѷW {aU_flJR̈K~&}]_3nJVJK~; K B٠t;wmM <g2dO
ޓxvvMaEy,%aȻnk@dU
G} "Aä-nh PvLu\
^vmEKV -c] /VASꄘ`*ݫa!-ەޱ5z..LU.~Ͷ("! ܿLmfhlkVw(eR[4y]$G?@5軠)@ LSNF{ + h/5؞n2Q]>=p;E,,{=y8 SG 3?}ED < 5vIxI-JT4*vs& KuqXf>ۣ]]Fσ륭i#q&90aJil*wdDo8%]*|ߛ5L:-*
u#.^&ލ aC( 庮8ds! HM ְ |]&' wB_&&K4Vi4xG:Fq|4p2
? upR-+]톽aLzJ ׄr`ut^ ߄5a~q[/[ɘOt,}lnY\:Tr r[qQA6M *
ù 9(TŲbsP_Mbٻ )o*AxN
3Bx\qϟ&J(ǐ#ͥTIqѸWD࣊`WqIyn&J
5dRbqz&, :Ot9'(b5 Qʁ7C~ e&`5
ԗ,< |MWĤ:. ^:F9 嘬. >n[/Is/L䂆1,b2 OMXeD#NB ci>7;Q1'.+2B9Ľzhf5"tI4y`w[.dz"@(ƟqX0t.Ta_:KtbU!k7`=y+Քϣ0`' 庮 )ኾByRQwIUQ 彾^MuE*j*IpRDr #*jX*B.
=2ГT ѰkGr ?tɭM(ei6EKB 2H{͠MmV;IOC?а~~MGX&X
4$x_7@)?9U4T.n謙Dp:pg?AC} ;cXd=som )w)vDY*,Tc RЎ"#vj;]b jВ0b<9vrJ1{`<+G2]y"uC 'hYAM9@
9QXÉ6 T&WKX0Mnz0WF_/} %*F%%.t/cW YxHɬfʛt\,+M;^[ r~ lO6 gw8<:Qѝzϡmۥt?44T{ }R^ǔՌD$Uv ft D몔4eM90l,.(izo@m[!}~8M%@WAh|Ȳ fힹ
,r\
[Լj(`[oonX
Iw7xꇍzC
Y+Dئy&v 0AN'ߌ}#Su 63ɢ05\~w q4P[r5q5(1K9xv]O ne^99V$nee,I?*N&Gn g4YƊMa 0rPatŸjw+y#C cݪE( sC{/)k8|&
fAe_%UV|1U2:;@5#Ք )w@'ӹEc{SoӅ VTbh%zqrBB7ChrFwQd_x{hi
1x.+Nd^پv(4bIpZfj>Leb/D 'endstream
endobj
128 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 4107 >>
stream
xX XS>!sD iJ= :^#EE!DIA8@@dYeID@ NjjmRmKu ܯoûv/gX_wd#Ɇ,Z 1qҸ9aLzJ&Y~0fȜYi3`g}U /CpPF.F̍C=cqsZ3^shdlth?"@xxۑt2D=*2B
ۢܢ^Fg
Vy>{asEEXHD+ pٖ!>a'NOt=V.<+D0ga/@|a+L :!,g. +)ߟ2gIz&Qz,C;,D;TJtL$SF q8~b|GpSߥByˉރmőcLXQv]6yw"TdILQH"cw",%>B
ݡ_8 n%LIyP\*UV@f0kOLdB:y
,F[M)Y-ĉ]4h>h%
5,If?gOs%[s<p]E Ȉkh4aۏ)jv7qR
YvYoadG y4Sb 5/ER7~-@%<(sN^}.]UUVFi?äZ Va**^GڷcK
!٫,+vPQ&!#>ג2ȬP}BΞ$ɩE[ '8 ǡ1uTsJ$D?,-R3v *²;!P GJOp>/%#mcEem8͑lq/(<"l|T!`
}Y(QҹwH7I ] YfI KDF'y]U|"5ѡyBJm,|O1=F:B
+)R,j:^ѕeY%YxvƷgJ:'NOyh";7(dLW (u҇y> kE60 AthI5l1{yH'eir_&'
[] TUd 'Jl9'*v6尝zvR+rMyq)PV% 5" 4Z].Dprd6xnt}㳒2S!5-i&YN,ð
~Ntq=/e%si'XX~:CfvN gN9ř9[Vg5UK5 RS,
K3*8 c ιH\}mTښ]9J8M%MD\Om;~XůEY./PNk>do䶋L?x !o:U? ) 'L
rȪ
0L *G9#cK[ @RoJJ4g:4lkij^W:qU#,蠺O{@ oXSa;~ X}NBOxrGPPFX%o}b(,-{9 =]CT}$҇ e~n~&C|zz1ep32"rӻY7"5Y1s>AMęâu!p f^R: FYs V.S
hLHwn[88
8ą tDǜ T0 FUzz vU5 8u٫|Yp$NC.bo=f/؏<%u8:H$ I9DI:ڼB( ) hܞg5C0oo`3#PI2Xy_X Ő k2,QT.~Y-"[d[*csՒX^|t)TIS2}2Q ϝ*57|Y~Skm5A.d( &U
̛,([F }j-`?R =ۘ "l_HG0yU?UdCUm
Tm>Ӄ AG cN<)VM@g%IRZ3K돖 ()ZdjLBS^۱]$Dad$ "A&5b@\*aQ!+53-YZߍo [֫?^u45-/4
=1,CɥҿAm<F6㤇qW}d}OpΓ컎>
stream
xU{LSwo^ R*^bs(E塸g*i} )E*"("(2&N%>bcS3u\3qeLI|WFxQ2,`S8-6:ѴQ?rʤp/i76Y>
HL $%{`epKcT=wq]
kfcNC]@d^@ cnαQ
L;n -Po+h̩& d ?=/LT( _0ܿlmVmʱs pBO` `1ySևEL-QAVD?QþȚ͠pNO3$Sȯ'BW9tqqv/Qavu[)rh6
ȤM艮3-X]c 0u|.N\@&2ld X<}0&l̿š}ΓLSK 3C
7wz{>ln)؍+FU c k|5LL\m,1sx&I
~Z4 <°*|l,Nz y
Ƭ2$~p~kA%I#X߇{J} j ia_Hn;K+%_[2!<`ˀ!ny6ͺzSyt~"L
m%0$ȸxt:GUaz {4Ԅj Qƕv1ʆS a}T)+mk! Vԗ;w9l-<9K[pcM {npi`9IKv_UwMg鰋k*O{a=70 vԆ:5
d4~Y gZh@Ekk8 A8eo+Pi͇<&31ٳsN/;TO0'5*@ AW)uoBC(' N:GM:u_;XS[ MQ
endstream
endobj
130 0 obj
<< /Filter /FlateDecode /Length 658 >>
stream
x]=n@{7}?2 lc7.I.@QKC)A>3#9E!0}o>[q=Ͽڭ[N>ΟuvZ7 Oߧfmsi OmsA/cLsN[nzX:`)3\Q Y*5j,l:Wu`=VudmUAO=OUAէA=b#6aP>
stream
xyTT r Ĝ! {FQcWĊ" Ez/҆20̞zCw@@{5Qc%b%Œ˟g@~_b-g{?y(c#J .[n3~`/ `$tƚ78^s|4]]ݍ3^Ⱦ7%ֺ d9aܸcƐ--玵\g咱Z
%Ytrqwru\s[˅6v+mG#@Q\y~ paТ!KB 9- w^}
kW7wm =x}2b?4F<-8ir)SMa[p5Q+*SjeC
lajj8eGP#(j 5MQc
|j,Z@RDj 5ZJMQSTj5JR37Ճ>zRT/KʊCRKQ})1Տ
( eN,G16eKGSkA&¹&ƅ&L/ fűkVut0ۣgzgj뽵>MYtֆmxY?~ef}NJL3-- p q?H,{X>h2tA :?x!CgmqCuPAc?]8m
Q:f"IMNPsuΑvJƋEh^ PQQe JR!8/AsvL1!ctˤPMt2)2\5|m? @A4< WCTG* [|3ċAK2XDL4XE2'Ehk'/^ȶp{w}ʎ<]֢:S$mE}ikbx8<+rf ~rڍE727i{9, dR/0 9<)Eu -bo>FZ[N >":)D+iEEҞBV
[юV!<Ĩ3 p ,uz ܴ 1]Cf Js xުJ`/ RV C6
ֵ NvƠ(qG@ X
n':;!qxhT <`
@S*Et!˒ &[oڰ(0x2`g4G+HiG uQV37_Ĉ rt.3ξEud`g+*"q'J`e\tӅOIr#q?P\mSk3780: + !uIk=С$І
4BS!lD <6h.Cp4l)
T ,ɍG m!1P K
/
6i?w|M$Q˯ <zlhKt 4Mp *9A-IWR)1Fj*rj9>:GΏn?
@*Fw~p|X߂fmFCn) ?ebj(n2J#:.B#¶ s$?%ӪM"Ai 1 19 [3 3li2J Tq BjgC&&CL4HKRT;A$IMOEUZjWQ {]t7b^uγ )r)DCBK퐐Rsj5:S> aTP b)m(T!p)1 kdҥ46l@0d< V
x NJx'`G&3;MdBFͥw^"9$|G*Ч(^zd?t
XM[y.' ҡA: 6BArVt<;=l2NF%9)o%%N E'2ſKR4zDiy?/1Ed =J]зúzQ#:Tִ&rr4O4 H|2^ y$K=
-ۭq~wꢒʜĺM*iUZ`:AJS|X=g[Zp`Xٌg.o:P̱sS XV?="fUmۼV4=@(rk "em!){q^!cGUh'dHMʴ | kVG#Ÿ4-.3b̽Ewa`4W
> ]i YIvuRМ@Őc'{+֨UجeirFtDrDYY?e,C~~fasI)EثeqT/Xbo
6WLIj~THkrW dr#HE)VAf& oY\ :E-d.nEjtj/h];Zڿj4\}6xxúnF"4P 'A]䉌r
.Npbz(CC #5z6ِ(:Dz'Dp8p
:3^
+u)Gm=:{3 ۉ/U&' J "mRVr
F( $幣Iվ 9{3R2PTG{onq;|ԩrgW^8* ~=m4HODM
dgW`L܃&w[e^PKrofB+K
w|9{g'½qIEݳM{T(~+|#\óD ʄp~VSqZ z' ˮ.EÁ*)ߠF5MFJ6Rگ6ZK2vШ ȡK EA$qkf*B:{fr!TLz/ōȈ(A2$GVџ U f _vVl{h-vG Ř}> .Y[!]L
! evF[,HqWoVfhTWUw %R9{;9U8cP VO&ctQ.z~~4~(UaϼjDPW)TJcڋtjJ"G?dƨAz?DWWܻ.Es
3rgūɜ yGPA
i5P;wFs K#s1*v* [lvwpe۴
Ltx%lsAOh EQwc8 -AD'ECy(
!4 g?s}&
ѵnS|azm|o
$.;xp& h`
BjK92S9 AYL)x f,-ڭr'GŲ:GGM >sкTH#= r]t=33juȭ#몹5ի`-L A-9e%}|ƈƀ2iΆ"Bf2t(eI2adqx> uf,RWHً&0,Hڻ 1tcw5pgD1L̘w[=yo3S:QEo|4(?@/t ՙֿ"ze}'Nh%(9| G# nu[8{yK7
kfjoz"ir/XKمa5ﰸUxZ3p GR@ 0q BvTW 6 B0xRwKy!͞z.e hoJsVY\T-7Β
#7t}CuthF/.e|Z!N-}u[x[S-9SA&JP*c8w aS'~<[~#1WW%Hv- fyS}f Zí:lPfŃ]7t:;Ф mq;ϑcɜ-4 4?"b^FzHnfƒ 7yibs)%yPT={O8o@AD7EZ4TG(Bfů
<;yhr~ EP YɥI T69{5~zͤN遐S?IRUdƓ{t]˻It|I+1̢:1Ȟkg2. iQ"|l]be !4*֏qO D +W7?npIaA@h` ^wNJntUn~I#? mV o$sL>яGBNSĠt 3 q҈tp>A[2m
mm>z%;Ez]vTYOHB,KC$ؖW FTaX@ΌYE*rԩy(/kRoVvYMP%.Q7?T 0i,vRs\}{Dͅ8FX'9h]OoZ@^0GN8Mii<w[>j/=t\zfƭ LZ
,q(
mn ![2w/g ǎ[n)i^jd:Q8-FEBTC i\&R) |^ dIt'ma8/~C&?GfFkwdӎPȜrŵvjo=]{U vV^م
xW_&bLmȄ~vҡ0}Z%{O4oU bysd8TX 1 QR?Px_xkr q4Q~zJ|Ly}o3X+D>iZn\Wի wݴ*jj+5i4FҽE_Sendstream
endobj
132 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 335 >>
stream
xcd`ab`dd
N+64
JM/I, f!Cß^ N.[zxyyX~)=A{,(fF|ʢ#c]] iTध_^竧_TSHJHISOSIP
v
Vp
Cw"`}
֫ ʾ_<}aߺ>>
stream
x xSONA(4SAP8U&(lB6KZ$mIMlM=M}Fu8_:wfË,ߏǦ._&%M/#ƦǮYna|)>(9cKlbBܦؕ7$_O=)*M-I[W>#3+{0' "@l$6 f"xH" $ˉ69b!#~O=e`ӏ!sƗ33gEZ5ˌ:} i"!-r ^UiAdtMT0 0 AWFޏI~&ِmR% RinA
A
-h-ޒe^wݛhf <=d
d*/غzmMu~> ^PJ$:,pg^~tJ0(X<#sMusUD7C`|s`eJJwD؞ Y -Ҕq̚*,H FAN?˞0`]e:gE= K][u;ySn;EF+rZͷSӾ|D(u}8P e` v}}@|4O!>Q|-;zhq'鮳{<Һk=~_zh<)2NkmYN6֚Id3iK+< z:r3;gڏPT}?|>p^s}~*d`4Lz:"$58r3|gY[DzPY6j,A
lQ- և{",C
z(8s^g AR
(8r fiC+kWPyo^ 2⪖W 1шtA\2H" ;yb_{{U8o.7ׄ껽.էQԟT
NCG5Dz;JvrhPÖ7){CY" ΠRӘ@q"Ĺ5w8bx1߭iwgAH 6QN˫ԛF &%G2cdn ݬ;9(I+O];h8[A2cF
niYkgъ?s!M448I[}nK ݏrzrxy:1.&V7K,9K_}'oާ
[MV.( 1]pk?V+>@_zB8A@_`{]B7I[V)ـVS??K{uI:v{J hNJΤ <¬;ʲ;}^@ 6\zUe@ 4uB#Qِaq Sv ɕMW:=:.#t/T!Q#?Cew
z^3buħFp D!M
;y.0+1CJNs
v<
a̺0Vo/#1v]!a5fUf UP}ت
f&2| MBQ<<쿅 pw! lkMc[on o9 6%
l旧#iv_F eqXC
`2Ǘ
vE ,Vٽ-PK*ڮJ'$ O}_6'u_ RqovGk05ZjقG @&h6xh &à&u < ޖ@䮵7ygVf}U
3W P{;|5EНLMr)%g#b!S{@
xcJfx &Vm. P α9 ̫MVSjZ$`Zc,#_[KAW ؝5{FL]X}t7Vnr ˽ osseFY-\e6*
Td)uTR -T.sk+gto̙c~M
9JTՖŘX@Z4Nm]ڀ̃WTVZ٥c1 /æqÃ_IU[! .u}aFwMM ,$q4^-FVYVI~8g];#|^"JB[(sM.)vrΤe#FưLlC ;I9OѨ٘LKIR|D#eS5lf7XlLӶ6 iZ&zN @O㽆*֨t=vp0\'y0g lܢK> od>) o -Vd^pʏFpЂNUtO[{S( z4R\ oHj&U/hʤ,Ѐ̦iW7A#(JwHCl ~FK\]A'ϭP)Y\mnnF7,k̜Q` q55.+RU3P6qk2V$v2;gɡ ziczIP#
)Jck7(ӺJ~6PrtXew=Q| vWii"}qmlo -4xl2jwYWQhؽb7ο?m#+ xKs"f2%uY&RiP҄\\cK8hki^-hK [g^cgPl/zdtPx>{c UQm$"x+rEaP[vVtjw.!&zܼE+W9]VUആ _ IfY O+'~WH} .z͊"8ќ@ίW |h:O'sfSdp3қR_@TRѱ-L6_rDŵp8y'xx1H *4NL
) ^ܟyGuV_ w+c[|suc㎸vRגvB̎
rhwPG;o=^yc>A#) CJg 8ȇ"x>W'fju*J D%m0Fـ@SP58= /p)m6o55
N ,JԩuZ O Gendstream
endobj
134 0 obj
<< /Filter /FlateDecode /Length 853 >>
stream
xUKsF#RsK2y?t +U!Vd%mXV*{w@>\{X1#\2Ad' 3vm#7<(YyG% yyԖM!/?a 0˛#v6/\8 cV{)"Tm^2 (p! -=+ &|M=eb.Th˃sTCSG#ND3wj5օ\.z f
I01Jchᗎ(-gruj`:*Ċ>k}3 -!rs 25ѣG%XnM! Qۧϭcmy]O0a0 j?U73b8nn%B^N[i~M:Kad +D5kw\.7ca:
w="pJkd$4ҐYqD IIE@K cbmGLCr.B)NHP6C
qȎAu1,NG~|~;.@d!|!(r'ۤy]dto6LiǼܪ4 )I ((M4''|S䅱0<ݧ~$%$W2G4xzL%ThkK P"Eh^/\r N20QmVʟ>¦k Lh=
V k >
jz$p4HbǠ4\c%j g:e=N0N6sw pyOٳyb'rR`M8/ޟ?~IT_6prb"ϼ'~Q 7zd^
t!Dapg(gN*^ux?r>endstream
endobj
135 0 obj
<< /Filter /FlateDecode /Length 4344 >>
stream
x[Kor) `.F8~wۆ1ot@IrfV+ &I{9gW_=ݬ*٬Vj:{w,̾?/ ߞlf(S:f盳fmmUVRAz\BҬؿ;U|Ym=eU3/ y=shM8Bj[7qD##̊at 5ʲb> /BJaT'`^YWnw AOx~ASnwΙ& 86I:.m A´I &A*Md>*~)kMz;Td4{)IL0;_.Nm*zsxhU5y% ]C ~Z71Z~hA|eh+/Q(vຬ /Te]@`)*EErl1[2vXNڎ%W.6w jRXF#<} Y= =4/ZR# Z8Yc2f &ޥ$Pڸ!0`vfxh=npFE3YLe2[Z9_Hlg 3 m6)OlP018\νyNV K+KHGXGX GR` ehD1I҃*7,7C9As'e 'n|] Qwݠ@G/\ =[Bxml^Ee_ _R18Că
LpESJm|
h@O ` <6
rX| |',r"M;O W8
`Mpo#zWv0 TiyŚ1Iu =g k(}ʔVᝃ C~CѦODn8yO>;(.R> b;Nl('N yȻ_VUjvkPV/.|χ`%f0 rJ
y SWK7T&ݵ`.1`TGѯ`^" CԽ.L m&K5纹oG iTFT g{Syh T,yʘt 4"]եV:>Ǥ0zBq& 7; !3i,;?'mj֞N2Q WJiLr, ) ]pO <B [01=t< pQ8 CgDȽu5 v/a($[z8ec{8pO#Km2 O- g.d@RTa 2X"/U J;'{ H݅i7`Cg+4 wFb-RGc./Lu0 HS0Z 0u3q(l=G F^"W4 =?qi/MT
96d>DzJ71c N-%m̃gS LEeNo{@8$;[I\ @`ʹⷻ4lɢ,
4u(Gi X-Dױ dC]bo(ěž5^Wxtc`%0PzXGyUp`>ͣM=u C lL^ٙ^&bB 7~!l* #|xC
Eэy̛/e~ yHJa}3(Q+#{AᕓLaU&B8'(ghE߆0
QX
:M%Y0}3ruu%?ytkCg9zޜ2$/S.w+>M.+ mܸdC nD:'&s>OԶ:Cm4N=9x?=PTp/0!/P,$gPo/
+B]v ( 8 #6gE%}r2<pkoN
pN2jtɾ8>=j]< h4f*Pq\wtrPyZrcUOov
rp=Cwƺh pN8>nR URa%Okm~Mni ӳW@;*+@|dAIAAi1d!ǰ G pi}X L. oڞh6<38
B92P H7/ bZڂhYe3n Q=,XD2a7/|aSP3)" w 2hAu5V
\'(v ҈[^^>#&/ %_i)N1 5P邯B>k73BjT"}*ºpT+ $ ZӅBRȡlW7c]/)7x?,[٧0*\^H=8c%} KJH^Bz NM{J
(-Uߧ7B)ܔPN5iK!;o7f{I7-DoYSJ';;`
jnJ09շ+[7}$qt
S6z|BMwoaQХBB۪(A-7/~FuU_FΣi:@9xn 2 ]x;2(ygH>wh~sIZ{a.w)y>qG. XUZ.0 ,9#]fhu1C'|n$ ı bNZ]y Wj9,C˴w_A1idU-幫2cMj I,$Cl
L_'z]5:A2í @{>XkI^d2ʺ`?X3CXc=Bxg :(y @0)rY8].Xfn*+Cl F(n --D Bf =z5 ؤ>
stream
xV PSW!$^rM-]UZ "O!!@ "$ȟ$
W P[ B߶:unnU& -m* <^ CIjI&x.wdg (ŴEiq1I w9'`Vo>ÈDA)(͆(--^cݞˀlE^ybkզ?jZ&Dg &eYQdn|;X=ߍ:Qj7%Er=';G`stUȾIO .Tn4M@3ԩlqBzAF]Ag@J`[{ꔵz%:&IJʻ˻ ~Y mo(g+AJiupy*D#
h ro,O)2K49] fܶkqב}XbvW 7 +t䠙.ξ;s_(֧p ]O <5N a]9`kSP];َb)Fz3[ae60Y-6˓Bk| С{U >Ĩ¤֕DOŰ7
bA-|'08L DyCSg G-mlj&բ3=Uj嵁o $`-~S$H55EIm**ű07]]#.KqٕNƪ [&Q|kb]$'t}Kqh bn`2Դe !ܾS)n4 IV(vUP2dYBVgKY@R b6Td%)hiWT\o]m y⩟@pdx`XRv(&=sf>
stream
x] <o06͒yAc`Pcmҩߟ|@Cۢ},ni6\&\->֛cfQE+v {y܋lq`aD*s 0ؿ^0˃F)J K`$!66Y-06+C
(s'?sSy4l)aXy>
stream
xklSei;reCcq윓(LK]zavnzc.aNdDQ>
d/Hގ7 ?8/ ,+hӲS%ۊ*OKOJMl!05KKB$Wi [y|ާr| uPnUA-kjɷm{]rW1)R(HQqY1yHg2rJI7J%HUY(&kVV*k*(~6* JAގRT!9#Bd-3Ca#sż NJgh>~
_DcN7'I
a80 9&ə%F}~88:ltc wS KFrj>B|Ș<.-p
{L(هؕ} H@*~l_ 6n2/NvرIpK{؊Dt8 IŨXTW s 2s9k0ho.?7όÍ+i:7r2X n׀6 by8b+ͺ"CE=Z=4~D wP/ DvnV l`^g]]NI&`RS{m =Fa]uI]/] g v;qyu.#¦S> _~@Lj;.70c0蟧6ܣ/gl;V7.w33\8#Hv
h[[Z;tj45 !xE`"uGlPaa(HbhQ#پ,5όN ,4:F8N0餭,:tuos{Y'YZ\Ê=ի2smr>5[Z*;܄{ UZ}NPP{uߔxj\,[gsSv -lM^].e== /@>DrT\)avMWNA\X ѤJFLkFF鑕L<@~ |/z5v1#x/EX! z_Z.V+avѻ\!n-,.u,G4d% 0j[==i }$nXrGYPwR`p8Jh k赙uZ^uu ?>7L
$|>>7y)z Zendstream
endobj
139 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 487 >>
stream
xuOoA g K6mQ`z
tF91?ൺ۟^zψ~g-)2m_6:g?H[k45>9~vD,x0[{?Wi͌Ծs 7RU]tH}7Kendstream
endobj
140 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 877 >>
stream
x]RoLw];@[!;͙D\"#
FWb
RJ +U-+jejZ5'
$jDHA'}d1 5q~&oO}^0 3J
.[G^Y) \ %CM\mĖ,HO%_ˈ-CaVXGKC䋋6hs_Q5
vUXYP- 0Y@j}ձ$gK =D͏ S ,u 4SAFDIqFǣqS\Dװ5CÄ>k:
cT NX0
O3k逌endstream
endobj
141 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 4821 >>
stream
xXTP i# Wc"AM4blXudh36 "UJ`c$1U:f{{(Bͻo0={#4(HdY*]b/2SD%^^
s'W){W~_S i"=˯5
`!) V#,Z[/[\WZ RX[Y8yzIÃ,R_ 7;\ \\-6lݱupMQԛahMC
/o _?m]dK.{slV5 (j+NPI)KjrQzjrQN&j3LmtP; 5ZCS!eDS,5⨙ eJQ,^xJBMSZTuIFԭaѮIk*XEڃ%}G@h3|=Q[7L_/[
3phчƶƗY3l 9k.;?SF!L3Bi)Cѿ>r9ϪPoOPpH+C -XFW7% @O_\)hoh~GIJL) Y=ZXj6O? b; :Yd ,SJ9fiXL8PK }Ҟ]_ 7&/1=^WlޣɉoG{YxI h'hϵ쾌Ϩ, C?,"YGiuno9w9,ҮΏsS)R{ys?0'*qvI@tE)`#VGQl`|oIUI ,zM_GGwSZjj=XqBi'
_ @KV%xhgRz*n_ߑ^ۀjgݥ[PڡORT
{B0G
iE8Y&T'9tfk>ō2Lh&fqK&@tt DǝDf'Q~iane~#K
RcjQ9EaĴa̲`V_PA,&PM!CqɅ<ovp.imj+QInn}^en*ȨIC61lNwY9g5r(Ey+" J|؉o{andTBR42 ;`JB̢<& 7Kp~qKqa~NUi=_0$d@SeH0i`'}.H?2Mτ4b&ދ3`9а@$]yt"Ǧ^#:*oڭwu8GL| ^4>LeBg
| #@[9.bL=xv +A[)"/"o":E C-_h'WncWi
{ B&U^|if9tF]JCZГ :
wyA2B ![ 2M uˎaPaimQxE1g@o{;\wU>)k Ei|z| bV6ì(E_ߌ憚sl 8ArךIqS 㩐HP7XJ >H(ZD/aᣅxh{nC'q$`+xc{\جYϷ>aO 1{X wH%O#wH"[d{![.
uMXw|l a{osZu0utnKhHV3l0"|ݬ;MQ]žf
KV 'K<) 3K{ꛪFvW?^n~MrQFUصLk&!% \sG{N~աbZv*QI)!ȿRVHbhw mH2_l ̀φY; ԫhBg8Щ(štXɰ*s9*ȫ,8}< 1KmQGJ{L[CysAEnᦴ#i*oXsصeӗo'ƜmO-[K]Č6Z>NFWo4l7P6N*OU=OB\W8J"53$Oo&>=!a}[3XI"^6A}Rl;PahB Մ C̍描
s?ݚ_ whvm{_u1<'VƌSuDų(O!cflklJ##ȶƶqxzrX=0}@f <8aXI9|F1'O0)R(1/./7 b-&*"2&gS@C+S.IUuuLa'Xgj2Ƚ4^-٘N>ecg5__ .~C/z%)L]WAsws{&0*/17%d'@W6a
2X!C\^r([ ɰ_vdG#Ŭl@I/j\B@1?w2Ɖb颶Si3a]ہpңS
$`EUx9|_,S3P ZJ|Q ":= 8 h
_pmR y yj!P0^I$Sϼ kc[~ >BWH7!h , }}]
ܪ.y^?sz*XS I,Εljд1džkZs?Ff;0:_ҐYt"N^^&6LmKLKHGf($wr QY
Fݥ9 g [GcP b+jԑQ>CT$#*9"srJpR$n% ~oi
1dmzQ"oC OZslq"߃%dg0ND==90[\N>
DiN}+"$ȧ]]TW9MLRdh&*+O O'|8 ds唶#]\5a3Hq!A>`ߎ-jڸȴt RU1UE<||}qu.B%fIJD)";$p-sk` ;-crfz
į/'zz2|x}%G e B
>3xٱ9QHj3_O)PƗF(B ^>Uy[}xy@HHIP,/%3PF- , yrq-֔ zY^/ Zvro 0}J)J"<<0D
{ǂi%G9 X0MI@Di<byJ8T@ 2dX:\)z WyHr4n KM\'Vڂ#%Ѯk$g^-馒Œbb{DuT\HFO &?6h
JR n 2?E~N FƮ]1 zoxmԦm XF`/
\=y߿w;𬋍Jyn2.CKBnH@? k,<*Rиt
W/XR_nTuAaaaa蘐udglJti8 .6v~2;"I*1]ޥucIn Z .mWp== OF&':d&gg43yul]sqmYGo(8W.7;g6;m.xD(Y)'F]RObGLFK.-x6Ŏhq
`@ ==0 U1%a 6ťX쒞=e{ZX_"O*֖겂2ZuܤzӐ\HO!8.ȕ#z)])vendstream
endobj
142 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 2468 >>
stream
xVkTSWBQs
vtjkJgtdQ@Z)@G"!yB )Rw
}"vuQZvvf͚sg RufMYqr Cxly,);q-)i$W9 {ڇ{WGfFF ]½*ì'Z> r;&/0Җ=QE5Wj .rt`/6, Ipka"^2(LzsAn9tGX'43K3% ۶PiӉQ<{
uVh
2\7 2 t60?;In[ A9 YM9uNKa(ьXe ?) >'dbm=
VɔӦ&l ؗt= 2;g.
;-9 t[{|Xw春$(7N K}!eX.;?&G: ?Kz>w综-NzDV@3 6Mr-
]m9
K# -sа_yt Eھ=bo G595{WB !& ,H<P4L h^
$SP[04P2L^N̜ w<>$ibmT2ֈ cO\p{Ѡۄ#˾9w4| 9\.R;6#zJRmTMx ~)LgRW=H|9&AyΈf0+R KfSr=t!R@
T џX |M6divfAp!K-KЪȿjeA^h2Ho >PR_lY g$ !btB:aDz>9,Ád&BHfYEjMWPu3}瀾 [%5#
Lj Twoa& 'hGxy4 E~;rxї4bgZ6{"쬬3Z㥯݆,ezVAj*js ٓC[_,fPEZmP
!S v{3 h.tuϛ%Ho>XQ(E\0t|ca}y
b|o(իˍM$'(O\gwZZ&ԔO؎H]֒u
nA~M=h zZevB6`%}9i\]pj@m=F=ZQoxf/G&ΛM
5CuOQ .
endstream
endobj
143 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 788 >>
stream
x]PkHSavv5sE9?労"(x)6%ymYjB1n,X6[
bFQ
*(8-? 8Y=U#.^1s)68%B?"CPS?}n7 N=NgE ZifW\
SpyH~`/ɲwd8?
s~W}As2'2+R :A(}QU~#}KaU~/6)2
NtA'QO)Sd abo $&"' ̢ β#u~V:(@#H5D t,+Ե.w襄ibi|^+nQ{nzS5 _jVendstream
endobj
144 0 obj
<< /Filter /FlateDecode /Length 954 >>
stream
x}I6:%gC.HC==8ｸN$(;5$%ǁaHM,IheΟzs~xk8| 8 Obܜī-YHt2bq(F8Љix/>| I T7o:w ĨSs~}M zAEBb{;H -P71TĐ˗Ɓ<Ǜ/rhvwn orQ(rIHXz}w+H*jM*Y'M
{ʦ8e
R:)~Rج1HL*.nlq+E@Lu6KbZ(OL.i٧a *?l)"5nFu v2]Ꝟaú֛SŲozBzu].2{ fe,\f²0%.!_J /@bg\tnpӭl%dmX7=jO1,a5YXϦeۛkW}Z悯aj8 TV
Xq.
4V8tÀs 04J1M4ok6
Td6 y/ ;jSqڤl7@YOr7Sߕ[r "fZa|<| 7JYC4n^w q܀E# P \4Gu?{vN><ߖ> zg2@T6"3K g'k&ˁw6)@tx.8 o·1'bƲX:($Vʮ e<;)9f y_vendstream
endobj
145 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 1078 >>
stream
xkLUK!;u:qȸˀBƥJ&Ea1535L04R\&BHRL_rP
QeP)/AqV 9V
a{npFGP{_IO?UQY_,.Q%ARqA E\u
UEe\}JYVP[#>_^_BICGB^
G9!!rF,ڇ\+rChQj@Tu2ZZ5Zm J7VT:U̞Ies3䪁p ]OzJZ 9C
r}䛐95/(И4ƴUb"z&мčS\YÛ#f2 e~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Ӫ2f x'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
146 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 2771 >>
stream
xyPwWjcMoZ뵻*hvVi=9GM pr_Oŝh0
rH@u=Ֆڙuve^g/J[?;$|?!zbK6ެ}QkVn**L=~Ţ EtEu/N XlqXԝ%_!,˫UdM þ2]NF:Aǭ״-Vb gГw*bwRSqdoJDPqT?Φ4uz ,I"<-%bq -LʎN %2t t#{G >߹d~N jEm|M 糌om ʓ^#'Ut4UZ \T6C?`v0t@y~hrlh , L
-!Y&N"c5wb0J ,py) i
EM˷C6UJl 3rK M-J\F pkxeU*fUSk{C7#. 2~M9ɦD9p;yKTo ^ ڈ|a/pMv
d%R W Ԏ@.*^K5ˉf8TVnVuIq
EA>CDL@1,}9ͮhk" 2[ggm"'h_Zj ևLf P7 |:*C3y+l=ݯB
3_Bk,< eSX!/+^ms?㫨frj BX' 7hҬ w)v_mxczFzJޥ-+K5թǣ. 8 \# @Ch9tη~zm=9q8Mh\G
eYYwگmؔG 갸ԥj(/T0ˆ",z&^fx˕~ *|? R):>)8r 5jR/cL3Eq0P(1<i9Uk,`Cm4.S.F(OR5Zb|roO$]B3P(D `@W4;-NgӀ?ljy {Far=w_u UQNb"p)q{ Ԃ]A݃?wl:O7 CBj?0~qi6{MecS5zQ"Rֿ.N0]Ov :8
;2(^S7:/=SwbZpi=di sԸlITF V:āG
)G-G)["$W@zi~|7;mdwQм`ޱir tt&sã_BB/2c$&(E pu@]Gm 8|_oЬ-a߅{x2+Ϫٙ:[{l`2gEII ~OIax_ց:]zkT&PkD ->_k
tźenF.V<PqpI@>q8^TOl6^ /}u8<Ј7(K_M\!:Y :F'd&38B/Gݶڠ$'HyH'茹SL
)z[jjGMˡ: T;44, LFP%5Ʀ|H9_:v6~gpgUCn aЀ9
\fsG*]0: z=UĮo@9,:vx9Ojߕ/ a E~4 LP
rRGlFAŴtXMz'؞ , \sO :p
ll[Y\&5#^0;n &^j˰=!Cn2*1T%>_vx)|"qTU$?CQs@6rA ZIZу== -OPG Kº?zdơSaW++L5ɠˡU0 j$Z;/߿Nd㏞ ͕ Ei$7<6bzj\gY4CZ)e/'7-L Zfꇒ.i;Q-,0{t1{F0|q30wZkM51 7)endstream
endobj
147 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 357 >>
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\OXBBy8y Ao Mټ~e` ؋endstream
endobj
148 0 obj
<< /Filter /FlateDecode /Length 3329 >>
stream
x[[Т(XM~q KE-z%3R"p,3s霸?߇f7of?Ϩ:<4nAB8-t~8 9SZjl6;vnA0ThfQ[,9g
w~
LA?z)ȟPvمuvӹ Lil@52]͐\ܾ}};YaE0KBsńϙ
3:ow3Ma=,m'̉ZraM4Vz\8 IB9r ӊS;b^QOZNrqE))毨6gJz(,r$TQ,7/ ڊ#'+bϨW:rdSqeLLB & .s`r`0"θ1' 82|ڍIhzӎBg 7FNՅ O!b ;)D"b'9IDD/AD."DD0 ]TНT&vBg
$tQAw"DD' .s`t`:$7(tyDDbt'%Ediѫ
#mG]e_ĭʝ`|4gкM,)S ' 9};a4-0_ig SH4e9JK|F0'QE^o"[ &N͐TgD
soDZAc (kK)#R:lb0;:?,t3 1SړnF
y9 B`b 1Q!54>~
+MH`*I kZ01hfפKU639K8V_CQyXGMr줧)agyTj廰?2^t9UքWrԛrը]7nJ!f0[C?M.QtHC2窻MZAv-j ĀE
ޒ
[
3 r )(NJA]~P(_~[qAp
g2E
)nn $8c ,tjRD`+Z9u=X( ǣK-F3/H,CJ!:RRt|Z!Pic51PS- S3QXMk@~+/ NG7N\bkXEp]&nneiNS &U-^[(dU[ 2q&zxr >_B 0&l
J3Rh?)9UyZ 7J
;"[yE/wi= K?/~u PdDK42c&\J"\7 A ]H]IM\)hv%u, TFFͮ_~"-!!ta,c B8*zcيv-w,%?qx+` Α9NJ{%4oEXRq.۴*" Aجco
ilWXiIևKO% D~~nѪ6/nGb5.M" 6ڴ!y??_=7u% Ok!3 R!c\.5# o88]јK!dZϠXom ,Ҿ~MR^ND _h֗aPg_KTs5q9@^v\O)(4#eaۢ2,J[ˊw@6Tp$.&<@ZV;ZRGڐ4}{5so
K- 6_bGcAa V2 /}WޗZ{Rˌ/MJ ?V BLCKR1{ ^@
bK͌'w!"PP +HHߵb .Dv %g.ځ7qůTY텀@ 9Kԩts[M $߃t3Y!cw n}W&op/Iu CSLMV]8_pӀVm>0%Q@Y AnW@cW'
k@k*zIiB^rP9gb
!?> W*gGn uSzܭԔKBlf L~q-T
K7 bZ{N߄bMvy seGobAko\-`9X ~{5) ^\[fBr"[Lp>tKD6Z
ZB
Gu괗=sr Ӯ:>;uq(iƇelP/N]ލ j=7(vh v ҇:2y2=^,5C`g|G Ԙ 1 *cy> 9R=7M0:BQwL=bj; }>jWמ}M_n'5r0̔G5ݝqwV8̡h0qMe'gsʽxo{qƱ!np()2IHFʍҷ,oF=}dwQlM)'._OF\` i}~ XShJ3- _| ~v_p(vp<= <iv$$j(m "71A<(?cE{@ zg:mz_(6"q m>>["<ۭESSZ"
wGW;L,4
/اsDE/,@
GbO9p:RݽSr!ny
_s/)RS&m=
.OD tЧ$ ,yx 3'7#֚hHDa
h1q fC,endstream
endobj
149 0 obj
<< /Filter /FlateDecode /Length 5547 >>
stream
x\IwHr'>e^fX0rlY?o<33mH V_HTKtJD2cbI~555/ . F `7vc *Y63NO0VlmF*wn4Os] W|Ymu5 `Z׆BjB5HQV 6|s"{զUVVVsIUsŀ7#GfW"s5|bO3Wz7ޯa/yuCEj0̹G j \D7R;gMX < &dukTu|X RX%$fLu;$zb rlcxHGZcL
H%'Tu9_HCdW-.Uee~K9 qG$vfjXgq^~4aj4U͔j-35|QuQ
X~ch^[+@AFћ{?$P6(ÁYdb\(MF{yK@,~ 0 .͂Z('i`/Y1 I%@@FֺZ/!^k9x/"+&GmQ-ÕK<+%#/'WwewU E :,逬s6 >,vLJp 얟5*#"k%[Q
c 맆or!R'2o#W}2ɻҁc6>4A>ի '}ܐm
Z?GO`a+Vdѷ3^
_탣w=#"\)zO7!@9vwZp>Ne+Tw
Rf^$@z.8%a)A xܒdhzim]cgCAHѐӞYyK0P1>S9w##m ;>CC#H1{)7B| R E- s$S}e,*nnj"cH]LlsKדlZ>^!vt bWp/D)F# ƮYdqsew΅d! j5e-YɁCh`-ɶ&e kF~[1)
I)Uk egNx *ؗ!p9
q4=>
ho( )BDv5Jd]ǁ{ *, `rr[q6 = 2`grv|= V&o'_gkNgR2Eik
V cjӪ0e
6f~,ߺq T2ZqK@R8OvujC^7K益]Kn-,Rfߴ?QN@%P:πeV$7D{ 2e=bckfi3,}. M)yXd`HdqrqNbcikw_ K(k:vo*Ŭ c2qg+H眤5Ť +ZhGsy-q/p(X_Q@:Q WZN4:\Ś "F''t{p ] E`C
leα#IE@7'*( ޙЈf7v)4<`YDX_^z0."*Mr>y$'Q5|G~? w@)l uQPߝ36䞎ٚ@ `. .asWoUIX`H(UC'@: SyC0)y:k$>2LI:VN}V9Zֲ^+NN2^^y2||*÷3Ol;% ۔]~/n.P1M "XϮX6Wۑ=
y
C-lm28MJ3
7PN4<*kᴹ߿g7M3UɊ^I& S*MhI <Q83mٓ0X9}nK*GC{>z~B ,@_20>g7^z _wé˸o #i-,5'i;n 9)Vc( "j W{?M{mtݰ` n=S4deGo[o];]^K<9GgOSxȤܭǗ =LXzG _aaFw_,/"5 Cp$aE+Z f_< ̄5c rZX-7u
O7uCdŶhΔQzM6ڶd7Cl*̈P젃's[,c9Df,I ٕCy )q\}T4>ȼ2),R\6t
~AKD?}o8 KEQ_tpaa2أn\QV"\ >_bŵ\Wgwd/>#CPP/@1"5|Qf uq26H> * \gIɓj3uò|sYnpY8+'K '6Kmhء$R
#dDGTt7g|Q2λq^RyCًM>z/C*2ox"?8KM}qRkb鬶LOD^$;OVv<=!㡣7ƔKM ,;07*70:,?pң"g[vJ
ΧD`YTKZR,3F$%F(c'ͫ)c$7p)l[D0uR0 ?d ,^ND1_ˍ}&_SWjd:ojn[^ [=Ey̞oaFcl/p5"SwK&~[VuRm̽dJM ĖCi ujo @B XIlԈ+ۮ1' ND1Ȓ?:تt1&]͏lQHIϼ찃?y[}* /}>2>!%מ➪q쵺hR-vՃݧBS ޚTyuףGch! ");D&*M`_2Du8}<,>Qf,m0#jM05p -`L叕acU8/ALc bm6.lCE@OW+ юJoŲv9 x"j Gc80г68ü o #_:0|D 04z 3o! yPkdXM_Uugendstream
endobj
150 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 382 >>
stream
xcd`ab`dd
N+64uIf!CO/VY~'Y|=<<<, %={ 3#cxJs~AeQfzF.THTpSJL//THKQS/
f*h)$f$))F(+ka``` b`0f`bdd?Ӿ ʾг*URmf]@{8-l_bOVAn7Ʃ33u/<6NJ?DjC^];ǂXOy҅?|\v s=g7y'Ly7}:Me` 8kendstream
endobj
151 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 922 >>
stream
xuQkLe~~J,%_?f2HY30e.m)kiY Fpc+8:HQݢf[!qcɲ?DK1& ϓ<9BB(*ͲJgQlnj+͖vm!3iLoo2Qra~fnVe4 -[p$e').r۬&OΎW8+qf NSÕ;;⠕tpFs9j*U z)?S D &BT@ZT y/TL\9 3 ]JI>MT'goN,ͺ0;}P!EB^U=Β xj{==fxZM V;ś g, <By ~ww^{{p`{=w.]ŰX3¾ vI *Iۯ! \ ػ7"p`,*Bh`V1ĻSacc5#S]N*J^;uKm7yq'ۤ$:S|סr]Y =*nNOSW1ˤ}ya(~w[A@00 ^ҶQw(4zm%*ua{w.c7OR6m^^}G٧[Pϧ! gQ߁F\"bXj-a"A?nPR~\j&Cr+:{s!f[jt>j[P<1WSpUCB7Զg8"3:HI?n
?(> /Filter /FlateDecode /Height 173 /Subtype /Image /Width 149 /Length 229 >>
stream
x!@ ^Yذ&,`FYt zbaչ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 152 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?B4QSkfp ΠGNׯJ4"0grmvB=&ZxY hj}P9X/m,~w}gn0]b G,wkh6
sVhlĜN>czuy>?sښNL&v|GA㏴Μ`&[luYԳS3
J6/-V<=$ZU EQE֎
PBCCcDHH`gHu pt8f
V37Oߏ zم&6W
ś~D>p@.7?TTM4tCg\]]sss00
hBS
Hj ~viK"k͝;w ;)0+[=`y-Eana{ O z/Oa>RVVfcSY+N8Ot~FH[rVv*jUgLÍ5Xa_aq%8k&) lUNX+;𗝝 = $ ڥ4%xVZљ.6AӲ"3x3 X hHJQ{&=C+ֺhiTUE _>e wOy6%
/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
6 35 vOe% ?oiZV Tw䑜iOEv1 D)' 6+V@Q9%`[*C ])`G5ް ң3|}}as. lXA@Hl}A$@B!p] 6`ݜ
UP-vjz T*R*3E0-a0^]Vt L@DXTSM6 , wI6s?-lVYuQ*c~[Љ
0ޟ:
aXԒ NEG^`cplY d}J i
hKob ( PCa6X AޖC
'`1"1XU-^}73bb0O6o9#=wj9DA7?+n`6=wٰ!sF 7i)
=kg5?wf7FƼ0%{ev'A% ?E|q Xi6gJoFِ GsL$"$*', |||pm˰ O_b.#~ Je V zҙ Ĭ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]F3 x
ݟ:ԇk 8GB LֵN B,Gc;8#NX/%!W$wc9d2+ _aS!lO*|M}O.eLZݒOMX (iy` ź :q'O/Q8>!>ft&[v#OQ7Cx\xɘ7ntQm' |"zj,[ءJS!XySvNI+I+췃#l3esb:aKa Kb$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%zhsC qT](ڔjG 7 $[ G+`/d[hC1 m5&=gu8@;rG[0.6-\/M|{]}iHlʫЅN ~SOP^iľqɔȮ܆sE*R]#cp`!\zjjzcN [=K*_0*lN!rI
jt?zVZdK;eۻ/JP<k\):~qPVNk(zR7
-+w$"|#
< =-L 7%8u Nju OpZ 4s0 i V$ v~Mv%Gc\?zA2XXAj;"QiUe
9 O;Qw-Oەtϗ9~{1
N%N!bmA Z|ëas=)qcamֲNg7,ն\+=<)Rr@~A|1RQ 4bj {-,:zHq{ݞ]Ea 57
VY+MU}88Y8Tv83yMꀭ& ᠦJvפRU״~7͈ ~<X"-2 kGxGR&`:"hU85lR(?/>yR )
FP|+gn;v! ѐ~ͨ ]Xۆl 둛;
7R#ƴ;
5 l (CN3UH`7?dMn ,#`mqdp(*͏t~OW#AQʙ=A/EjQF ԛe9 ͅ A;",yOMk3e%Mr5FNNj>bN
:}6fV Z1H6B` LdxهiK,9jz mMp+|
j)6Q#BESo~8}*֧6a~R^`pC[}og~J3_P X/:{LoX`v2մY$_o4s _h;rIud%Y_^9ʊ1Yv =7?_pٔMiFayTp6+6~ȋO kIX
hfI : @Jd4;XvQ@' V l rXa|lHj-ǎt O\;H
ё~ N/D˪oľ#'m
N p#i Mc<4t̢vx
im+X̼\BOi4H8ۙ!bVj\F W毃7mTFT7,W=?k`+' LjHeOyJSl>!G@Zd5Ƈ/qg1/f\ia9>ӌ5P.P'-|*5sf?qsmrȋZ%"7P լ
55K@;~(\S[K`e4c$߫*5 TOkOx 0![
<ꧥ Cs)
2Z+O{U0,?RL]g[mprZ*l4%W2 j=Ir0ϩon5`Gt:d!-~=6 &yh\pjGI:{=2jL]H67GV(H0'-c> ӿẑ$Ȏh W
0XZ9G&VbCy/jJ8zyW~Hþ 7'Kuiah*ԁ`bӺu͓hnX0+ԗjN
'e0^ x2˰w %C,
ɯp~Kp9}a fC
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)Ww ivi_P 3JN4gkM|kCV!@M+iuÏ 5J
C
UhB=i] љ?TԩSw܉k BH
у }CH$`a?é~|@^^{I o;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֩`j kecctVĖ<מ%cLܞf/ٿ3gҝm f: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[c X1` !~?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?OuM endstream
endobj
154 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 3715 >>
stream
xW TSW־!{E0>(R Z V$o d' o ^EP![ڱ:Z jqxvfu_7+I:{}QvH$t*e<~UQ)
daHxNxC bDo7wq'18ٟ~}X+h"Ѻ(2!C9eҤ'a~XeZRl<~g2_iOoegXD\驌 \z՞Yzg;EQ ũie[""cbqwMVRTZKP`ʏ6P)_j
Q@mj)zE9QCٔ 5r^ƐzQI4Zo'K ;Gw:w'ɐ{gi= |iӣ!)?8ۜ?w~rb:,\ x2" ƪF4 *
+hQ Ln(_0K辗-xAA_)AkMjX)cq8SZKi/O^|rgZ1EԌyW4H$т'n,;J\2xRNj=s/EA ){YOGjճd0Fªo# E 'rx2ʗqh2 J:{1 vlP#ZIv9<=H5n|̢XHG1R6v' =F.}poK!V6+7mJz'vNA9sǾ V9舭iAΐ<`Fmͮ{P]7[8R:f}JXwfco[ův^FϠ-[?
FvX0$nG-A 4QΑ7OƔĜ" )IJfֻ<mB;^+ ^8#n8<#n7yU'Ǫ4;p$8 H{@oOPc3o=䀘_]5=H,xϯ>Ʈ C,˗%sg{<7wP?ոi]|R&p:Z̆$&n[C]C>HJmF3ԋZO 'Ă
ѴQE* ! >vSE5G^(BNݝWb[c+RdCN٫VӜT/xt6)љɂ2<e&+0vui̤./.
mdy4 e hvcCߡs5űv^J}E)8t@7E2h</_?=zC :hȰ
nIuNBwCyF?],x| FF*zM&m[i \fdf!;6Q왜J!0^+@gI/1q ^i`tvvH 6_=c hLZyXڠPmn3DCg#GC9~8 o_'ӳ%HJs
<%I]+'䎓;kuB~<: KBMħRw&>cxLOHU lЧ@B+fL!%9K kGuղ%4M!7{9 k
QlJ
ፉVǰ NYOA' Im( >`kJt#4WRgq1ch֔ܺ[w :tHR_u[ 1 NGo"gA^|I1}P g\BH |^E,U_pߍ #:KE X ӳ7 ǃ}ʱJD[BL$P$dk,\?K&&ɵl g[Ϻ)!_xSZŇLJ-r`&
U]*aTE5e0#upfx?Y#ޑAd#J@82vMMUL~{0}qfuGH1(<<`E
U%u Ĕ4|&sl 5 7Z6*k*y >2$~HWȱq*/EE7"X# k5#U}+zCkEsDG4r32t 1͞cl1/&{QC"@0j龤ƸƤ}m&Z$ &~7HhINqhT-ȇe Fu>(o l mQHڌȮOzGУF`x 7߹!U gșB>8nģКw_1zt4HvFw]+ET2=sGN<]HY7F$8 )}ح*eO6dyh%Eքlw )O4lm n[<e{=6 Ҙ^i?l+f 6
fuc z*@ԍϟ?ſ(h}e!'Ubv XJOE=Vԓ& d֧C&Ò*II, Ƈ,rRU2DIH렮C!"MEk%Bf1
7H?OlPp\YE\Ռ9\~ 0y]E#G_ BҝN}
}/Pzd{Җ$3 UG0],:rUInӸÜcs cuodv}M_-2),i9+Rd^
" 9| w7T
bZoi KvR] G𱴯Yڬ3eK".8 -
:R>tm(VO?R`aLߨ"6pƗfRgrAnRD\u9 {Q|^;>9mvNrG=EƲ#iE ,]endstream
endobj
155 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 2309 >>
stream
x}U TT~0o KPy
&cZ&&hpD2ΰ0 DeeA 2Rh$NIZ56'&jFk Ӟs;߿\dk֮5
ΊIiڵ#ó@
IHS%,TLe&,Y7a'X&,a63˙L$
4g@& f 3222F]yW~OPj*+pȂiږJB"qNs_|q:\4gIK2_|r) TКW[REdx P bm6J-EY]Q!Bgh-j-N@ הU ld/8\$cBihvnU~2#!-[Y.uo;t65x.2yެ1@ "3gdSm)OcGynїq4Ef,,~
~M2h$AYHATb ! FcgQ-x wDuNF|RTMgZ_MMEE%*5$oʵ)gmi Ec@hTVy2r\)'G bvY4G.iG!gB>>v!+
xee 0Oj`S[l/A%%`7g>P8jG=O96 ` /AUIթӤiu AћdIozʯ+!xE>W4B[h3I*(.P07jKu [W nm{0Aڠj[
*#C':Zp%ig^^6,̝/ƙ9jTpխBPi|cU+zC 7ӌV8TYgڿ΅G? iendstream
endobj
156 0 obj
<< /Filter /FlateDecode /Length 3062 >>
stream
xZK딜
VL rHAr 9x@<4);ίOU?nF F$ɏYE/l7iCUV} nNc& eeQvBUR~9 ;!DM5#>\ è#vYm'5 viP:L&yM$_{\*k,#c00`1ZXA-YmWgs\o N=OQҤX.A.פ\9=BN 7|cFӖNpt\In 9EZR6E{;i)Α`"4'wQr0Px2u h57=hAIE-q>R`ɺV>LHrBuř'hNRW;& xѭ>l-9Qr 09aZ2Av G;gcJR5'2^Borrl;kǴ Ak_( r
?#__u 5"k !^
q [SC!ְ6'z{AiCv#P)=;\qV`H>3 8WT>lg*ju/[đB \
$!9ҺI7 \H`T8Q0pE؟M$ 51pkt )EU-\Cqɶ49'S]n%+R lVkȐ91Úr`>4 p sSl[|BplR@I1:Y]1{O䰖5@tqVG(eҗ`ŨJ(ƏNnrzk ƜU
tB+N.M3}i
p!Y|#ky[R&6z +Ӥi !ٱ8=qPU4+ QϘڑqidfjM*//qy.;44] 794V%RQ.
./Qb% *otUH gV]m+k !&C
c`Y(JraԒoNLXNŦ[OU؈M̉>EBp.m{Ii"bhes:v./սz]K6B;pmILy',y֤X쀘)]}\jD쓽fTHb[alH-&{nД4s}AԀD#|9d 9mark\|)͢F;F{Qt
9>#&iY1DRJ7Ilݻ9= 2aEH5zgu/~ 2aS71$J@-tЅԚ[7*2 zvT}d=akΗ
ͯKUnKk,"X\4U YKbu$n#=r4Oz%^WOsHutN>6˻x- tܲ * q "5Pmq
T
%/TS+ y
D<~$ՄS+ hI(K II>E(g^xP eDX122
;oGB8ᏠT>
stream
x]1 EwN
V)bI `" "d Nҡ÷lm.SHA SI-iq|VHXW@؝G {M:XҐtZIu7LlDq^jV
A
^;}px&zK |?0g<^!V-"_4WZ endstream
endobj
158 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 840 >>
stream
xm]LSg=jά d㜓.!۲0d1QT 1i-@? K}zT"6fd[qf˲ rL\7ě$OC ֑FL&α6UۄL, n+)G;jkNQRJFavv`N$'ⲙ UU TVg5s1wz:M }i4jbhbs;b8h?ijf7 oާymWB5 DE
h;*)"0 ^Tm!A|W Ē;_C\Ƈ e5`AH^N\|T?}BZPu뷸; @p4O/_ 1:KK=0'JO\SXb!& DŽK+k@ Ӓj08I퍮 _M,?xx*6k6bSΫ3@J(Rz׳oε LWSau;!qtv [݅oϬ ?| {^/Uψ;b_ğwW
:I-/4;+QTt =# a&Od5O~,OA& ;'U /= nLuن{:yUvz
ޝ,Z#TZ ȱ>mf곚9t:') ? X|7P*{^<<67 [Q[--g[@MD"P4D2J\: #ዡr;BB| endstream
endobj
159 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| }endstream
endobj
160 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 1051 >>
stream
x[LZBievd%m^6KVZ[@D2/ ?@@K^j],Yӵ-mdYqt4hCl^~_ 0Odi/˫R駀~AF0Uɳ4@UA·fW(˔,0 T[$WhqISPn^^ Z0( ;ݪ eD;Jr!u55DiueݙcJA2E HR#eHz#Bn0a
'i D (~cIT.m,aLu"DiܿN _?E'y
"6x|=AIJUMz jpǼ
~
SqqsI f.2z~Džٝcȯew
[&4MdzO>&@7kPKgEg;Tc*㛧*2L͟sx@]JoVYxa1
ۯ =j =v:ꇐ t wwcAK ר#[ hUg7Z{6Վ_ kWC
xOdBC>tNBT]zYJ.cXy*jsY \ܢ# .L`@Ձl,SGV'A.3RBcI8.bR ^ !
'^ ::tBb5fE?ZnC;穙b*=zh/;Ī;cf"
vendstream
endobj
161 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 712 >>
stream
xm[LRq GZ<ڲZ[K-
/zh2N ^U/mmہfT/=|!9ikE
YbMi.WRԙT!
ZӂB_vBl d L 4(y>%=
hҬ0:Y[VRr8p/UV)"c5*CTJ\,i)J7Hx#jE! R#AտsVWj!oĀ5:GR3 iiu O ]v$@?L0ۿJe
wTXm]96+C(jQ4~'Α0F~]bjSuW
6UY`Dp?M~ ~ PUׂ 6Fkm)$US73_j Y?UFR [`ܩyо(]ZhlX> HMP*Q CD.CoP1CFsQ7GN'q;] Kendstream
endobj
162 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 301 >>
stream
xcd`ab`ddM,M)
JM/I,If!Cg N.[zxyyX|_,H{> fFjʢ#c]] iTध_^竧_TSHJHISOSIP
v
Vp
PTQF ^Ȣ}
f4; ]T]+2[miwI?.\ؽHq ?oZȶk' s=g7 {&LógJi{{xx 5>
stream
xcd`ab`ddd
v54 1H3a![OVY~'Y|=<<<,^,{ #c~iUs~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTW q r-I-I-./J-,M)I+a```4c`b`bddso? 3g'N=cZӔv?{Ϭjhnnoc3Zz9M2mFS? wS )IݒM
`CJX:lI7smb1ùd20 endstream
endobj
164 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 460 >>
stream
xcd`ab`ddM,,IL64uIf!CVY~'Y|=<<<,~
}=M1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5U15|N|ch^Cb=o?kάnok Xؽ`%S;gav˜]j,
N/+M/J n㨝=eZ rݽ̿pnY ګK
+tԶUtH.YΕg韱Sod;,[p͜ K7F欈o(h<}2^m=7n9.z n ==}'9gU{&N6 Rendstream
endobj
165 0 obj
<< /Filter /FlateDecode /Subtype /Type1C /Length 301 >>
stream
xcd`ab`ddM,M)
JM/I,If!Cg% N.[zxyyX|_,H{> fFjʢ#c]] iTध_^竧_TSHJHISOSIP
v
Vp
PTQF ^Ȣ}
f ]X]- [mYwY?\н@q ?oZȶk s=g7i='NY;wƴ zxx oendstream
endobj
166 0 obj
<< /BitsPerComponent 8 /ColorSpace /DeviceRGB /DecodeParms << /Colors 3 /Columns 149 /Predictor 15 >> /Filter /FlateDecode /Height 173 /SMask 152 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?B4QSkfp ΠGNׯJ4"0grmvB=&ZxY hj}P9X/m,~w}gn0]b G,wkh6
sVhlĜN>czuy>?sښNL&v|GA㏴Μ`&[luYԳS3
J6/-V<=$ZU EQE֎
PBCCcDHH`gHu pt8f
V37Oߏ zم&6W
ś~D>p@.7?TTM4tCg\]]sss00
hBS
Hj ~viK"k͝;w ;)0+[=`y-Eana{ O z/Oa>RVVfcSY+N8Ot~FH[rVv*jUgLÍ5Xa_aq%8k&) lUNX+;𗝝 = $ ڥ4%xVZљ.6AӲ"3x3 X hHJQ{&=C+ֺhiTUE _>e wOy6%
/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
6 35 vOe% ?oiZV Tw䑜iOEv1 D)' 6+V@Q9%`[*C ])`G5ް ң3|}}as. lXA@Hl}A$@B!p] 6`ݜ
UP-vjz T*R*3E0-a0^]Vt L@DXTSM6 , wI6s?-lVYuQ*c~[Љ
0ޟ:
aXԒ NEG^`cplY d}J i
hKob ( PCa6X AޖC
'`1"1XU-^}73bb0O6o9#=wj9DA7?+n`6=wٰ!sF 7i)
=kg5?wf7FƼ0%{ev'A% ?E|q Xi6gJoFِ GsL$"$*', |||pm˰ O_b.#~ Je V zҙ Ĭ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]F3 x
ݟ:ԇk 8GB LֵN B,Gc;8#NX/%!W$wc9d2+ _aS!lO*|M}O.eLZݒOMX (iy` ź :q'O/Q8>!>ft&[v#OQ7Cx\xɘ7ntQm' |"zj,[ءJS!XySvNI+I+췃#l3esb:aKa Kb$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%zhsC qT](ڔjG 7 $[ G+`/d[hC1 m5&=gu8@;rG[0.6-\/M|{]}iHlʫЅN ~SOP^iľqɔȮ܆sE*R]#cp`!\zjjzcN [=K*_0*lN!rI
jt?zVZdK;eۻ/JP<k\):~qPVNk(zR7
-+w$"|#
< =-L 7%8u Nju OpZ 4s0 i V$ v~Mv%Gc\?zA2XXAj;"QiUe
9 O;Qw-Oەtϗ9~{1
N%N!bmA Z|ëas=)qcamֲNg7,ն\+=<)Rr@~A|1RQ 4bj {-,:zHq{ݞ]Ea 57
VY+MU}88Y8Tv83yMꀭ& ᠦJvפRU״~7͈ ~<X"-2 kGxGR&`:"hU85lR(?/>yR )
FP|+gn;v! ѐ~ͨ ]Xۆl 둛;
7R#ƴ;
5 l (CN3UH`7?dMn ,#`mqdp(*͏t~OW#AQʙ=A/EjQF ԛe9 ͅ A;",yOMk3e%Mr5FNNj>bN
:}6fV Z1H6B` LdxهiK,9jz mMp+|
j)6Q#BESo~8}*֧6a~R^`pC[}og~J3_P X/:{LoX`v2մY$_o4s _h;rIud%Y_^9ʊ1Yv =7?_pٔMiFayTp6+6~ȋO kIX
hfI : @Jd4;XvQ@' V l rXa|lHj-ǎt O\;H
ё~ N/D˪oľ#'m
N p#i Mc<4t̢vx
im+X̼\BOi4H8ۙ!bVj\F W毃7mTFT7,W=?k`+' LjHeOyJSl>!G@Zd5Ƈ/qg1/f\ia9>ӌ5P.P'-|*5sf?qsmrȋZ%"7P լ
55K@;~(\S[K`e4c$߫*5 TOkOx 0![
<ꧥ Cs)
2Z+O{U0,?RL]g[mprZ*l4%W2 j=Ir0ϩon5`Gt:d!-~=6 &yh\pjGI:{=2jL]H67GV(H0'-c> ӿẑ$Ȏh W
0XZ9G&VbCy/jJ8zyW~Hþ 7'Kuiah*ԁ`bӺu͓hnX0+ԗjN
'e0^ x2˰w %C,
ɯp~Kp9}a fC
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)Ww ivi_P 3JN4gkM|kCV!@M+iuÏ 5J
C
UhB=i] љ?TԩSw܉k BH
у }CH$`a?é~|@^^{I o;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֩`j kecctVĖ<מ%cLܞf/ٿ3gҝm f: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[c X1` !~?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?OuM endstream
endobj
167 0 obj
<< /Type /XRef /Length 184 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 168 /ID [<5bfb265ff83f3a106e8184314f4e42b2><2f49a922dbeb8829c8eb14880b687d8f>] >>
stream
xcb &F~0 $8JҜ;