magic/0000755000176200001440000000000013347666430011346 5ustar liggesusersmagic/inst/0000755000176200001440000000000013347535753012326 5ustar liggesusersmagic/inst/CITATION0000644000176200001440000000116313262761605013455 0ustar liggesuserscitHeader("To cite in publications use:") citEntry(entry = "Article", title = { paste("Recreational mathematics with R: introducing the 'magic' package.") }, author = personList( person(given = c("Robin", "K. S."), family = "Hankin", email="hankin.robin@gmail.com")), journal = "R News", year = "2005", month = "May", volume = "5", issue = "1", textVersion = { paste("R. K. S. Hankin", "2005.", "Recreational mathematics with R: introducing the 'magic' package", "R News", "5(1)" ) }) magic/inst/doc/0000755000176200001440000000000013347535753013073 5ustar liggesusersmagic/inst/doc/magicpaper.Rnw0000644000176200001440000003443013262761605015670 0ustar liggesusers\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} } %% need no \usepackage{Sweave.sty} \begin{document} \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۸~ }vvֲ:; P6[ڝކ&vGn.{8y#U)f2`YmX¬̱$3o,1B90!'$J%a"IЩT1ކIiN)1{|왌  uLJ5KŴ"R3ؘIirLlў0#{nj.bf`1f*SCvͬG'ʲxŰ[˰5%viv0V;:K"4!@J$hbH-;`Z`4 @`!c[YEB_afh f1Ȅ P%,H͘\H>+4 wOiCxtJy&e|'Keb6ٳS6e;h9>y:ʳ(OٳW/d,vZȟ),gjyznFo=.1[|zq<ߎS,-xGR`qΞ|6LFv=ʯRdE˦y6^2b vCAp>U`<@/~m* D?r2IbV0\xӝ4O)d1g_-}jdy%bv;caZuk$'b=7-mIcf~jp_sLe} MhL9+;Q@J9Uȗg>2'"h# N&-f 6QJKwYzDSlC{JSCms1f!t h ކB 8mRدHlTH,> KE!IҗF hm]H#!y0~@ [4אqxXi5|" X?O~lA'xvN@ Y;W9Yŀ:l2((ĬVzy~Ed*)?%ddyjOwDiFO9Gu$ E"cl0p>]%@^3J09x]`[~W`{w sE/:rUP#I.h 8VHlc6B& ƢZ0}Y~YQ V3@H8nԧLu ´!Q6.|ojj3 |0[fGuYL h,]yxr)Ua{s7#cy%|4 -ig|o=7-?|;>'G>mQ?Os)E^l2zy<>-x:-^l&__]//tNy_)u3> !buTLn r;O0Cm^4/"+y~5OS-+ܽrJU]_`^UeWht \l5uGu- {$O@8ҐΚ`wo|'' 5nM٪a0 um) K_PUrkZT:zgk : iL-,6[Xf/bG+zuq_!n4.+OJTPIp1Ip1H8-HJȺHQ:q{x\ގ^;fj&29beޫ8s] j( @&n1E{ e^T|?cGF 0`x K0MCk+dKNVj|-"5Y,x#6hzƷqPH}C*hN6bX%06kd<슃/\Ӊ̏e ?,],+Vü .9a@67z67ӗ 8]{gGo>4c\rC7<%3ȸ'/աjxEuI1R_NfA& {g}DE!צP g})뾁޼ۡKv͍:Y ӦP)iۢRTLHP:eiPp$x4hMNL&oN>P鴷"Z;?mD1ah}նyJ8ûVoUtMG|A3e%K:MC҆Z"Xeʄ6sefW~ǨVb5j]Kmk A[F_ko26Kl$ ¦49ҳ7d}\ 1bUYubQLuLv8e36}(8l0}Y-;) GlZ3N&+nku'!@_o8Cw~sK&fE_r$tɇyHuq~^kGɆMۙpcLa/ݚKݵژ+i@9$>,x3t 8z: C x2QBw8I#za xZ|`Z#auWJd%|Ntx|LPշ([|Ck0rci]4=G_n3g?LQ?-树2ކa/{@ +Kl2Q,$JT#G\WE %CZp0R80իO6 dkj=jzJhFɖ_ߟ bʋ < $3Jg޸~ݨ_c`=9ʋ/endstream endobj 64 0 obj << /Subtype /XML /Type /Metadata /Length 1650 >> stream GPL Ghostscript 9.21 Magic squares 2018-09-17T08:24:12+12:00 2018-09-17T08:24:12+12:00 LaTeX with hyperref package Recreational mathematics with R: introducing the magic packageRobin K. S. Hankin endstream endobj 65 0 obj << /Type /ObjStm /Length 2543 /Filter /FlateDecode /N 61 /First 505 >> stream xZr8}cR]!jKq,gQȴ͊,?炢DM/3 pqs/i-KuLYϤfLk\ʌ \ΘWL˜aB ͜eC<cx$)*M&3 ׂy&c^3Y SB`eJQ1e2)g5RC4,L+\giy4YfRL9f$.f2f,il`XYfh(fFS@=b3Z #uZ`rBKC.D3`@%]žx>_W&1!3B^ bH(P cEA BZĿ~|6ga&p'ȓ@Ui(4^F3'9Hu:cti-QΞb8/&_Jnz!VkxM0j̓bq00hPq`ı!뿾K>[ɴ3O3Ȓ˹?91n0ځ-'+yt9,Ma>co`@0a/'xv@; yф4URcjN`.aZu*ݭб%L/)kn[]:QvxBXp/ v9ПMZE %^WBs?Pp0ד,7T3 JQvk8 WYXZ,@e}b#L%bO42<*_+[|H ŊX$|b` Q6&M<7"YɤS8 ig6$};-|{WUz0%Gzw.k~3p2%,%_k^|oOdoXL.ϯyN򿞇I^HD~0\oBEC?WQ[: nO/? ~8 FY1P\̯q^ z0M=+86:Wi,RK ZW٬q ooߔUEi"^*B"MtLJ1mo?{midˠzY|C?numچ6"u=qjgKRHɐ,ۖeSSa65UUmcVT9 dBm(5`+ F2ez|e+dHjk\( {+ 6VWJQA&FŊi֕YVuU\v֑iH?XGT3VlҊmj6B:ij$;`ԇi"X#MzJjNro4O|%>,'-Ajx7x1۔Y@f&0;fGӳ{;Q71F;Ս9tWl2X F`܌mʅCEhVߋ~U"^˨bn:Ϝ QGԡn#hplbkJ*-! $IB¢ n=TJācdRæw# ǿ Q{"cd,މvG||gh[Zrld~Cu޶e:#akt[֫@B[U~/QIW`&hkʊCH; eVi e*zev.n'ub*B;fo>_n̸,K>8qDrVE D]g w''ei-b7Wg;Ŭ͎M&`Ѷ jͭ?o'PܦefO3/Uχ9(~UVWV{j?^JX36~mjOw3;?{x =jǶUӊqlyװ5[mowu8cክW$ʟ |k1N/+1NnW?uB+*&ZvZ/M'՛*]TBԎv_\_dCcGoƽ2Ǟh2VKV#q*?ѼT'eTa8g/Ū=endstream endobj 127 0 obj << /Filter /FlateDecode /Length 5238 >> stream x[Ko$q |jv9~%$<4%3(V<*##-=lO1+322/">lԨ7 +?<^Wjsp鯛_q87)9dF*Ԩr1ar6v8|ܪeg=hITp<&:*4sT^=q!7x$omp+T*3Dv}3))l*[Ч7_Y/:O[ ;6Y%1 uH^;,:O(uT R6qnvpY'1^)GTN)h7hތ,@;=t`ZZm0Q9A(ˣwf Gq 2Fv¡o5Mc_Ӧ|n'sIna[ujGxnT0ޓX˿__ʎ9m>U VD>\~I&C¡ 51> h]r4ՙT3;`*,R#m t(r1q;hfVUsP̡Ni')YXWäQi<>=0d bfW.KЭl#*L CX )ρ- l::6۟ѻ)g1'e@M7]LwaB'm@x&NQO{tF1xچUUU diCDR6yPfA[ڛm0Evd:`"Nm9 qVNAE\ $I G(3IG{p0B9G l PH*OncgG L6#; !tZ?Q4`zgiS[0 R lFh1N*-(^NWv*?L3m{>%,-}e0J-nvjbm^@0o9"@R@@c8M}^l!j` *-,;ڸuIbә,$L\m VdYřH7sA@ۤ(n6 p2,i#--ث  }1\O,0@"ĊjC/B8:^ywIx;8`ZA 9Ad)NcF\ <Zcwu+L_\x{xnyD ndq_k߼'{eĞ$*m&'h/B6acXiZc!M:y n3RAv\H!'Fh`ovidy19*4)9l I<&v$ E-,iEA/xN\B*!.R!Ιrh,PH9Ws| *35>"'RBYe0FeJqHݐs#7X䆧ee")U3g/3/ҜZ(8 OpP=P t/΀mx('h pu#ufq<) #)QWFO yWLԾt"P9P4E=mnWO=@I9dhqfhKbT{ўUNҐ l >#Ut+t Os*UiZ~@eͥ8y:nq1࡚~i.eX[\]c}\j"H*_[CRdc-0KO bHP65нxN`~9͡zٸNoCF8AB{#d9Iv_ɩ@of??L[_C."h; f;1L.i5xZ5.~@iJ >Չ\x3eƦ$PW)$wo5 ']2d-~3)f n+0 s|rd}}'Q7 '(׹YvS)M$MhG,wF~aBˆ.I[{ /zH#l)6yB @@Af#dzOE(|Wb,AʱmL宩slc0͑Y%v=˅fd>-9d%W牙[mjJlAJ=I $ $RV# ꒣^u>ldX!.aɚ A8l2 5^ue"C9lyMf+D SPrLz^1{\e-~r_] v59p7[nXt7&r9EMm[dS^&(˪Ԃgiq5ƍLV`R_ .x^Ζ0.isUS?2Bk=f*1h[J˖'L]x=RB v!1|iY'dBF[,BlOu=iR[ZY! ?/S[e#P ԣCpR7BPTNZ/ȕ2,j}*ײE-"Z`Um ;`Đ&k%_;рl:/V0PL1R/X\'GLcRCHjE9_j(:4]_ish<Û7 MS_$"D=Wq\]Uрx-e6PΨ܏kV@kHh9зmH8ns'ߗgnVE%N\K>ճ˗xy5L8;pFpQUlb;Yz D &6Vn)֗S_(w''$e ω._h&!9Hny1LnG/ ߵRklִUjZ4Wv_p-6Sm3F.l[fXaj<~'8q,e]2$4v+,&y_3]Z7p/Ra[ħNf5e z3Tt+/jUy[=XZ76S88I.k.6jeAED |Ws&v.Ce+>kYAf\H'g]b̯$=4ƮV|%ַt-|[o TZ z##JTk'~n)_ם" j RdveV id1$%HW1lՕMYTgו{eEx<C!mlO5k8tD,{ߊ>xL#}e\/_r] a4w=[] VS=GV9 KuU벘`_r]Fz px˜X8މ+V2|FLڱM҉bX%bYKN5! H~CHl'“~l. wAPP.@CifMDԶҬnM^}+W@Mup1H]8`Mh3DKf+|![zZˑ]EJ5UK`@VMڪOƚVKMwUX0*mHHk]S[ؘ  ʯ1V ՔV$ρmiiYhhՎ)=[}⺺X?@*5ྊNO5$?4/z?n+(mx!(xOk|khO#S x$`dtwr;Ϯ)͗Zjp#Jd> T󉲩t_M[O@8Ѣp^s3)d^r!"kZjEVMr LZ˪Ш3I7ƅcy˜R寻˘r?W֔ C'yRKV$^W=3endstream endobj 128 0 obj << /Filter /FlateDecode /Length 3927 >> stream x[n3yl"# p$ AÊ($W"M_ήL`jrTJr%'ϕ\]ݟ3uUY&MEgre+o}]ߜ螯71^Eoto.tֺt[zzz}`c^[H` wV2} ʢwB 0[ nr?<۳?}IG1B!zqzuj6IFa-l.z># {{!+aEj{tG̳QÇsJezyr8O m8Z7֑Xh^Gkx֑4G9p]t`:΁CXs <(";/:p$WAhyˎ,B[thw$"K8"Bq\BADEADmtQ8. tTAK8 (Qn) z^DoLBQtсE8‹9p[t`:΁aD4‚é z^*A舂E z:XУRABG(TЮj\ [MK0볯XMLhojcBvSѼ M"MF&4qUhY7՟LH[._0}WN~̬B2s^4B%'PyQNV [%DyD{//Uhf0yU'*h稥rqOt@5`ԔUR}pbG 7'¡fHRaWwaIqfOb6} y=yZ䑴b?FdtVRR' O y'.eֽxQ2&:)q#`ߏѧ(i"#f"`'Md~ɓ cP#N:@4'ΰ M= nf`30}Taf LD(r ?[";%iս -1f4IFg%KLRuǞ׳>%l)ô0ک]{6tN^e#ؔTCZE?|S};V)22v (ֲ`vfN*T~e6 n_'@T 8u-+T~R;Z%mo^XhF "r, ՔZhp1.W>FƣU2$7: @+Ӫ `F&ս`v?'lFm'[%B*Hܥ 8~xYd\#r_v$@+ 7%6H_sx$d¬z:D55UFn"UX3jЕƦ+^N=X')0鶲pL2@xl_ Xu7K V///[ZꨩAn~Y>xb ٸ2fP*tB̔ 3(y8%l2A bK1%&4[ӗD{ ?t~MJΨv^gDV^Gm RRJxh%nBkXFW:I69ʌf %<:^t ss&leKnӊ4ʩP^oT @ Th@28KlaA uu+_%7m@nIGGi3I2bꑻ-4MF=YqrHfOxp U>^]J뗫4%7$ZGVЎe/sk` o :R.Jgah;ֆVu jMX#GTڒx@=I/'Fyc׏C]kv0췼WY@G؇ F^5.Ȏx#sVi.ZXumxxjX+1ammYy&i/'9 EM檠e4m%X>"yzaz&?l\`TR$D{OF +C{Q c̭),zъ&:N NJOItJe/c{;.88o@r|LE^wDx#ce6ڎeVM&QjY${9NcwF(jkRIPbĪ?US| `v X*<6ir2nڅ62(% mǻ\cȴ'q!:XΣ^̈́}VI5Qas=I$nNC_0@<~^M~^Gendstream endobj 129 0 obj << /Filter /FlateDecode /Length 5705 >> stream x\KO8?0w-/Ya{uh 8$g(?| TUP TAD>|^T_gF_.텦^n.FovYe}/w;eq|~slU;ۍ9crwh! v ou×fs3c4k-ep:0<=άvAy%m$ۄK ~u1/˭z_HWkx"ΤOy8lp@ ĝzuZxmLÑg7u;7yc< 6D:#i=q̰a:*w/ {IRq4.r5UqvpLP#Ǡ4|hw> !:njoqF)NVi}BG9K%99J`Z fRac9[\s?åN3PNw1̔l߉դ|#lG!xn[ЫrAIA \Y/n2 ̕`*@O|N jTNT:@oHLXTE]}]ů$9OpݼK:HǷa`N@iޛ 79'l%-Yrvj5ITܷ5ёAWtvCPSNË, N$e)hTSUȀwLӾ lTz~ÖOQ'hE)HIVN[[ H|/8%q2MFy͔Yh2`yfpA8۟ĠRTr]z٭bc2WukCr+6ޓ #vE`79#=X@  NuO&N FnccEf X*T Ԙte\uQ?3 |y?QOȤg ߀YU}[e㊣2I>Uqn{)kr2CؓnP58--BGI(wBX1 6Ic lATa-X)@cDw<Nq"?PpL^L7jMbF~UuE08 Ͱ^U'8q |j:d-x'KgҼG'o.iec-(W1 <'zrϗ]5$-|,pKr'dRFw>%(8[Cι4NPRx_zL(a:ڒ UܦySxSZϛcuP q$>. 1g |2g9XwVtƚOb?9#]xɏʓiE9㞭,+駲!Y( e`vt|_q9 AH0= 53Ug)k䓚3H^ޚ3X2z\u._nL=c x{ ܋ #_"/X71[1mpy+Q FĴK!!Tx~$@O[=O8 Ruas1 /vu3&OśYW`BM g1/UQdnݤ,-`΢;c æ 輶/:qZ55?nqr]&"Y~=/V:"p*3$\ʉuPR3Rϫi?;5q) 0 8+uw`_o\ltGJ1F77m+ch9"@!y2`UsU膳~I"$FܔEt% roV|8d3Or9ueZTN )*7hÔa;uhAa @1WپY.1i%2ɴxL_ZSAx"wQԦ {XӹXN@t/Qߎ520j+[/[crXQuH_87胞e d),(8dAH-tf&º{!T&mlt`9PФUQIJ-MpXeUs*؇͘=.ۘU{唎DKv>}f94UW@k)d*9<IJ#Zyדq{@8؉N;>f5c~ ,bGL$@0y@iL).]`'k&L-tpߤ9)-&, <%t!Fk̼Pk03(!q#:fF)ʙNX dIQއqʶ?{3BFNr3,D"ֶ*u94:T7M-|HB\ܝtd ?fu?7[:x^d5!H;li%"dz ٯ85L늶7þ`>v:'Éq=<^"Ne`TlOMCþ- )f\/d[)X 2 b[׀ɞ7{oZf!;Ke2oVB5NY`vVz*Ůxpv0 *T=5isvR CfHDRR ~rđn?<҂ h[Oge܏lwe6Dp%׉==a4_\RO&v|AU`} k`Q5OTIoxɾmhˎSՄtLV6zW3n@|W]eh5n*L&!?ĝ);Z>pΚ-hQ3|g&܇6BQq-GjPդ)xNyVwjYFY7|=<-eahc`pUadjhdvTRA{8ZKR ٗ&!t-#laL~o2'ae4A*%8\l{A U|5Z b%0ՀgVM_[jo!S7/ }]pV0喫Kga@Q2+c"O#?ܞ0QBx}s}{\x ;fTAxkL4q|ܷP%xa)V^WEkMHAa {CTW`AMxJ."p}aK&f3Pq|sE)PfR*/% zv|}B=,7]v`vD7UZ3"а,,G|RLHj4Knj; .$bnY~tTM8Q,}I b] H7kYDi$l k\e8v*E5?W(Tf.~]B֮OƦ0|OM F^kNcU1fLbN)ݯ=a$aCnf=^N5 :5ޗrma^@멎y[;?M=v1;ǝf3Z&+7iTZgۺ$|ND;|GkzǬk,zc(Z<[S}/*ݬ!ݬ{=s hƖ39EEHLL;k-Qh狄4dN BN ^hgD3bQM҃aG _IBmgwWyQ^꣚216O/0MܷoS '8Icq ,^?rz6 }(JK׀7f +Rw)I Eʣ_F\HsF"ŦUIw!5`ml<ST<]Aw`xeUAka{oуv6rClmcN(mF15@!7,/^UB*> stream xztSWz//@L B/  M`܍{-IȲll1L -$@$$$r|ߕdf&Ϛ{sg+ ](@ |̈́M]XFޖdkvn>rzG=GJ(' 8c3q8~ G@nA"|"țG`^ю#fFD||8 xˠ 6d!CJ|71FJ۶$0M&~^P$-cSU JyjzG:5@khZCL0cNJ~6DXB+C3pt pXݬ2MLY |l-,`m;2O|uAY\Fo"z1mTX^$Cꩋr׭p?vz7ixb?j .ۃ3⛯h:|~b]X봙--z^?uӰP$}^z"\g~p˵w |$J1!Ǐp ,̓,ǷYGʬJyܢf JoTG yǢ_㞸(,}0hHPnײa4>8QqpKYa5xJmƶ[jjk;3?;c'hHL|KCg`0+=DjECG0=e0E+]t1d HL69y7l<:J<OIx 1aFחQ~h߃DZ\͔Jw};GӪ*8#ftzl󺯁AH \#(9v0M6'Ӝ:ZN-YJ[pW,N ^7ףcDq6՝<_ #SDd< =ˌht˨?A?ECLxZ&Rt`zpEtZ'E𤘳6&dA#!6hsor&҉_KT %r@sнp- ??H m&yY 4kc?Iβ]Q<WPJΪMrHgkS!Ҳr*r3+$؏$~y|!ZvW6냥;]|+7r%,_E/ dEW`xYo_"ְJN#)% ئՠ6DrP&#P"Ot}'k7!:j"UNB<703j NydciwXG!Ods?qcC>謹Q 1&o|W_ϒ%%Ņ}n)؆}ݝDk#jL1 NGl\O]qAif5F|$yfmXDylw&fE4&hߩYpB+*ukU+ ["7cCCsV-ܐQ.&O |;w{;$Q'$NT/m^J!?ж1MUhpJ1bȨKJMX Uaae#rQ>%QԄx?ytm DJLiY(b*"" ۚ}^tg˯"i6<7wPk>}ASϹ+偐DVWw9{Ǹ½9+kQ]$ *WqA$z#O:Hlߌc5_qWm#$lz%.C-mN9Z$|FuIOH'xu]VZ.R״_uQ%i h#NfYPuJ4n?kO2FAlDIٹfc!׈cB{ϥ 1="m$:grİ$n4 wT7QgtGOi4ytPug Y,a2#"cePYWFd1[I\7t41ڳ5L{Nh3mˍ!f,&êlj!k&5QdjDW˕5D1Rb:=UNcڟg'jԙ@f?BWAKP_ff/%D>b. 5ؑ4Rt]Q:F~cjn}jXA$l;hv w([pὍuDPWn빍)._l/#l"" dGlF6_~_OE,ʣ m y* ?#$/-{,8U8]:[~iߊ߱`,^}Nws^u& )E-͐|,Y苛֖2nR?3 Ŏ?ϖm1tVsB[A3M$lmXYp4$4j6Ւ&*5;Uz}yq=I53o⾦兞'Õn x N#ynćZF:1]X"& ~|IXF*ewJwYh fyӂfYϭ>nP$sụmn&iEGD߹"_Mӓ!M/|%+O[_-d.9/cym)KS# ?+L@S p*V6kMxEPPxxPPExMMEE q$3ʐS,m\ ,G=hJa %92 !9~p{ -Cs"+(I%.B<2[ m$|(uDNj`74T%}A"Uk>ӖV^ R:hZAPճ9Y5kv0H.[T#O$w#II1dP,<1.>{xb0y?CbNlhb5[zjZm$KBI~Z#Igkw^6-6-hҜEֆZWkUxiN{k4;T. m;lӼP\̨te>6=trm7[)wCoXK&Ϛ77HKNg54aigP-W&jwǓu*̧@% -خus =;)L#COiyȥ^ە>ihn>lϰ~`<24(e+@-_: 0z Z+BT<=$- vqen#ID" Ģ,[&z'Wo_;{^8 ф;8}0(WFW&@??x'>ѦkKZ'3{p+UĈKI^LmJZ}OvͨԟGOg':^\̽IFr!Ƥ7u8tR~0OJ'$VJPHVa#n2;(׸p$ u|%&eBA-FdY-5̚uĻ$iG34 d+ipC ;\R$mA&+EHɿcc u-3~ńįC[Y} Lmá ^^RKH+O3)j(S%I#lt)K֩H]+GhH.2Ҹܢw[!ʴ2-;t+˚1XIg+6VT}SN< uE#7^RzmWzH /Ŀl!! k-+S-[.IL$;T2)_nZr%sO`#ϧK#{tapYy8C}g]?dn `=b?CJO 9qBA vF2|ߪ}0,7q%ް-)'pVҘ- .?)8e_s2+DTR&LIe_̸"YL,M'v0pRw2DZyLA_F$Q_[٭{9yk7[e/gcj< OӸhf.71HlASGW6y5sQe9Kn,5:%V880cʼ^+dR͍C2g;Y) _A:dp*- \cWl}f)0ߺˌ-NOlodx*|̧_=tBهDQvLYjEl$nV=@*!2;@'Иksr&aQof-y<'DWY' ٺ:fvOw0^( L\t[Ēib 'BL9qm9mn0}2uĿgc6BF8 G5Vݛ_O|Uݎmyi`+3}ǨIF^ Zޖ?Fv^GN?j/Zꔒ;uLLׂFejrYfhB{[6;3+8Lp<8چ̴ȡ kj+lGA{Q|DFBg I*~S`6Ho5U^xʋyA5RouY3[SK.*Z j3p^gLMKMvҬXm=֕q ~<#DXmL1j@c݋^O~C: xwIBbqf'Y`2tbɳ[2s-YzM|0rBUi$^g{7K&My%C]1OmXfLuk,cF [Mj= jBަIȏE1#΂ZT'*Hp;ˌ;Q?=.B%ŪqWT?wC64ݰ+BϹU&lm8}#pXwgx t2 2wtհ{t(/#+jm4u.JaAfۈ~1Rex}Hy1vFmw(dfccɿ!.ďׇgWAR5W,cồOjKb{3'E3\T"D5h%{6GB^av )mQ3Zdz';'Ҭ6{`}u_oGXzgJ>A,M?"juj/"k'2F/; ON7PKG8lXF&…qcn3;b̋/={(ךiMѧ-[U^T.9=1ـO _Ȇ~~#Qt*<25aUIdxNDtǔg!ӺPv͊dآpCD#.wof,~NϿpgU*Ŗ2R?fD=6uܝu;=.{ endstream endobj 131 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 340 >> stream xcd`ab`dddw 641~H3a!O/VY~'ٲ=GzxyyX~/=[{TfFʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=土[PZZZ`d{N|q00~Ksp跲ֿ^_n=E'l~];\| pBIOpb1y4^}endstream endobj 132 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4062 >> stream xXkXSg1RSMVm驵wkժU+jI !7NVr#pKp kxiW;VgS{N2yvfx1tͦ ~]a+[ڡ{^|/D>Lrpt~22߃&|OkZ*(9s.^h^{lqt85Y&Y?7Rʂ9d*}TR-HY Sd<7w^J̌ߐKO_.*&gǏ`T-U+R X")(sVW)L['#s8+b&@#C&b3J*DKΐ+ U[use}WB.?MLnk>ADQ퉼{"c-<޴{]R,I-ݴmv S-4ol[ϸBcI8&gn%jVhg"#Y%@ \.w>f RN4{Ib)W$*sW_|$YMueۀ\oqv&5".b?ѿNzvF)SS}v񹻸y'}nlӸ$yUC~qӭpmI?ߣh *ÉY& w϶5=t`߉n~k\].|`fK Nb}]i{|؋'4A&SHz5CV.HUSڽ$TZ;;;hOEB/f`H|[z me6'8E>0Z+SPJV< 䳂 ispu Z3Jڪ>VVcep hxZ7 &sn(.139.qtAezqƋAM/ e\yЂK'BS0AS^޴[PIY'I'`j+]k2AwؾOIRq\ÿ^aHQQR*ZɍOyd+w iuD7pۉ"hi|TTnG);]iP0#qyBPݪk\lVFؖz'oF`G CCMxm{Apϖ3v.lh^zK RˤٻU|mK'謄ZH҂LnN(e'>/ פ[[[Z꩚͇Kj HM't$T5lE >h>Ԥۡ>6Xy-)_P > #LaòM nn ;C aUE[q:;4H= =#4ɬy!YOnYWr:6`AsZeL5-'{g ny!;R%3 SrJR^2Q=W DQHMr QAQg M!Yo{Gށ_]KG藘ĥV*pJ2K}x[[oyj~䑆kg !^wn2+hKyl6&fLHw.BkuҕV)hH_EzZ= zgtHa Ri߯y6L47c ݎC̡"ww@<^YC@}õYnv/л-n rt@ <#) `2)3l:.B~ShO{3C !pیje9FUo|*Mт3L[C xE表$$b*?8=Ќ쁺;n,[%YuДܐL %ܡtl68PEվ]Zƭ׾4P_e&1o)5a݌0Ab4jYJgWw Kpk[HO>yFx@/^K 5uozk2 GqEFq-h!Ms7r@ĉ#0)Ʀ5u,"Z0HZmׅ17t% p ئ6B0@TNǎ Ne:~\oK_C sl>B=³Ǯ7J%t% R5]FU{;!}JN{˱Y.H!N*ovL`Rlhj"#=3Bg|o("oLk<ܨٴGoOG"DٜLBO6\F|dDja 8V{.shLܲǞ-JΡ^w# 'vٵ_.~[ {XtK^c#h!::u 6b o۳5=8AK:T*2PPwp ^1V nLhT5vDt37Vrfzs)6</uNc4S4F<[v1f`:~}ɩo7B}BK+7kd&w-&`6)IJUdJ% oy9bP*$}"w]@5vQ!ĉũTendstream endobj 133 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 204 >> stream xcd`ab`dd v 544qt~H3a#UA,j;nn= ~g((ꜟ[PZZZ&Pnѻ?GMe?$ ^#@Tơ[CwO^o>9m]m| ~8;s rq1Od`_Fuendstream endobj 134 0 obj << /Filter /FlateDecode /Length 6475 >> stream x\[u[$q/c@FF (=v%rD? ?;R]uzvTԹ|Rnvz_~V.4*]ޮ~zX|*W^%>kyR7J ?xFL) ڬ/7[kVla:t0>w#*%FЂV;C2;9~utD|m3UqEZ/bKڹ8yo7Bt riƀM R VlFx0WiO_mk>ݷekՙڛ1ҁ]$UC -Hhſ߲]3aF 4\GO'=ڍvv56lּn7yٚeof]mӷ]ydwȀa[q3Ȫ%LϚO isw-Y}#ɮz| V2[|(_}__: g ~f4vCКoZ5k尨}ּۚv)1Z66鼾>h MA|޾NϡMğ}ជ84g0t.A:Po+);AO8%-%2˽1¦`'~aS, 0Br 9(G.)ӋG1ٖFE״¬;;!.-drO/c¤/l&㊴s4D]&A^ Yz2EYWS!, pui%}]G8hjnh@'.FӦ^ CeU7g638t&w@hP2?[-bxyLxE{YknҊayB_+[^4[YkDk=DS3f+~Úͭ[Sa`PР5mkE>csHա{!A@tbX8=ʜt<؋'ko2 ]Xš7]|ScJqR1ٸ !uݴ̈́d!tZ DO[5N38R KIWeS Izsg,r_zdEkD5uIz? >IT_hRp@q;BrCq%O,de@Kc#$8Є T/t ,}1M*0QŊ;~ΰPGGxM G[ÜH @^vgP3>{)(Ԅg䪕a SК&['G*ɲR2MU誔'Q[:/h XsPKFCHe euO Jr Ec.[!/mæ:`2V̰N)um2A$9d (΋/X. "#cՍ4Gq"_7HW\N$wC_ sJTG)V"":lFݦRjRWlV)?ϻ2]E@2;CȐ($x(E04"ȚwP ~₿Bsg:xȿ<'ONeV~#tHu>Bayy)PYQzaY o @SN{S]k,T6aڀPhHqb<͔gA(XGZ-SZԹ28'G$"#!*H%,j׃O8 '^A$E@J9~T N^ȺY !k{)*W;~l& vW9vлZ7 7IeBёo|9~3c3iEtj╛:MTpQ$~*:a< aiWm(x$[ _t(kx\$M4/Gpi OkmY ⥝_DVLOcgԠ\%F k/ZǾE`Y-H@d=a;:By@dB +Iz,cM1>;GEW 8a6$wZ0xs`Vc"M E= /y!v})F16f1fجEG1VqT6I:TkQp g ' 8[!BKvy3ߜe3Z@sVʞcY-M2B]X#m ݿq-[/ur7QL=sͬr~!U4:Lwe@ f;<)ݮX|q9qcNYwTA$NXOm'^:1;rEF v$i˷U<J> Vë~ߘZ %w!?TW𪞅0\O_|U)0<禢;Xf]yWGYēJ%*46__hT7deNDX\`ﶿ8@ 9<kȞ>&jXpVu4HQBC[On.w, 3S@l6:#% P& Ep4wOG/ ґhi&5w :\Bߗ.\Q( ZAz(Kudw/ۅ6|W-TRֆPBxIד^XY$Y8 ;e} r 8x]hd#?M5fB?*MǢJl~΀;%WIU2>Xa4O]87{X@v{;Q R66 ONL.)aLCj> XT8n@^r/0O3Fq9{!X=aP8;4UYׁBi .|ă^ψ Zv 'e6x&Gt?o$CY?r{ErGW%nZ7, ;=*:ԕB &/PD&%'ʢvznA-~ Y}i1oy ƌIo[7H[ s**ZۤOv(-$"}-4輱@F9༑U][I!' endstream endobj 135 0 obj << /Filter /FlateDecode /Length 1103 >> stream x՗Ko7 )tIz@HCzp{6׮E})^3 caÕ(G<} 8}8Mɳ<{Pu4p;KK(*t%_Zˇ7;HcFnF?񨉎-A=a1P L8MmӠzU p3I޳]d'2boЪ.]ov{ ̛舢yX39Ϡ<¨VPgv]'.;YLXPCuB`pʀ3pfY׹6/r"ɴq=4+h}f]V8\'%}ba1싴H_Kz\re{Z֕QhSR:5 X B|! e> stream xkte' ⢁F$aqe ("ՂH ʥPhhC6M m3LnMk4MoIz!\rmY D஻;usvJÜL><~a<o|rjƺŋF_33x#㘙|`w(MYrfcC χ#񧦢_)(jɅ2<'W-kteKH_h9L%ߕU MRYjO4p\.]V+/\jIg-j\iX*eKS Y tlIc?Ʌ F-SIS e ,(,RdsW,']a/ciX:mabX2<`k'l6{zy8id7RvW?4:MT8A0 I;G:5;ʚ/x4Va/)\M`O쥇d/u<~;"x] 3@TTx=5G wƚzn-'rvERA̭UMMD W⋛;R6>WT.I`U̢ tF"cg ,g_|!1x4GֲfQRWENǮ GqjHoxb_Af~;U>`֋t@Eq+5gvF_I6Zʗ$yuRz'E/̓7\UZ\noQe[K_T . 2h]BC|f>Qpd#\7r8w/"oRtD:l9b0z\zi~4"Pv{}84r2pV@nw;1~cۃe~ \ˬɨ8 Ѓ-aQ%Y vrS0bz'z#d;s[䎺j/r˵dC289e*|g.1FD2;(<*awzmΧt:iIdm[_775bYI+ {82ah~3pN⬧}8-*Ź\wuC>"a"#lg0O ={t-\VA 9rG](~Bow0v$0z#84mr=3TbovC . QbOd+Ѫ8.v1|tpdzcP1m@.vcٱwVKD8nMXz~M;Zœ&r6h J2R{k,%0iUQ~"M>43M>m{WˁٙloNDslC};pGwbS4}1G]2r)04Fϙ9C-}q{w# p ?νp7n® {wN'hEj}W(S[Ah&Ofg};4]$j- WTqg߶aaOpC_yZ e)GنO e^5 v3|Y%PWy[';gN!|t?Fe0d`Սե;@&P-4ɬI2M;:E1k;__rخk#zήFN}!#nC+_2VܜRQy,% mm#:[j݂UdzX r ~3z-y#_?ӊZX+r^C+@H MVVpH`/Kyۿw۪MʬK*7n?x1DARzFW+ 5({`l v2ܨBoP|tm¼✂V]G;"a颱oO:Bbd׽gj!wz14E])G iP-M^tb'Kg4Ddwjɕ\/_fтǖGzW3Ij`:DfޝviVӴ+9|:=ohb`:vp q2 è(bS VZ#t$*2nJHuh17+j% Xq츧%洼FU6O6V8R :3V(Iޭ #Qonro;#JJBW#MIZOPxydb@`M|<3;endstream endobj 137 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1212 >> stream xmLwhh&wF >7g&"!>KPҖWڃ}mi{P, PFԈܒ7[Lls*[f?$>!iʃ%mK7`aSP$LE~TxY9ILޔ5*OufO9a Z /)-]kW)_6iRIjz%=|%jҊoݫ!I㞝;-޼05hI ~DmVZ*}@⇕z5ݑ[ TJB6 *0*~{ : ރ*P*d5c-Y/]+&K-prv,|!鎂n"X`e#\'|` /@Bt5m07NvJs %vv |;Z' %Cvii͕"m(up\6mG5F\a 3 @cv] I0a$/&McI.ؗ Fz 6ulrbz1}hE;&jW@V^Ģ #ݗ\a1X ly e,-)H NĦ#wYiPow*bG7~piwx96s{s3V zmuη9qs_YȽhiWWOW/勭W#} E;EDžҖ*ѕ`Wbءs.KL"1HM֨-H'辧2E*;`ƙfwnBA?:h.= ` 4xZ]XgYi;j@ R;Yʹ9uO%g ɟf)|D?`r=cG~&FT'#HxEz|9ea 'ŗYb"+_(^2 د0d)=n?[?<ǖ)s`0 9J&SY6U]=W5qYH@&?Fƛendstream endobj 138 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 496 >> stream x%NMoQ|i5bJ*& =4+l.TK{ L&3L2 Z4Fd],&N~nό⫳ 󍽽A4fBq1#R2O.h,F"1DR:gQSXQȠU1%EQ¼ÅEzX*ML/`ty4|)qQd,lxg.MpC)a53OYY~;tԩ/^Tn8U^'Z@=*u NRo$iNН{4Еٖ2&9*fRjh4|~n{[vtz54> stream xPLwG*qݹjLEθhb-)Wo[ԲS⏩iєV~)7F3?$ѨYb{cɮ%/{އB(KMP[@i 3<QԒf nGp4pCd"?A4Ey(}]n,廖JeeLZ} .gTn&hQ\ 2'W1B_vU.uH6~뤵J368=> j7eTɾfS\/!f9Gk2ꦞdkmTmH-AM&tq+tm;-o>G#\zWx9fѓbZ yJ@49Ovjwmxi%3?d ds 7BD|0{ G+J,#[4r6|MdW&&jc{X˘g\xM[6W'n_{SN*߻j C~%Iqj`Oxl}\> stream xW\SWۿ!ps!*K*ՊU 8*XZ$ Ad)R'#apbu}cw~#sr3_ejB R7Ɵ M o3ʰQ[:FBdak -aJ(H#SJTv۶޷co`+ uK|Cdl^+WN_$B1K*_򶝭"@.uE]! ۮ7tVRiHXWf&+ (PiX,B^ܩ/q =g{濿aELq֙vߙ=ER(wj=Am6RPΔZJmQ˩GJʅKR)7j5eMKFS6j"ESoPS#ԛ9FQKє%5hST"%pԙ0RpSnikM/:L!ɍ\n~bE]n92.VMV?YϷN{챱cO}r쇬=omA:yC?N5,4e[QLPpH*n̥Ps ^{re5Vk\uO,_DJ%CN:y=fjclMgMVXϿ5<]g9:d ,:2Bq6,Jⅳo\p~or%NrxiVĀ 9S5|az:a== l5 h_.ig;b;,c~&WjyE+C!uzit usAۛǖpa@ٟ.JE=bj4{5 .dc^~QKЃg FPF G<үa}M `8S8 E n$QV&dA4e(;)?7` w[; mL]ycq{659e{P1bq&x/>gb3'G-L""$GQTў(1n;}7]BhY T̥cj3iɐzqC'HŹfqoQ((a^`!@A e{_͈zA{y>5kR+#0Oc<30Q(,{4rdn lb Eg{Y@+PT~ĝ&#;^y/ i$6ΰ_'8lDB1D RJ ɢӫճ u|D B$"/ Q Re,_0*YX*{Oc0$l+4m Ei1IjE*愘K{~<"=lIu\b괕M'#O>[4k`_WsKP7%?w61 fQ&ABmlb th%\狞;{ x%Ci`=F@gNÖxө~R2|'9ɾĖ]xAݲ1 V:| 8zXFo}]mڊKl8m)``PsTKu*]Xwm? 'Ξ?zgn嵉-as坈ypZosrSt#-ۓ]V1Mʖ [1%ygJ^ĘȐ HR&+NpDDf0>g'{BوYNxPBYbY堼 4#G[[5|}E1^0CwL~0:!g*eQpoJ,Bdhn/kcpF?8vuRE-E^FEɵ\B\W2O bC6L`Ťax1xԫ!LO j42R*lli"^׷ssAtk/ߡQ4 rbssI Fye<2:_QL9s⇆j1'be$",Ad6L  h;c;3xޏ!|e5LݦA`#(9ea굗q63_I³]`n|0U7+ 1AѢ<G ^QȟDގeѮ)_AKE\~iU bķPH\Dd? uψxK'~nբ2-!!)QɊR#)#J/(8x{^4!b MzW䔴t{8}ŭ|_ *N/×ebM<\0߯1R[[X'+?~b|}-\<Kੳ>ڻ> B:x}p +4vgr--W)ϐXIX$.S3b eĿA^n} Sjdؠ9h烇K@AR:d]ƒ&Ǔ`S[8ǔ0FX9=7n sz_jQ'#PzV K,g>y:3E4lX Jɀ;pYC&ZB֪E֎ 95KWW Mؐ] .Sz|?OJX?@@ n"` Ȗ?ݹtHC*&JPll@''~1~ @&ذ m] @] #S Օ^/+湸/3Kkh ϓ^15v0M8VYYC;κT# QH%-Rmql'X{o'"^nǺtݼooD;oasl7ΉsZqŒs {t[[.]z݅?>8. ܡIz!oA,>%#쨊Tԩ42EtHP2҃lZbHBN]@bNߛ$ďΠ3:VpW7~uH\Q7~B:KQz^ Jf<6/f X `X mi5oiEӿ\#\ !&w ںMBVl|ªJEDPncyF:(+b ЄwqfNNkOjx{o{h0//eX7ku?yG; 饔&ۥ5xi]{a!-)SZeiLrfVr`AES{;,97PGEuim5ZbFM=wz BpͰy| N_ l^?l=(EIљ()& S3Ig5KZ]˯Wmޗn=~cG-\}ma)~x,/_X_1NJ/lj A xAE*L(Vgʏuq|iB<1KsDM6h_` Lv 0u9XR"^,IC%X iHaBs0:<$}о⦬/ }{1Iߚ!w'?V s2Lxؽll)z~:&ѥmt#&dI$Hx(9 O,.6 *֚U-uJ'm-+RcJQGkj H'8C$pS`6Hrūq`O`%EbW a=oix+XbXZ XU(ҍԛs#MUR: (o񫯈endstream endobj 141 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2171 >> stream x}PSgo\/ʢXVsSGEDV.U"DBg#8$DQ b)SKeV[vƶv}yc/ :;ss~ys^Dp8נЈ]{uq,tr,4ǭw,"fo \|ܸl[8k.:gSs.V$Ʉqr|y֬Y"Ȅ1b~h<^ /@_1^.nX:%%'Z#pA@,o"g!H"*?T+ iL O|!0b'"b+Ll'BD(KA#•I&泶΄9¹Ω,trѻ%3"gT/auwX lDHĠU ε&%ϣe]ťP9yo%KN@+5o+)I T3!|4%JMȿYv.24 ˢ;j:FWa`SB~D;pCه7?*`ꉦrhM rC8&<*15iS_ע%4Z5AgdΫ@]t0~kQܱsYg+oz3C ՘jP& <]#TS8cT 1IS3 !e!x zgœ<Q1ҝ{5qNa"kly4GVm%Pz&ZKbtɣNSG 9qLpP o)qOU<+ D^j5S6KbuA:Bݺ3hԘ f הN_L 21&/JoM2.2vP; -e埖CKIx{AIS'.'R{Z/vb+ u_윻,]mJEc.lZTΒ@dR[Rel^ވm]:^|TT0({FXy"7qF~jD^ "\G*ЦLd㊣@m8?8ԇ<x *b!kދe³7!ͳsFQqAxɦtvy7Fmu ӳGR   Kʂ¢iHG[EsL׺Dv:2!WGpR]3fYe7P?>|ڨ1-5V}uAf5e6fˣELEXwVǙOL\u D_v'z?GWIOfБ _oܩнa1~F{u^nbZFǰmfr[>:9nЍViDhI65:ϝzbT-erC.o7S4RߚV>Y<L!GU.ʱӲ?FwF.r[4'.jqJL8eu%T@l\۬%P ` Œ]ɤJJn K L95yjEm ( ADKmuֳ/׺xO3IOmYvyY_~S?mzF[v&lih^ånufB26PsA9=&kJuP>U ,doj;vNvO+Q۷,K]1%z([J^O|. ;{r{Q}aCmyU 2(]l*4V|\ fNJE=ZU8! q8ƚ*0A]fe eH͒sT?#xWF i |Lh$6bv1[Ut$9r}Dh~iIE(cYfmTzzJrpYp0(&%WU10!75ڜ> stream xCMR6/v7B@vZ  jnc\mqCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMR6.CMR6Computer Modern1234=OQmIK%gd͋ǧj~$`dًËËً‡ #`$Of}I|:}O˪16-X~_ȱЋ=:D\BEKmlGvR%I[Bp$^sjpmza(S(S ڥˋ- 2U9`up拔s8Tl+'yp|{X8 Nry]d;j7nd鎷鈟 #n78&;Fp|H|pqqMzt}R}tqqvCoa  7 ޜ |Q=endstream endobj 143 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3526 >> stream xW TSg>1sx δIs[h@H^!N Ϡ$@#y Zvթ^|ܶV<ά'ֻνNV9k?Ap8uCsG0op-|P%o|z,W .#WjB8T- "2gh̙!U\8ANj"mQDŨEA ju3RSS`JhtQjZ*J'ZHP֋1"wP<1YSQ%11a"QJR'JIGG+mg5mzDL@L$6b+NL%%‰eD(x&+0b%XMXG' b4%p/QqA{++:^?IvSHgOudt+ߛ?o_hp0ގ,X5bN/V `3 nc J}D*;(ϡIqRSa, >$oy4oViKȆZc/е,ǠTNcIcE+W%dgNC?|isJV4jbkXf@-Ls?|r+l8{ޭ+q Q=D"}EO2M#3iZp4G#OX_/PĎc< Bc+`Spzmve.:ϝ5舷Չ XؤڣHnw65ǁƱOPhG;gƥY,ޞc?$5w+3О^{z ((Go"@OِD%ZY͑ujGOHv?QpNAM*L[ފ]Mؘ9t=dG4;_:]n|Y7Yx|.Y蔵=sT[{- b!kmޔ TJ[a2j LŝQ]Zө u¸Uep:^5"J檌C6 Jjp1h]#`&v2Z sj)WlzV^9ybT&Ĉزpb;_Fӳw :/@_4wA;[N%a5My}kDPP -"b'|!Dn1V(mWDl-c~]|J( .|]D*rōAcat\!Zkҙ@Aթ{@ &̱(E#R(#ƒut;zdI HЁdѳIw4h&/mA_ѵvYk:1]DHam 0 5WB!;vc6 2@c^q,RMe4hA}0U6.[[4qp;*P]c3}N()Ҙa ˊ(7IRO"雓viзbq|Kb+ P3#.,Yj,vמb~ sb'6ݒw! yxE}|m}UTK{vq'-`VFdCő 3 li\:Cy #T]lkvetr|l;DBL}Rk rҎ=ge1AY$!+/΃I7m_0j\/h5>\`NԥŸ,apOC"~N6&oO[ UpRk B3ou_X[ˡ^@ov C| LEFEcڈWv*]pMS; Rb*2@iTt)w!j_f5z #a BZ̓ag"phGеW"N-b5yk"*㛈=OJM9ڼ0nl]&삨stRz߯n>$6(>A^yB=]ee2AN5I5Ŝغ0d\ ?Q24]F5P^9Ơ0ږWo(Z!ҔUUYk TX O!C7K3:B W-iHψ;6qb[Nn1րkU]l./gw Fz`n>LUa,a>|6/|k겏M,8jEkV/wsoh5O+aTO|.^'A؛Xe$w(K9F=]i2*!Nho`VNGeВo$/MnUKI t 9X1 s`RFx$Z<t. 2cl’PņPG-lЎ<MIvݗ]W nJnƂmjcYDxDp"™ʓ z[  IkCb-My% "$KN'$ncg.qq-]A $CfXQ p;shi!dP;jS %Kd~Lj!o< ZqFAmXi<,-DzX~{u4-1l6h\LvG d<ݔdP%듚)K qNAUX'GpE{Gٞoo 8iϴ`16Nu-] 4vWgpbe'BҐwEGpr1'AjMpVXka٘/ =M<6t%53P3 (4 endstream endobj 144 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2158 >> stream xV{PSg!HJn}_V,$  (`y JBCeT]ͺV'v[GGZGgvؙ;{ww"D"r ]os)"M/~xPd*ڊeS3??1yo_ :IX$RVjY=JN8C6gg/-OղuR ^&Mb˒-QrvѬYaf|jLnO!S6 ylFɢS岑&VqjbE|Dx&)T‡%&K?b"Ieo#~E:$^F1!yy_LtHRQYeg'|? C8 t3 wVə R2W)*;4=zll.-h9`Ocz Sj>΋t8PH@U-A4 $ 晴 d)}vWUT Fwlǰ^x쪫fp*|H<p!"oFrm孇7:{Ҡ PRƔnO'l ݂^8D6^+ d7žGPEqD^Q i6h8NS!Dz"q{Xs:,SfٚUδW:UExq)37aN0]BZ dߤDÞ]hR9)gHG# Mv!4 Q+$m6ÙJln\QN$8Os$dNڨh5{Q`J3WѪD=tpP/Bhs+@T1#' CBc!O( :#UHhPIiIOk5`*D(cKup:TlLP^^ں“z(&]_̮Ig"dz_9FqkoZN{_0iߠ\?E"'.1Ư=ijc.<jNrR"}/,BQ' p=bt?M_Xoɦ"%T:v2[m=# Ndl_092ʮ -[^x'=~P36 " >lHY@܍ =,*3zP $N3]lI=Z[[X M`O.23{W%jJm}'-f+3;QZDh; kOQh(i;{:|n^ ?[YZPmCao2x'CM%1N 9P+4ud5ְ} X8Rk\Xm/ah=7ܱ: lb,Ȟ Ç_y}PjA֍}E:^+4}ٶ]MJS/9E LQ]K%[T\R&Ta>sÏk> stream x;nd>*} ,"@d/`G}Cь=-KOO"Q ],ug7boW+yJ_77qf"+Z*7AnsvsG5 b!՛/[1Cp#!RMkl0v ##q=!„mA2DCB0pVU"ɑUsvs#j_$=nzI[=*e7g F a@C N VY#;^:7268BWxHȥf}_6 :ri 7EFvҹ h>d@qAx1^Z3 pY1$N}+ gd'5li•~j{ÿO,1Q%R&|E!N@oc\2&=: k T.iG-\fFyd|KLV8BJT2(P(0_Ow'* v#Ύ @Vz: Dr `p\y'D Lp(#2_TЪ2&vxi([J;r$ ċ {h~F`&RAae%Ҧ.Nd%e;P`Tt]JH m6`HɃH 5D;\j4K^+:EAq>5[î5q2g H RY BxL;ͤ qZ?`Mo&,M ̊0vs\pτœaK)N!6`0h w8`F_Aý*,8O8c4S 5G@B-pt u e_)ΰqDv|bālONwGad1n/q7P.m N%vcL̂cBՇY/ qО, Tj `]"S|J_9qלŊs$Īs[Ep곉v@&UG?G9*b"e$Ő!$/{k;'e8=pHW "'c9{ 2 \NS?6a])jv0Z|riH*M9n<5ܙ>xgt=?*sٿ'R u3_Gə!~A;pre+13j;}9ɾMl25]__DY]PWˇ~ | q^ˇrҌٴЋ/B$ `qOWmObhT#/ ^"l,=a!9gu[$n> &rNꝹl<+;d]Hcpֵ%f0zRN 4`M9%Dl+^~9UJyMm䔀i5:oD1: všPL`夆}9؍̞ 0#b̏ |\zgnawq&4"Ӧ$kT)I".P1)s顊|\/NXp9NcR񚇳pQ[~ Jn79\)  !^=_B8r\.#hQחh@f?_{V 0{+rI?q@H9='W 8]:>B`ɑ@,E,,@qq0\t3|m^dZd3+| \dZ$'pZvZ f+VXsUkVn %VQ EVIbD+, tIbD ,zcfuU,@qq0\t3Vg. u+:]`. u.k:f 9|??^D5A_O}8P7ΠFovC itC :orǠF 7r(mWD攧ê(hP': Cs"Lt@Y(P耲P6<86&H2#W*^l^X+ Kln= f4bSeS 0􃟃as-c_x>U ZD~'2C-[!FW^+t{){Z' Mgn'L %#r_+MVY`k O..{I?Y۸'g)֞ps8s #N9z|@nEt~~0\ORbۜjڕ޷5ȝ<`4]uҊ׆PlV󵭖i*[t\~CzaU=Z*1Z9Rv4LmuAJ16]3.TtTFjwZNEG٘^2#P,xA[s`Ϧa-fBYf-,s'kN]#BsO3Gg&x&xPTb@Ѷ@T,}a$I`{A`J Iy؆6o6i!6d*c~4fH"KS2fe LMS  7Ӂ.kMCP$hk)B<6yaIK g3dZ`ZaFcU]椇K9<eDQ-6k×6|jÏm6,zcن.CgBlYXB 9w<4n6Af)cp&h~@_,NXfhlTHIv#Xq=@JK1ڇdTAMBPPY8Йjk}lh́d!J[1n=QaOujΓ&\C[z2@i|ʡg7 ~5ӄ:R <:o$5(iW}: VOK0mmT>(]=yn4z,0^S`J {&~6DD 5n#&lw\)wi*Y PnFɍ^@J!RBl$r.Kļ/Thb `/-3M\1JKEca}OŎB;;Q)7XM@B%| wHm޷/Nmu;b#-fgt[OY"gq+ kLާ"EG?8nA%w7Jrf)$f$!H{Bn0RS0Xxk}i1lendstream endobj 146 0 obj << /Filter /FlateDecode /Length 7218 >> stream x]I7vv؞@]a/agM֡M6%5Zݤ$g-H! YՔFBX75^ӟ>]7W~ݔ]Khaf*W$>N˷W۰{ukԤR/o>a&sJa{zm׻vrz۫fo~JN-R.m_A* ;)m[ i{+\R`foBnXRLmi&z y;ici90iER~Zkh#lHml۾ť)erx=٧Il jk-uvRn߈s3 pM Χ;oWZN~/Hg8" :$6A?4x3p~CL A8q8/ೀ?:ggCS*;FB:a뤴Zz h~g򑇰=~?yj9{v{>w~uU0>a)tFʉ*jv*gӋQ@4~m}K'mbv.>k/D9iJ4: $Y0xǤ חWb 7ɻ H:$Mfr1TlkcenV@{*"D6q7 ~DSTH)@h jB&Ʊf]{aYr#+K 01<䁹[Bx%S&pca[Mm8 t$`HkXH#vH>b,|FP%:9Ԅ "#HHrkwMiO=,i dxo-H5z`Z(84R۷O1u:M`R@d*3 }`G'C]Pi]aNNqkPE×Ԡ[DDٻ;YwQ5B +Ԯ#'ك:4c#Z[ rU5kص=Ao}9V<ݰV8,~"V~ޙ^] N{U(\Y˅ڢzrQ#j_BG+s$8dFc.;\PP@a) 3Ӌ)X PNlw͈zHJYEK= u[Z]ň*7HSCxc6Gz-ѻAP[8T]VcC[g4XRX GLAzhfY~䢟5Eb%8`С3"D3KU\^b8P(ZQQ{yךi VD )!{CN_Br1 (٫GJWx3LI;~PNjjoHwAS@mW΢vR/ox  sg~Ca[.?2Csi 16p禉Mzb,*[/-)۹'9xK:g`<})=oh&dMili& yxN){q*-+EG-q?Ƈ}s;'q\2001MBabB<𰅅,DΧuǂG%N3Ч0w<tSsaW7SH3_~wqNw8qI (WًZ2:4[}AʘH_ѷ궗}cr7B;XnV"H_|TU^UޭCqJSk Zۺ`B+?2d?߀*h(m-xn5*ox|M?/FKʤQ {`f U/olp2S-;ƒdFUL>}98bL:oV'tv\-hŷ(,Oa QXߏ1̥Z95@l!9~@M YpG6F,t&c DI 5;Y#ay~0)Fd`(~K9ق_ u'Lb{&6)r^zaR Dt(F[LY[ ֫B ֓ Ep8"De!f>Kۜh)#gvb$4:!1m B$܎rW<: u)?8JF+9Z s1Tcҽ%P{,f`mL; x-: ?{igAQ=#hS-}"$1l-P$^*d M"L6b@hM5ٞ1 AR'=ĭ~pF5%uĨ^6:°<|F299o09:A4b5!9`Ys @oC6]:AϦ4.I]@#(W)_J0+ӭF:#T)mv$=9Y|?)ψ'3Qxe: M]dH+a$LeqQ&+}}}j,FMMOyE4D*nAvl1n rҩ Giڞx9t{ɌŧX$'˲s5J"+F=!@H#ZtX|jvLzS)f#d8S8A]'gY?\?\@?n. $AO:#>;G !Җ Q23mzF`ңPY ImryzY4i<^MN69vQ'%l%B{xE#{5Ry/7ϮIj7Ljo` _k61/!0q70 ܉znQhΨkfkԹs&g/ Q~ap%Ň7׭쁉t Ɩmy@ Ɲgw`WBЭ(K΄| ļ(G]t BmkDDiPi2͇My>.k8Șܧюys{QDKPA^OFALR?5Q'5J1.Z.~DekhmEJoql7%An^# [ ~ohNI(_ZL#6l N_)LICqh +7lP-V]i} ǡ\O$~!G?^&Gpr,y靿-x KX@eKAiIے ,mʋljAt y(}bк#sz;I ᾰCBMe tE߃KuޤQ+W͹ X,N wooe4(e{AV1T"j\ub[= _$.9IM`B%մyw!:ߨ^@(3/~LGs.yxڛub0Ǵ7j"}@4_U~Ht\Rwo,<_8@H`Gc=?Q޸:Ei)ƻ,z~quce` c} κ"bPf[ &) M!}i- & ?._ pN{Axg,$ {DZ`u3J=F4z6M[k (:J @ 7^d~shd.%ݚ]@ZO;ה.@ 8O@}{)bn&:E01.|13*af%f-i,};.Ɖz y;1"5~dqA"0I3˦ț 0UCeF `V<Z \+ŭ۔'m/>BʸA4K.%NڵTҹ;l?)a{KvuVơ 8t+w}M[~*~W/Ft~FL H_{7u 4kW@6d;V>3|ta!\?1Uw;vRY"9zBśu#_FֿNlV.@L|oYߴ٭ެ;?>4Q1\o>+Z6avRG=rf߾ f$^י\$S> /9'oq]7mx^ Eǽc3^RO3-cnh=" 3&?-HXޒtZ!D y9{o;ziCSA눔yNYTss0a$y|6<>QZK/`7 /? {j8tdQăq[xL<:C?ꎲbC"sɞ M=cV!U1o~G_楏S?'ة w+Gnyь}]L-($>1Ah}uZ`~9q5+nz=TS[v(t~Ir^YrUBGVIJv x뺳&Y'<;~k/5%q%9e{@3;Debuvu ><=fH-Y~ 0n}Y+^y+͸u-;&PMM:xcq=\&bhy;=wȝdPg rLJ§gv;A* gWG-֚ZAm`6i!8c\}eaʃ=HKJ!ZBuɭ MISZ%^?TN|C׀X@Si |dx<7.&"<. 4+6A’ʣIeCBgy2c2Q9)ʆ"GC Ϳΐؕg1O-GW&([X _OgE1h_=Kt fkc8~/j/ u+w,O5;7w@59烕_v=?N (SbչU#W}͛a g]shz4Ap9CE6؜Aj#DS!;@8I2_ss86r#)z\5‹2~>Qp9?#9鐼YMQFV!eN _,3G{A!'ElpU$UIkL|2QwSb[]y_/0endstream endobj 147 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3838 >> stream xW TS־1{ADUj:[Z}(T(IdJd  N@A'!(V[muZ]זJ[_ uXX!}9gw$0F"<^! 'HxRh\df۹S$'ύ~k4~Gb(F*Dk=v'ƨCB\`//p]ޥtVƅE(pWߨ]꠸Di^8gNBBleD쨘WtMPDžn zEEƹrϨqA1QA1 LY;&6nUjMr*qw`Ѝj߰[8ۙag3>$flb63әיƏYdX"\ b@M$@eC

yoA@8 )RkPenCjMk '^X{vURp!d6L G/d2Iiijk`nж|Wr̥+z -Fܔ^ՀVNH^d8U1x/$y88x],Ys^>i^b;CƑɞ~k3rgq n17\tjB"2ﭫ3wm9K")-^|0ͣ04T!.+ ?)SIB.U* .8*)K^e̅'c@ɽu=QBf8 e$‘SoB9\ħl9\jQm.\[r݃*歈1 䃶lWAN =j#ւ+%?db8I2 }24it&Nn [V) [$8 m'Z}YBpHMXga7`L0B7<ɩ?a)Shr_ chIvEe/XS?|\{>ƅ2\goapB.Q^dgHρG9" O%S!d`hCl:ցmgUE"f|~IYTq l}u49q Y~ =v j *9Z+X|~YN۶"4*H#[p i!b[Yއ.Gu 8Y Yi d8`->NƇ?D sRDt҂xWj/EKU8,ilze7_5_ٜXPV-[$ jA X"HݑKJy0(dU*j8"ϚMe>2MQ*Ņ>n߳HmGys^Ew*@Ni٨x<6*R(}xEY)#R\4a^+ R 5dl,6[QoTs͛B(Cс/N}CJݳ{SFcYAotI)[U:sy ڥX7sp*z4!O>?3#"8'ZX:剆v*5E ىC"pq Y铁Fq-#9#TsE#u楕K(FqFdGB#g!jV鐮7mϳSuWl~\J&>| ].0oaMY"+_K}>mKy5VmW]A|M5jo8#Wv@d2/ J sA)^ZO#&p%yxXR8҃}f:` ֠Z18ĐX2L%!$]0D ~ k zF״--nuӎ!bo*R_ޤX3~K RWe螭=GB({~d Ii{AjNzP e$1h (X 2pc2/hoL'J_sl2#;{4b8F)Z|MpuPP] jZݿo5(\⇷cXIɻ})iպp2w|r4`rTVgHKbA%hb"Yպ~-G35Sh^!vsdrI _Y^-?[I>;xu?!bKgZYAaҵDjXQTȎj"W:rD&  tY$}ih0^)i>IiED5e))B߯v:~D~ڙ[jZNwW 'O_ȭAE{rA)X.{ŗmK<>vh|Л8ƻDp#fuNRP\{dJӻGO= S/|YwSe"'v |n=Hñ5i-=AmK:ZO1$:B67l6JҎkz=RY!7&QI)_oDF$6'I <j3hx8*L$)|#\2 vC]3#mE HSM|6ˢ=:,jF!<-9њoO˺͂sP B 5!KM әl]!TNnѼ8C:޻rYX/D'iSaSEYYX,#;Y#J v+Z PR40Xendstream endobj 148 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 374 >> stream xcd`ab`ddt v04q~H3a!S,lYԞ[|=<<<,k?^(={3#caes~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWsᜟ[PZZZ`ȒgP./}"zj֫8G펓–^ߐ&{ r6NN-~oY<{a1sW1U{w1 b=jC.7{BI_r}b1]foʋendstream endobj 149 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 879 >> stream x]LSwSzh29=%b°u!P\qR=k+rVY(# lE#ڪ ,  HzBHf>.{?ֱl׻x1Mwv|-5K77y߃ʷ.7BU0zU=H]zZ>ӛQx)M &JZ./5O*“d[Xߔ:}{NbNP$%.&^:blk;W~ny4NpݟIe|ߊwK]Q,Q~)n4w!&%N-˅g<VK4=b7Qe^#<)uζc+΋/rG+f4f1lY "B1 %Ap@ӠNsJ:uoĢ̂/EB ɡnv;!ن%kfnTԶBN%gZ#cp,-C)ى 1<^Z^Ʀ:\cN&3''vffV #x~'hphcVi&cSy4ff۵$k43$tdNk$fPSk^ yЇԂ y$囙tgBxxlzuvj]mfROp[uWLN$>)Ic?3[@QWmW6GUjuaendstream endobj 150 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1363 >> stream x={LSwo^YV8 At-< S"0 >P"ǒcbd^ ?j#99=_FD":vSLo,&Cķ@jj݃̚NHA >*o]$ggSӌ`UbIdPŋ#ZuVJSlRZT$UjI:hXhQnnnRkg~M7) ub^gT+j;ΰw)V6),EQS F~C%PۨT KS~K+APOEV}=n߻/w, pbS,ꙸ.&%衢숉X'a.E$T_. _XI:ph֜Zk%Fk$u ּ^膟4y.h(!$O" 8w ߗHDۇ{qLb,'wl“;k_u?t=p4;䪪Lc綵ۻؾuecd.CyU]Tt?m'syԩVY v`ZB㦊JK2ThI?UsF!;F G#xB_܀$AohaPCl%e{;.\n_wR]kQ2OYZ y tcsU. e%:D 6^d.-o<`-Nc 0O4Yɓ9bvY2><\قإ32u:n2 ^`[f ۟\urpnQ'NqIaܔ_~"L!Є!3bF\BXMUE\fܧyp~M(8e42Ồ;8pJhd9ҫ`&+.ܠ_P|VY_l~k>g2TY-BI>Ohm>zu_?(,[ųc`>jo)9Gu[+0C ;K#~@o}῏!;|r> c'1_Ѐ{yqNK1ܔZ&Ezl@"Z} Yzlx#"hxd6$2ܕaN3syA^|OKHvz=cEtJM*EEU*j&endstream endobj 151 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 825 >> stream xE]lSe߳v I$aX11ْbDq!dZm{ӯUُcXk;0Aa u8%1ѠxaJ$=11/y.=7 6lmǩE}RmPtu576mG7:o/Zm"=Hv(o`EWSdv;V --V戇\XyXq}q3o'Fݯ:Epz^}y/vNͼ{E8 Ll= /BHe]zEIԸ~ң/(;yR֑7ixVY0?W/_ 'Ҍn;5ܱd )ZxzǣPS 󲹺r/6sщUwypn4'g̵+/F 9J 8` FqdL.&?Z7vSiLyW+eg̃2%ߜ\ 1@:I7`!1+W2gN~ss?F\I]Lc.pgyyv\k7?('HmotdiMocK})AV+y9_1O/ԥ|p!7 wN9tk7NM3Wn.<X4lH"ѝzV Եr +:^6{`=r,7dVnV+J֫AYm$&6_Va54ofendstream endobj 152 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 372 >> stream xcd`ab`dddwu041~H3a!Wu7,lYԞ}|=<<<,˾^){ #c~iDʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UT=土[PZZZW\ 261%G߯j*x77vuvK6L+"ｬElE~fymnſջ9ز}qҔ޾~)o{UKLױVՕ#W>Mw|]\X*y87Ob^㊒endstream endobj 153 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1025 >> stream x]L[O)cg[- Q9q$ ،#n& (p(0i RRJJ)ӿR:h'D(ɦen#IbG oyHr"R;W^p/%qB v@RϝIb A<ۣgXiVERcW۩&y#Mde&#VTSLIFR!wLUDD曍4>}^ϑ)49*JVV6oRRCR:(P)iX =̜R4IEzR"r@y)CA#)d䞠#hҦ酪p>to jd\&833k/6) 6DKWUYX]]&GI@ V&e2{T矮JJEZ4+@-?|kϗmfah766 (CAσgTMg+o OI7:@&h uq]_Dz<.:p*Op?=%Mec_f_3%U %{.楯}X =o>]tCkvÊo$a n'󀮇"Z^uBötbNcO؂l9I oYvy&nĬ;^L5[XPphlr«:LUߌo9O|vs=X -v%>>d8ḫu{=`جzLWXbH/8yAɷ_ ᡂ>X|3GalR[E=%.?~+^~]'X[Z~NeZjpkP1>3NdpnUjڛĭIwǺ;MAtAO6>S[kS8cbwiCQ use<ѹ?& 0*sѬźx:0o'D'U`endstream endobj 154 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 702 >> stream x}Oq2d޴rj\rh2E z 38@PDPMӭf޴V^1dUy< E ŭ Zp N"*UPɵ+W)DU=% 4(]*+suUztjSi-WNvpچU4hipjVjTYYukM8e{$Acj=_V糑4Na D;&> stream xcd`ab`ddds ~H3a!RVY~'ٲ=wzxyyX~&=C{*$fFƼ&ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UP=0霟[PZZZY4t<|'㓟?^ؽhQiwlե%% g/it\;wb^8`4endstream endobj 156 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 374 >> stream xcd`ab`ddd v541H3a![OVY~'ٲ=/zxyyXV.X{\FҪ.ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UV=ZZZ\_ZXSWhR߲ ~g;ODO4{Ǵ) mMrY,23$fvusL2eڌ |f@Sju:ۻ%뛛.twlo-b>s, e`[9endstream endobj 157 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 461 >> stream xcd`ab`ddpt24~H3a!G,lYԞS|=<<<,X }=C9(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMU:UJ;)槤1000 &FF?:~4!G7k~ Yڝ֝_V^\Q;{ʴ z{{'.s¥&7TW7&˷7&Vmn(]j+'M0ym3|뙸|ǚecƨߜ -UG}]f̚v̡- M]2u-;svxnع̩EjΏ߫̾;+Ke>~>3endstream endobj 158 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2718 >> stream xkPSgOģu̶kmUlmֶ"HoDBL !K I\p1rDmk^nkwwֶۙv;o=vκ93(bILX"-+DTIΙ8#Io>>z-bD\|| ,Đ(%|In>|šh!ZL@I(9pq{mr阂 rWR<ptf-`GBQF *#;!dnBe%{ms Gޑ?8b9h)Zz$Js%^9׵g'oLЏ 5'j.2.\ۆ>T աAnMzs}PWU Ǖ&_WC;NvQɻyLN9Zŋ~hQvx~8+6SE`5N?;{p=('U-CD5d(q q`\Uz9#TG?'n%5o2cxgᐲIġ Ojy'^3C{9g%67ynCJ+a 1/q"f&'6B5s]CK"4kDT Ьv6kw{T$;L6jjwT/W[DzQJKxЍ=u" 5*>\B?cԹVXK;> xT,U+@')>:r?Cx`PˁSPUa$Jʗ^bjk[4qҥ[&8Vq Eb—7i4\uNl1dq3v'0a 'JTrBg71e5yP~ers,ԣC] wrtxGnVD\mYcaix> 5 ^}CYAժˀG9. w$)c௖*5M}) Lz4y{\mY gj<:2XM;:1 #Q4AH2lٕ[QAPwPJxg_jO\9v/g4\M榧~ <hn&; v iai&Mc!J=×Q \Miuvxux.Wn-QA1.ܞ` ^t.Sg5:.j7Vdcgfw٣}ǡq+#"3D(e9Co5iGʹt4\,u/sαBZ1RuF dcrT=6?wpB\D'-L? NwgԹ3H:!·CAO d:ֆЋ,uz 0u@Jb0@-wP{9@b 4+fǠ@ֵB-xKm]fphth0Q^3KR0ө޹qgv!T_P?x7٫;e^ecfG%//p?6xal0o1WZtU婒KD8 ",kE|8CL/m n4.owvA.h xN#fU2Gut (Ul 'zPCx]x?vaKendstream endobj 159 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 370 >> stream xcd`ab`dddsu~H3a!nVY~'ٲ={zxyyX}/L{1FƼ~ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=0霟[PZZZW\ 221G߯ jxW?3ENž S?+CZ+/ XfK,:0lj=WK'۸׶;VƷ*Ke>U<> stream xcd`ab`ddds ~H3a!3VY~'ٲ=zxyyXV~&=C{*$fFƼ&ʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UP=0霟[PZZZY4trßl?ͿWΝ׽pAyw=lUe/i4m\۸Xy8b^`endstream endobj 161 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 343 >> stream xcd`ab`ddp 44~H3a!3,lYԞ|=<<<,+'={3#cAys~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWuv-(-I-ROI-c``` b`0f`bdd S{='85o~Wte '~ ne׋!۹Y}} ?D+}gb[Q*_s/wt\Xpa`|Vendstream endobj 162 0 obj << /Filter /FlateDecode /Length 578 >> stream xSMo@ oAOOOKjI/TmYmA{ζhɔ~hB$1,ntN.#H9R0>+a;ܨ?2ʻLJRgvdP~@:.F&vql1!Dr} Z[ 1R$?jdQT:g~B=tJCі01z *nZ'L<;~߇ji#E]%[p{ߥxF,o› L ^Ou 杳.*4N+\W;mۢendstream endobj 163 0 obj << /Type /XRef /Length 170 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 164 /ID [] >> stream xcb&F~0 $8J҉gvf; 7nO<d9B)>D@%"%H֙ -"@$ X0X/5""'$[lc$X^,Ff9L1` H B=: ?3`d&6 endstream endobj startxref 91359 %%EOF magic/tests/0000755000176200001440000000000013346315414012500 5ustar liggesusersmagic/tests/aaa.R0000644000176200001440000002211013346315414013341 0ustar liggesuserslibrary(magic) n <- 10 # first check minmax (NB: includes checking all zeros): stopifnot(all(sapply(0:10,function(i){minmax(rep(i,9))}))) # test magic() for magicness, standardness, and normality for magic(3)..magic(n): stopifnot(is.magic (magic(3:n))) stopifnot(is.standard(magic(3:n))) stopifnot(is.normal (magic(3:n))) # now test some of the specific algorithms: stopifnot(is.magic(strachey(1:n))) stopifnot(is.magic(lozenge (1:n))) stopifnot(is.magic(magic.4n(1:n))) stopifnot(sapply(1:n,function(i){is.square.palindromic(circulant(i))})) # now test for magic.2np1() giving a generalized circulant: stopifnot(sapply(1:n,function(i){is.circulant(magic.2np1(i)%%(2*i+1),c(2,-1))})) # Now test that is.diagonally.correct() in fact extracts the correct elements, # using a function that returns just the first element: test.corners <- function(i){ a <- magic(i) identical(a[c(1,i),c(1,i)],is.diagonally.correct(a,func=function(x){x[1]},g=TRUE)$diag.sums) } stopifnot(all(sapply(3:n,test.corners))) # Now check that, in a 3x3x3 magic cube, the second element of each diagonal is the same: f <- function(x){x[2]} stopifnot(is.diagonally.correct(magiccube.2np1(1),func=f,boolean=FALSE,give=FALSE)) # Now check that the first eigenvalue of a magic square is indeed # equal to its magic constant. # First, define a wrapper to ensure that eigen() returns an integer: eigen.wrap <- function(M){as.integer(round(Re(eigen(M,FALSE,TRUE)$values)))} f <- function(i){minmax(c(eigen.wrap(magic(i))[1],magic.constant(i)))} stopifnot(sapply(3:n,f)) # Now check that the sum of eigenvalues 2,...,n of a magic square is zero: f <- function(i){minmax(c(1,1+sum(eigen.wrap(magic(i))[-1])))} stopifnot(sapply(3:n,f)) # Check hudson() for 6n+1 and 6n-1: stopifnot(sapply(c(6*(1:n)+1,6*(1:n)-1),function(i){is.magic(hudson(i))})) # Check magichypercube.4n() for a range of dimensions and orders: stopifnot(apply(expand.grid(m=1:2,d=2:4),1,function(x){is.magichypercube(magichypercube.4n(x[1],x[2]))})) ## Check magiccube.2np1(): stopifnot(sapply(1:n,function(i){is.magichypercube(magiccube.2np1( i))})) ## Sundry tests for transf; ## is transf(a,0) == a? stopifnot(sapply(3:n , function(i){a <- magic(i);identical(a,transf(a,0))})) ## NB: following two tests *removed* following redefinition of ## "equal", that is eq(), or %eq%. The _old_ definition was to put ## the square into Frenicle standard form, then compare. The _new_ ## definition considers the square directly. ## is transf(a,X) equal (ie eq()) to "a" for different X? #stopifnot(sapply(3:n , function(i){a <- magic(i);eq(a,transf(a,i%%8 ))})) #stopifnot(sapply(3:n , function(i){a <- magic(i);eq(a,transf(a,i%%8+1))})) data(magiccubes) stopifnot(unlist(lapply(magiccubes,is.magichypercube))) data(Ollerenshaw) stopifnot(is.mostperfect(Ollerenshaw)) data(cube2) stopifnot(is.magichypercube(cube2)) data(hendricks) stopifnot(is.perfect(hendricks)) data(perfectcube5) stopifnot(is.perfect(perfectcube5)) data(perfectcube6) stopifnot(is.perfect(perfectcube6)) data(Frankenstein) stopifnot(is.perfect(Frankenstein)) # Comment out the line below because it takes too long #stopifnot(apply(magic.8(),3,is.magic)) ## Now check magic.product() works: f <- function(x){is.magic(magic.product(x[1],x[2]))} stopifnot(apply(expand.grid(3:5,3:5),1,f)) ## Now check some identities for adiag(): a <- matrix(1:6,2,3) a2 <- matrix(1,2,2) a3 <- matrix(1,3,3) x <- 0 dim(x) <- rep(1,7) stopifnot(identical(dim(adiag(x,x,x)),rep(3:3,7))) stopifnot(identical(adiag(a,t(a)),t(adiag(t(a),a)))) stopifnot(identical(adiag(1,1,1,1,1),diag(5))) stopifnot(identical(adiag(a2,a2),kronecker(diag(2),a2))) stopifnot(identical(adiag(a3,a3,a3),kronecker(diag(3),a3))) stopifnot(identical(adiag(matrix(1,0,5),matrix(1,5,0),pad=1:5), kronecker(t(rep(1,5)),1:5))) # Now some more tests. # First, set the dimension. Feel free to change this! n <- 6 # Check that pad value is correctly used: a <- array(43,rep(2,n)) stopifnot(minmax(adiag(a,43,pad=43))) # Check that adiag() plays nicely with subsums(): a <- array(1,rep(1,n)) stopifnot(minmax(subsums(adiag(a,a),2))) # And another test: a <- array(1,rep(1,n)) jj1 <- subsums(adiag(a,0,a),2,wrap=F) x <- array(1,rep(2,n)) jj2 <- adiag(x,x) stopifnot(identical(jj1,jj2)) # Now test adiag() for associativity: jj1 <- array(seq_len(2^n),rep(2,n)) jj2 <- array(seq_len(3^n),rep(3,n)) jj3 <- array(seq_len(4^n),rep(4,n)) f <- function(x,y,z){stopifnot(identical(adiag(adiag(x,y),z),adiag(x,adiag(y,z))))} f(jj1,jj2,jj3) f(jj2,jj3,jj1) f(jj1,jj1,jj1) f(jj3,jj3,jj3) # Now some tests for is.circulant(): a <- array(0,rep(2,10)) a[1] <- a[1024] <- 1 stopifnot(is.circulant(a)) # "break" a by changing just one (randomly chosen) element: a[1,1,1,1,2,1,2,1,1,1] <- 1 stopifnot(!is.circulant(a)) # Now test arev() with some tests: a <- array(1:32,rep(2,5)) stopifnot(identical(as.vector(arev(a)),rev(a))) jj <- as.vector(magic(19))[seq_len(360)] stopifnot(identical(arev(array(jj,3:6)) , array(rev(jj),3:6))) b <- c(TRUE,FALSE,TRUE,FALSE,TRUE) stopifnot(identical(a,arev(arev(a,b),b))) stopifnot(identical(a[,2:1,,,],arev(a,2))) stopifnot(identical(arev(a,c(2:4)),a[,2:1,2:1,2:1,])) # now some tests of arot(): stopifnot(identical(arot(arot(a)),arot(a,2))) stopifnot(identical(arot(arot(arot(a))),arot(a,3))) b <- c(2,4) stopifnot(identical(arot(arot(arot(a,p=b),p=b),p=b),arot(a,p=b,3))) stopifnot(identical(arot(a,2),arev(a,1:2))) #now some tests of shift: stopifnot(identical(c(as.integer(10),1:9),shift(1:10))) stopifnot(identical(shift(1:10,-2),c(3:10,1:2))) stopifnot(identical(magic(4),ashift(ashift(ashift(ashift(magic(4))))))) stopifnot(identical(ashift(ashift(ashift(magiccube.2np1(1)))),magiccube.2np1(1))) a <- array(1:24,2:4) stopifnot(identical(a,ashift(a,dim(a)))) stopifnot(is.magichypercube(ashift(magichypercube.4n(1)))) stopifnot(is.semimagichypercube(ashift(magichypercube.4n(1),1:3))) stopifnot(is.semimagichypercube(ashift(magichypercube.4n(1,d=5),c(1,2,3,2,1)))) # now test bug reported by Andre Mikulec via gmail: a1 <- array( 2^(0:5) , 1:3) dimnames(a1) <- list(ALPHA = "A", BETA = c("a","b"), GAMMA = c("i","ii","iii")) stopifnot(identical(dim(a1),dim(ashift(a1,c(0,1,0))))) zero.extent <- array(0,c(3,0,3,2,3)) stopifnot(is.standard(zero.extent)) # Now test subsums. With wrap=TRUE, a matrix with identical # entries should have identical subsums: a <- array(1,c(2,2,2,2,3,2,2)) stopifnot(minmax(subsums(a,2))) # Now sundry tests of apltake(), apldrop(), apad(), arev() etc: f1 <- function(a){ zero <- as.integer(0) identical(ashift(a,dim(a)),a) & identical(apltake(a,dim(a)),a) & identical(apltake(a,-dim(a)),a) & identical(apldrop(a,dim(a)*0),a) & identical(apldrop(adiag(a,zero),-1+dim(a)*0),a) & identical(apldrop(adiag(a,a),dim(a)),a) & identical(apltake(adiag(a,a),dim(a)),a) & identical(apltake(adiag(a,a),-dim(a)),a) & identical(apldrop(apad(a,dim(a)),-dim(a)),a) & identical(apldrop(apad(a,dim(a),method="mirror"),dim(a)),arev(a)) & identical(apldrop(apad(a,dim(a)),dim(a)),array(do.call("[",c(list(a),as.list(dim(a)))),dim(a))) & identical(a,apldrop(ashift(adiag(a,a),dim(a)),dim(a))) } stopifnot( f1(magichypercube.4n(m=1,d=4)) & f1(array(1:24,2:4)) & f1(array(1:64,rep(2,7))) & f1(matrix(1:30,5,6)) ) # Some tests of do.index(): f1 <- function(x){as.integer(sum(x))} f2 <- function(a){ stopifnot(identical(do.index(a,f1),arow(a,1)+arow(a,2)+arow(a,3)+arow(a,4))) } f2(array(0L,c(2,3,4,5))) f2(array(0L,c(3,5,4,2))) # Some tests of the incidence functionality: n <- 7 f <- function(a){ is.latin(a) & is.latin(unincidence(aperm(incidence(a),c(3,1,2)))) & is.latin(unincidence(aperm(incidence(a),c(3,2,1)))) & is.latin(unincidence(aperm(incidence(a),c(1,3,2)))) } stopifnot(sapply(sapply(2:n , latin) , f)) #Some tests of the antimagic functions: f <- function(x){is.sam(sam(x[1],x[2]))} jj <- as.matrix(which(lower.tri(matrix(0,n,n)),arr.ind=TRUE)) stopifnot(all(apply(jj,1,f))) #Some tests of fnsd(): a <- array(1:24,c(1,1,1,1,2,1,3,1,1,4)) stopifnot(length(fnsd(a,0))==0) stopifnot(fnsd(a)==5) stopifnot(all(fnsd(a,2) == c(5,7))) #Some tests of recurse(): f <- function(p,i){ stopifnot(all(recurse(start=recurse(p,i),p,-i) == seq_along(p))) } f(magic(10),0) f(magic(11),1) f(magic(12),2) f(magic(13),3) f(magic(14),4) #Some multiplicative magic square tests; see Javier Cilleruelo and #Florian Luca 2010, "On multiplicative magic squares", The Electronic #Journal of Combinatorics", vol 17. #N8 f <- function(n,m){ matrix(c( (n+2)*(m+0), (n+3)*(m+3), (n+1)*(m+2), (n+0)*(m+1), (n+1)*(m+1), (n+0)*(m+2), (n+2)*(m+3), (n+3)*(m+0), (n+0)*(m+3), (n+1)*(m+0), (n+3)*(m+1), (n+2)*(m+2), (n+3)*(m+2), (n+2)*(m+1), (n+0)*(m+0), (n+1)*(m+3) ),nrow=4,ncol=4,byrow=TRUE) } stopifnot(all(apply(as.matrix(expand.grid(seq_len(n),seq_len(n))),1,function(x){is.magic(f(x[1],x[2]),func=prod)}))) stopifnot(all(sapply(panmagic.6np1(seq_len(n)),is.panmagic))) stopifnot(all(sapply(panmagic.6np1(seq_len(n)),is.panmagic))) magic/NAMESPACE0000644000176200001440000000046313262761605012564 0ustar liggesusersexportPattern("^[[:alpha:]]+") exportPattern("%eq%") exportPattern("%ne%") exportPattern("%gt%") exportPattern("%ge%") exportPattern("%lt%") exportPattern("%le%") import("abind") importFrom("graphics", "lines", "par", "plot", "points", "text") importFrom("stats", "runif") importFrom("utils", "combn") magic/data/0000755000176200001440000000000013262761605012253 5ustar liggesusersmagic/data/perfectcube6.rda0000644000176200001440000000107213347535754015330 0ustar liggesusers]NTaˠQƅ .1cgifAz0&GQ| NWJkn5Ed4ua"c^)k-DZkcg^r>5$.HtoV??S_g1FW>]7 vcEs2s}&]7wc:1鿏Ƚs, O}Xrwbc9a/k}ؕ__Ч7/Naia/z9'bN3LWǎw{=;5¾!gQA=6D_bt\K@^Szfc :b/]~㦲1.}k&magic/data/magiccubes.rda0000644000176200001440000000041313347535754015053 0ustar liggesusersBZh91AY&SYsLLUU@> @ih44zMcCC@C@IMhz@w JŒ<('@F Dr`D6Uh`%Tg=%B,N [ϋA wv{X,}ir P2 GiAEo[xƆ hP i}i0 UAOx -#$ B.o-k! E\G6h `w$S iޑmagic/data/Ollerenshaw.rda0000644000176200001440000000062313347535754015237 0ustar liggesusers]NPF/.\ cQG s[ RڛH Ѕ[GQx'0ޏM[7rSBHD<}MƣHx2z~}oQj)}-wYx O&6>}|wqīM~5hΫWu].>ī:e/wxE 2^x^40TpM!&¯yQ՟GIozc i%_ؚRnHC $I (#.3 I! i%(3+-+ TM47tiQ5!DDDDF[l3cfg>hђ%JTRAUNW~H ,ړ Bm)JR- ()$UQUbN.ATUXQEQEQEQE`Q`XQAE( AAAAAAAauC-q+몭U^v&ovI$YeXOȷ'*g<&i1MK c#c\M$3Y%LT S!v,iiƽƱ0  H!@!B$I$9ss?mφ(:c12ۭ:t͛2`1c!B3333""A k[UUUUUUUUDDDD33R{kiuwykmBs9s<>=ܑN$!magic/data/Frankenstein.rda0000644000176200001440000000131613347535754015403 0ustar liggesusersBZh91AY&SYs} 8$0 H@@ F=ꪉ4M1244ɦ щ 22ia4db@A`2 !h !$OJ d4FF44i0d4hhi2h &24Lh@x"G#yt_G6 w'0&/{*wpL>`tE }9/&yzF^ Ʒ{p^L jz~Vs~wk}؄C'xzGq:[?>I,ns}ϮRNmagic/data/cube2.rda0000644000176200001440000000034613347535754013756 0ustar liggesusers]Kk@FoB*.\tхH65QS/\u¥{@:1B109sp!peIYb;fe+iiyH XP?'W"euzk.1y[N=>|-IC|}qa *usI~ѫ| Cz ::| Na]=ho?n_magic/R/0000755000176200001440000000000013346314400011531 5ustar liggesusersmagic/R/magic.R0000644000176200001440000012410713346314400012741 0ustar liggesusers"adiag" <- function (..., pad = as.integer(0), do.dimnames = TRUE) { args <- list(...) if (length(args) == 1) { return(args[[1]]) } if (length(args) > 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 (...) { f <- function(...) { 0:1 } 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/vignettes/0000755000176200001440000000000013347535753013361 5ustar liggesusersmagic/vignettes/magicpaper.Rnw0000644000176200001440000003443013262761605016156 0ustar liggesusers\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} } %% need no \usepackage{Sweave.sty} \begin{document} \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.10), abind Description: A collection of efficient, vectorized algorithms for the creation and investigation of magic squares and hypercubes, including a variety of functions for the manipulation and analysis of arbitrarily dimensioned arrays. The package includes methods for creating normal magic squares of any order greater than 2. The ultimate intention is for the package to be a computerized embodiment all magic square knowledge, including direct numerical verification of properties of magic squares (such as recent results on the determinant of odd-ordered semimagic squares). Some antimagic functionality is included. The package also serves as a rebuttal to the often-heard comment "I thought R was just for statistics". Maintainer: "Robin K. S. Hankin" License: GPL-2 Packaged: 2018-09-16 20:24:12 UTC; rhankin URL: https://github.com/RobinHankin/magic.git NeedsCompilation: no Repository: CRAN Date/Publication: 2018-09-17 09:00:08 UTC magic/man/0000755000176200001440000000000013347530513012111 5ustar liggesusersmagic/man/recurse.Rd0000644000176200001440000000165313262761605014061 0ustar liggesusers\name{recurse} \alias{recurse} \title{Recursively apply a permutation} \description{ Recursively apply a permutation to a vector an arbitrary number of times. Negative times mean apply the inverse permutation. } \usage{ recurse(perm, i, start = seq_along(perm)) } \arguments{ \item{perm}{Permutation (integers 1 to \code{length(start)} in some order)} \item{start}{Start vector to be permuted} \item{i}{Number of times to apply the permutation. \code{i=0} gives \code{start} by definition and negative values use the inverse permutation} } \author{Robin K. S. Hankin} \seealso{\code{\link{hudson}}} \examples{ n <- 15 noquote(recurse(start=letters[1:n],perm=shift(1:n),i=0)) noquote(recurse(start=letters[1:n],perm=shift(1:n),i=1)) noquote(recurse(start=letters[1:n],perm=shift(1:n),i=2)) noquote(recurse(start=letters[1:n],perm=sample(n),i=1)) noquote(recurse(start=letters[1:n],perm=sample(n),i=2)) } \keyword{array} magic/man/latin.Rd0000644000176200001440000000745513262761605013526 0ustar liggesusers\name{latin} \alias{latin} \alias{incidence} \alias{is.incidence} \alias{is.incidence.improper} \alias{unincidence} \alias{inc_to_inc} \alias{another_latin} \alias{another_incidence} \alias{rlatin} \title{Random latin squares} \description{ Various functionality for generating random latin squares } \usage{ incidence(a) is.incidence(a, include.improper) is.incidence.improper(a) unincidence(a) inc_to_inc(a) another_latin(a) another_incidence(i) rlatin(n,size=NULL,start=NULL,burnin=NULL) } \arguments{ \item{a}{A latin square} \item{i}{An incidence array} \item{n,include.improper,size,start,burnin}{Various control arguments; see details section} } \details{ \itemize{ \item Function \code{incidence()} takes an integer array (specifically, a latin square) and returns the incidence array as per Jacobson and Matthew 1996 \item Function \code{is.incidence()} tests for an array being an incidence array; if argument \code{include.improper} is \code{TRUE}, admit an improper array \item Function \code{is.incidence.improper()} tests for an array being an improper array \item Function \code{unincidence()} converts an incidence array to a latin square \item Function \code{another_latin()} takes a latin square and returns a different latin square \item Function \code{another_incidence()} takes an incidence array and returns a different incidence array \item Function \code{rlatin()} generates a (Markov) sequence of random latin squres, arranged in a 3D array. Argument \code{n} specifies how many to generate; argument \code{size} gives the size of latin squares generated; argument \code{start} gives the start latin square (it must be latin and is checked with \code{is.latin()}); argument \code{burnin} gives the burn-in value (number of Markov steps to discard). Default value of \code{NULL} for argument \code{size} means to take the size of argument \code{start}; default value of \code{NULL} for argument \code{start} means to use \code{circulant(size)} As a special case, if argument \code{size} and \code{start} both take the default value of \code{NULL}, then argument \code{n} is interpreted as the size of a single random latin square to be returned; the other arguments take their default values. This ensures that \dQuote{\code{rlatin(n)}} returns a single random \eqn{n\times n}{n-by-n} latin square. } From Jacobson and Matthew 1996, an \eqn{n\times n}{n-by-n} latin square LS is equivalent to an \eqn{n\times n\times n}{n-by-n-by-n} array A with entries 0 or 1; the dimensions of A are identified with the rows, columns and symbols of LS; a 1 appears in cell \eqn{(r,c,s)} of A iffi the symbol \eqn{s} appears in row \eqn{r}, column \eqn{s} of LS. Jacobson and Matthew call this an \dfn{incidence cube}. The notation is readily generalized to latin hypercubes and \code{incidence()} is dimensionally vectorized. An \dfn{improper} incidence cube is an incidence cube that includes a single \eqn{-1} entry; all other entries must be 0 or 1; and all line sums must equal 1. } \references{M. T. Jacobson and P. Matthews 1996. \dQuote{Generating uniformly distributed random latin squares}. \emph{Journal of Combinatorial Designs}, volume 4, No. 6, pp405--437 } \author{Robin K. S. Hankin} \seealso{\code{\link{is.magic}}} \examples{ rlatin(5) rlatin(n=2, size=4, burnin=10) # An example that allows one to optimize an objective function # [here f()] over latin squares: gr <- function(x){ another_latin(matrix(x,7,7)) } set.seed(0) index <- sample(49,20) f <- function(x){ sum(x[index])} jj <- optim(par=as.vector(latin(7)), fn=f, gr=gr, method="SANN", control=list(maxit=10)) best_latin <- matrix(jj$par,7,7) print(best_latin) print(f(best_latin)) #compare starting value: f(circulant(7)) } \keyword{array} magic/man/arot.Rd0000644000176200001440000000225613262761605013356 0ustar liggesusers\name{arot} \alias{arot} \title{Rotates an array about two specified dimensions} \description{ Rotates an array about two specified dimensions by any number of 90 degree turns } \usage{ arot(a, rights = 1,pair=1:2) } \arguments{ \item{a}{The array to be rotated} \item{rights}{Integer; number of right angles to turn} \item{pair}{A two-element vector containing the dimensions to rotate with default meaning to rotate about the first two dimensions} } \author{Robin K. S. Hankin} \note{ Function \code{arot()} is not exactly equivalent to octave's \code{rotdim()}; in \code{arot()} the order of the elements of \code{pair} matters because the rotation is clockwise when viewed in the \code{(pair[1],pair[2])} direction. Compare octave's \code{rotdim()} in which \code{pair} is replaced with \code{sort(pair)}. Note also that the rotation is about the first two dimensions specified by \code{pair} but if \code{pair} has more than two elements then these dimensions are also permuted. Also note that function \code{arot()} does not treat singleton dimensions specially. } \seealso{\code{\link{arev}}} \examples{ a <- array(1:16,rep(2,4)) arot(a) } \keyword{array} magic/man/panmagic.8.Rd0000644000176200001440000000174413262761605014337 0ustar liggesusers\name{panmagic.8} \alias{panmagic.8} \title{Panmagic squares of order 8} \description{ Produces each of a wide class of order 8 panmagic squares } \usage{ panmagic.8(chosen = 1:6, vals = 2^(0:5)) } \arguments{ \item{chosen}{Which of the magic carpets are used in combination} \item{vals}{The values combined to produce the magic square. Choosing \code{0:5} gives a normal magic square.} } \references{\url{http://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/transf.Rd0000644000176200001440000000103213262761605013675 0ustar liggesusers\name{transf} \alias{transf} \title{Frenicle's equivalent magic squares} \description{ For a given magic square, returns one of the eight squares whose Frenicle's standard form is the same. } \usage{ transf(a, i) } \arguments{ \item{a}{Magic square} \item{i}{Integer, considered modulo 8. Specifying 0-7 gives a different magic square} } \author{Robin K. S. Hankin} \seealso{\code{\link{is.standard}}} \examples{ a <- magic(3) identical(transf(a,0),a) transf(a,1) transf(a,2) transf(a,1) \%eq\% transf(a,7) } \keyword{array} magic/man/hendricks.Rd0000644000176200001440000000044213262761605014356 0ustar liggesusers\name{hendricks} \alias{hendricks} \docType{data} \title{A perfect magic cube due to Hendricks} \description{ A perfect \eqn{8\times 8\times 8}{8*8*8} magic cube due to Hendricks} \usage{data(hendricks)} \examples{ data(hendricks) is.perfect(hendricks) } \keyword{datasets} \keyword{array} magic/man/magicplot.Rd0000644000176200001440000000135513262761605014367 0ustar liggesusers\name{magicplot} \alias{magicplot} \title{Joins consecutive numbers of a magic square.} \description{ A nice way to graphically represent normal magic squares. Lines are plotted to join successive numbers from 1 to \eqn{n^2}{n^2}. Many magic squares have attractive such plots. } \usage{ magicplot(m, number = TRUE, do.circuit = FALSE, ...) } \arguments{ \item{m}{Magic square to be plotted.} \item{number}{Boolean variable with \code{TRUE} meaning to include the numbers on the plot} \item{do.circuit}{Boolean variable with \code{TRUE} meaning to include the line joining \eqn{n^2}{n^2} to 1} \item{\dots}{Extra parameters passed to \code{plot()}} } \author{Robin K. S. Hankin} \examples{ magicplot(magic.4n(2)) } \keyword{array} magic/man/shift.Rd0000644000176200001440000000330713262761605013524 0ustar liggesusers\name{shift} \alias{shift} \alias{ashift} \title{Shift origin of arrays and vectors} \description{ Shift origin of arrays and vectors. } \usage{ shift(x, i=1) ashift(a, v=rep(1,length(dim(a)))) } \arguments{ \item{x}{Vector to be shifted} \item{i}{Number of places elements to be shifted, with default value of 1 meaning to put the last element first, followed by the first element, then the second, etc} \item{a}{Array to be shifted} \item{v}{Vector of numbers to be shifted in each dimension, with default value corresponding to \code{shift()}ing each dimension by 1 unit. If the length of \code{v} is less than \code{length(dim(a))}, it is padded with zeros (thus a scalar value of \code{i} indicates that the first dimension is to be shifted by \code{i} units)} } \details{ Function \code{shift(x,n)} returns \eqn{P^n(x)} where \eqn{P} is the permutation \eqn{(n,1,2,\ldots,n-1)}{(n,1,2,...,n-1)}. Function \code{ashift} is the array generalization of this: the \eqn{n^{\rm th}}{n-th} dimension is shifted by \code{v[n]}. In other words, \code{ashift(a,v)=a[shift(1:(dim(a)[1]),v[1]),...,shift(1:(dim(a)[n]),v[n])]}. It is named by analogy with \code{abind()} and \code{aperm()}. This function is here because a shifted semimagic square or hypercube is semimagic and a shifted pandiagonal square or hypercube is pandiagonal (note that a shifted magic square is not necessarily magic, and a shifted perfect hypercube is not necessarily perfect). } \author{Robin K. S. Hankin} \examples{ shift(1:10,3) m <- matrix(1:100,10,10) ashift(m,c(1,1)) ashift(m,c(0,1)) #note columns shifted by 1, rows unchanged. ashift(m,dim(m)) #m unchanged (Mnemonic). } \keyword{array} magic/man/is.magic.Rd0000644000176200001440000001611413262761605014101 0ustar liggesusers\name{is.magic} \alias{is.magic} \alias{is.panmagic} \alias{is.pandiagonal} \alias{is.semimagic} \alias{is.semimagic.default} \alias{is.associative} \alias{is.regular} \alias{is.ultramagic} \alias{is.normal} \alias{is.sparse} \alias{is.mostperfect} \alias{is.2x2.correct} \alias{is.bree.correct} \alias{is.latin} \alias{is.antimagic} \alias{is.totally.antimagic} \alias{is.heterosquare} \alias{is.totally.heterosquare} \alias{is.sam} \alias{is.stam} \title{Various tests for the magicness of a square} \description{ Returns \code{TRUE} if the square is magic, semimagic, panmagic, associative, normal. If argument \code{give.answers} is \code{TRUE}, also returns additional information about the sums. } \usage{ is.magic(m, give.answers = FALSE, func=sum, boolean=FALSE) is.panmagic(m, give.answers = FALSE, func=sum, boolean=FALSE) is.pandiagonal(m, give.answers = FALSE, func=sum, boolean=FALSE) is.semimagic(m, give.answers = FALSE, func=sum, boolean=FALSE) is.semimagic.default(m) is.associative(m) is.normal(m) is.sparse(m) is.mostperfect(m,give.answers=FALSE) is.2x2.correct(m,give.answers=FALSE) is.bree.correct(m,give.answers=FALSE) is.latin(m,give.answers=FALSE) is.antimagic(m, give.answers = FALSE, func=sum) is.totally.antimagic(m, give.answers = FALSE, func=sum) is.heterosquare(m, func=sum) is.totally.heterosquare(m, func=sum) is.sam(m) is.stam(m) } \arguments{ \item{m}{The square to be tested} \item{give.answers}{Boolean, with \code{TRUE} meaning return additional information about the sums (see details)} \item{func}{A function that is evaluated for each row, column, and unbroken diagonal} \item{boolean}{Boolean, with \code{TRUE} meaning that the square is deemed magic, semimagic, etc, if all applications of \code{func} evaluate to \code{TRUE}. If \code{boolean} is \code{FALSE}, square \code{m} is magic etc if all applications of \code{func} are identical} } \details{ \itemize{ \item A \dfn{semimagic square} is one all of whose row sums equal all its columnwise sums (ie the magic constant). \item A \dfn{magic square} is a semimagic square with the sum of both unbroken diagonals equal to the magic constant. \item A \dfn{panmagic square} is a magic square all of whose broken diagonals sum to the magic constant. Ollerenshaw calls this a \dQuote{pandiagonal} square. \item A \dfn{most-perfect} square has all 2-by-2 arrays anywhere within the square summing to \eqn{2S} where \eqn{S=n^2+1}; and all pairs of integers \eqn{n/2} distant along the same major (NW-SE) diagonal sum to \eqn{S} (note that the \eqn{S} used here differs from Ollerenshaw's because her squares are numbered starting at zero). The first condition is tested by \code{is.2x2.correct()} and the second by \code{is.bree.correct()}. All most-perfect squares are panmagic. \item A \dfn{normal square} is one that contains \eqn{n^2} consecutive integers (typically starting at 0 or 1). \item A \dfn{sparse} matrix is one whose nonzero entries are consecutive integers, starting at 1. \item An \dfn{associative square} (also \dfn{regular square}) is a magic square in which \eqn{a_{i,j}+a_{n+1-i,n+1-j}=n^2+1}{a[i,j]+a[n+1-i,n+1-j]=n^2+1}. Note that an associative semimagic square is magic; see also \code{is.square.palindromic()}. The definition extends to magic hypercubes: a hypercube \code{a} is associative if \code{a+arev(a)} is constant. \item An \dfn{ultramagic square} is pandiagonal and associative. \item A \dfn{latin square} of size \eqn{n\times n}{n-by-n} is one in which each column and each row comprises the integers 1 to n (not necessarily in that order). Function \code{is.latin()} is a wrapper for \code{is.latinhypercube()} because there is no natural way to present the extra information given when \code{give.answers} is \code{TRUE} in a manner consistent with the other functions documented here. \item An \dfn{antimagic square} is one whose row sums and column sums are consecutive integers; a \dfn{totally antimagic square} is one whose row sums, column sums, and two unbroken diagonals are consecutiveintegers. Observe that an antimagic square is not necessarily totally antimagic, and vice-versa. \item A \dfn{heterosquare} has all rowsums and column sums distinct; a \dfn{totally heterosquare} [NB nonstandard terminology] has all rowsums, columnsums, and two long diagonals distinct. \item A square is \dfn{sam} (or \dfn{SAM}) if it is sparse and antimagic; it is \dfn{stam} (or \dfn{STAM}) if it is sparse and totally antimagic. See documentation at \code{SAM}. } } \value{ Returns \code{TRUE} if the square is semimagic, etc. and \code{FALSE} if not. If \code{give.answers} is taken as an argument and is \code{TRUE}, return a list of at least five elements. The first element of the list is the answer: it is \code{TRUE} if the square is (semimagic, magic, panmagic) and \code{FALSE} otherwise. Elements 2-5 give the result of a call to \code{allsums()}, viz: rowwise and columnwise sums; and broken major (ie NW-SE) and minor (ie NE-SW) diagonal sums. Function \code{is.bree.correct()} also returns the sums of elements distant \eqn{n/2} along a major diagonal (\code{diag.sums}); and function \code{is.2x2.correct()} returns the sum of each \eqn{2\times 2}{2x2} submatrix (\code{tbt.sums}); for other size windows use \code{subsums()} directly. Function \code{is.mostperfect()} returns both of these. Function \code{is.semimagic.default()} returns \code{TRUE} if the argument is semimagic [with respect to \code{sum()}] using a faster method than \code{is.semimagic()}. } \note{ Functions that take a \code{func} argument apply that function to each row, column, and diagonal as necessary. If \code{func} takes its default value of \code{sum()}, the sum will be returned; if \code{prod()}, the product will be returned, and so on. There are many choices for this argument that produce interesting tests; consider \code{func=max}, for example. With this, a \dQuote{magic} square is one whose row, sum and (unbroken) diagonals have identical maxima. Thus \code{diag(5)} is magic with respect to \code{max()}, but \code{diag(6)} isn't. Argument \code{boolean} is designed for use with non-default values for the \code{func} argument; for example, a latin square is semimagic with respect to \code{func=function(x){all(diff(sort(x))==1)}}. Function \code{is.magic()} is vectorized; if a list is supplied, the defaults are assumed. } \references{\url{http://mathworld.wolfram.com/MagicSquare.html}} \author{Robin K. S. Hankin} \seealso{\code{\link{minmax}},\code{\link{is.perfect}},\code{\link{is.semimagichypercube}},\code{\link{sam}}} \examples{ is.magic(magic(4)) is.magic(diag(7),func=max) # TRUE is.magic(diag(8),func=max) # FALSE stopifnot(is.magic(magic(3:8))) is.panmagic(panmagic.4()) is.panmagic(panmagic.8()) data(Ollerenshaw) is.mostperfect(Ollerenshaw) proper.magic <- function(m){is.magic(m) & is.normal(m)} proper.magic(magic(20)) } \keyword{array} magic/man/perfectcube5.Rd0000644000176200001440000000041113262761605014754 0ustar liggesusers\name{perfectcube5} \alias{perfectcube5} \docType{data} \title{A perfect magic cube of order 5} \description{ A perfect cube of order 5, due to Trump and Boyer } \usage{data(perfectcube5)} \examples{ data(perfectcube5) is.perfect(perfectcube5) } \keyword{datasets} magic/man/diag.off.Rd0000644000176200001440000000156113262761605014064 0ustar liggesusers\name{diag.off} \alias{diag.off} \title{Extracts broken diagonals} \description{ Returns broken diagonals of a magic square } \usage{ diag.off(a, offset = 0, nw.se = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{a}{Square matrix} \item{offset}{vertical offset} \item{nw.se}{Boolean variable with \code{TRUE} meaning trace diagonals along the northwest-southeast direction (point \code{[1,n]} to \code{[n,1]}).} } \details{ Useful when testing for panmagic squares. The first element is always the unbroken one (ie \code{[1,1]} to \code{[n,n]} if \code{nw.se} is \code{TRUE} and \code{[1,n]} to \code{[n,1]} if \code{nw.se} is \code{FALSE}. } \author{Robin K. S. Hankin} \seealso{\code{\link{is.panmagic}}} \examples{ diag.off(magic(10),nw.se=FALSE,offset=0) diag.off(magic(10),nw.se=FALSE,offset=1) } \keyword{array} magic/man/magic.4np2.Rd0000644000176200001440000000113513262761605014246 0ustar liggesusers\name{magic.4np2} \alias{magic.4np2} \title{Magic squares of order 4n+2} \description{ Produces a magic square of order \eqn{4n+2} using Conway's \dQuote{LUX} method } \usage{ magic.4np2(m) } \arguments{ \item{m}{returns a magic square of order \eqn{n=4m+2} for \eqn{m\geq 1}{m>=1}, using Conway's \dQuote{LUX} construction} } \references{\url{http://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/do.index.Rd0000644000176200001440000000323213347530513014110 0ustar liggesusers\name{do.index} \alias{do.index} \title{Apply a function to array element indices} \description{ Given a function \code{f()} that takes a vector of indices, and an array of arbitrary dimensions, apply \code{f()} to the elements of \code{a} } \usage{ do.index(a, f, ...) } \arguments{ \item{a}{Array} \item{f}{Function that takes a vector argument of the same length as \code{dim(a)}} \item{...}{Further arguments supplied to \code{f()}} } \value{ Returns a matrix of the same dimensions as \code{a} } \author{Robin K. S. Hankin, with improvements by Gabor Grothendieck and Martin Maechler, via the R help list} \note{Tamas Papp suggests the one-liner \code{ function(a, f, ...){array(apply(as.matrix(expand.grid(lapply(dim(a),seq_len),KEEP.OUT.ATTRS=FALSE)),1,f,...),dim(a))} } which is functionally identical to \code{do.index()}; but it is no faster than the version implemented in the package, and (IMO) is harder to read. Further note that function \code{arow()} is much much faster than \code{do.index()}; it is often possible to rephrase a call to \code{do.index()} as a call to \code{arow()}; do this where possible unless the additional code opacity outweighs the speed savings. } \seealso{\code{\link{arow}}} \examples{ a <- array(0,c(2,3,4)) b <- array(rpois(60,1),c(3,4,5)) f1 <- function(x){sum(x)} f2 <- function(x){sum((x-1)^2)} f3 <- function(x){b[t(x)]} f4 <- function(x){sum(x)\%\%2} f5 <- function(x,u){x[u]} do.index(a,f1) # should match arow(a,1)+arow(a,2)+arow(a,3) do.index(a,f2) do.index(a,f3) # same as apltake(b,dim(a)) do.index(a,f4) # Male/female toilets at NOC do.index(a,f5,2) # same as arow(a,2) } \keyword{math} magic/man/magic.2np1.Rd0000644000176200001440000000226113262761605014244 0ustar liggesusers\name{magic.2np1} \alias{magic.2np1} \title{Magic squares of odd order} \description{ Function to create magic squares of odd order } \usage{ magic.2np1(m, ord.vec = c(-1, 1), break.vec = c(1, 0), start.point=NULL) } \arguments{ \item{m}{creates a magic square of order \eqn{n=2m+1}} \item{ord.vec}{ordinary vector. Default value of \code{c(-1,1) } corresponds to the usual northeast direction} \item{break.vec}{break vector. Default of \code{c(1,0)} corresponds to the usual south direction} \item{start.point}{Starting position for the method (ie coordinates of unity). Default value of NULL corresponds to row 1, column \code{m}} } \references{Written up in loads of places. The method (at least with the default ordinary and break vectors) seems to have been known since at least the Renaissance. Benson and Jacoby, and the Mathematica website, discuss the problem with nondefault ordinary and break vectors. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}, \code{\link{magic.prime}}} \examples{ magic.2np1(1) f <- function(n){is.magic(magic.2np1(n))} all(sapply(1:20,f)) is.panmagic(magic.2np1(5,ord.vec=c(2,1),break.vec=c(1,3))) } \keyword{array} magic/man/cilleruelo.Rd0000644000176200001440000000245213262761605014546 0ustar liggesusers\name{cilleruelo} \alias{cilleruelo} \title{ A class of multiplicative magic squares due to Cilleruelo and Luca } \description{ Cilleruelo and Luca give a class of multiplicative magic squares whose behaviour is interesting. } \usage{ cilleruelo(n, m) } \arguments{ \item{n,m}{Arguments: usually integers} } \details{ \deqn{ \left( \begin{array}{cccc} (n+2)(m+0) & (n+3)(m+3) & (n+1)(m+2) & (n+0)(m+1)\\ (n+1)(m+1) & (n+0)(m+2) & (n+2)(m+3) & (n+3)(m+0)\\ (n+0)(m+3) & (n+1)(m+0) & (n+3)(m+1) & (n+2)(m+2)\\ (n+3)(m+2) & (n+2)(m+1) & (n+0)(m+0) & (n+1)(m+3) \end{array} \right) }{a 4x4 array} } \value{ Returns a \eqn{4\times 4}{4x4} matrix. } \references{ Javier Cilleruelo and Florian Luca 2010, \dQuote{On multiplicative magic squares}, \emph{The Electronic Journal of Combinatorics} vol 17, \#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/sam.Rd0000644000176200001440000000217513262761605013171 0ustar liggesusers\name{sam} \alias{sam} \title{Sparse antimagic squares} \description{ Produces an antimagic square of order \eqn{m} using Gray and MacDougall's method. } \usage{ sam(m, u, A=NULL, B=A) } \arguments{ \item{m}{Order of the magic square (not \dQuote{\code{n}}: the terminology follows Gray and MacDougall)} \item{u}{See details section} \item{A,B}{Start latin squares, with default \code{NULL} meaning to use \code{circulant(m)}} } \details{ In Gray's terminology, \code{sam(m,n)} produces a \eqn{SAM(2m,2u+1,0)}. The method is not vectorized. To test for these properties, use functions such as \code{is.antimagic()}, documented under \code{is.magic.Rd}. } \references{ I. D. Gray and J. A. MacDougall 2006. \dQuote{Sparse anti-magic squares and vertex-magic labelings of bipartite graphs}, \emph{Discrete Mathematics}, volume 306, pp2878-2892 } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}},\code{\link{is.magic}}} \examples{ sam(6,2) jj <- matrix(c( 5, 2, 3, 4, 1, 3, 5, 4, 1, 2, 2, 3, 1, 5, 4, 4, 1, 2, 3, 5, 1, 4, 5, 2, 3),5,5) is.sam(sam(5,2,B=jj)) } \keyword{array} magic/man/hudson.Rd0000644000176200001440000000256213347530513013705 0ustar liggesusers\name{hudson} \alias{hudson} \title{Pandiagonal magic squares due to Hudson} \description{ Returns a regular pandiagonal magic square of order \eqn{6m\pm 1}{6m+/-1} using a method developed by Hudson. } \usage{ hudson(n = NULL, a = NULL, b = NULL) } \arguments{ \item{n}{Order of the square, \eqn{n=6m\pm 1}{n=6m+/-1}. If \code{NULL}, use the length of \code{a}} \item{a}{The first line of Hudson's \eqn{A} matrix. If \code{NULL}, use Hudson's value of \code{c(n-1,0:(n-2))}} \item{b}{The first line of Hudson's \eqn{B} matrix. If \code{NULL}, use Hudson's value of \code{c(2:(n-1),n,1)}. Using default values for \code{a} and \code{b} gives an associative square } } \details{ Returns one member of a set of regular magic squares of order \eqn{n=6m\pm 1}{n=6m+/-1}. The set is of size \eqn{(n!)^2}. Note that \code{n} is not checked for being in the form \eqn{6n\pm 1}{6n+1/6n-1}. If it is not the correct form, the square is magic but not necessarily normal. } \references{C. B. Hudson, \emph{On pandiagonal squares of order 6t +/- 1}, Mathematics Magazine, March 1972, pp94-96} \author{Robin K. S. Hankin} \seealso{\code{\link{recurse}}} \examples{ hudson(n=11) magicplot(hudson(n=11)) is.associative(hudson(n=13)) hudson(a=(2*1:13)\%\%13 , b=(8*1:13)\%\%13) all(replicate(10,is.magic(hudson(a=sample(13),b=sample(13))))) } \keyword{array} magic/man/lozenge.Rd0000644000176200001440000000065013262761605014050 0ustar liggesusers\name{lozenge} \alias{lozenge} \title{Conway's lozenge algorithm for magic squares} \description{ Uses John Conway's lozenge algorithm to produce magic squares of odd order. } \usage{ lozenge(m) } \arguments{ \item{m}{magic square returned is of order \code{n=2m+1}} } \author{Robin Hankin} \seealso{\code{\link{magic.4np2}}} \examples{ lozenge(4) all(sapply(1:10,function(n){is.magic(lozenge(n))})) } \keyword{array} magic/man/magic.Rd0000644000176200001440000000237613262761605013474 0ustar liggesusers\name{magic} \alias{magic} \title{Creates magic squares} \description{ Creates normal magic squares of any order \eqn{>2}{>2}. Uses the appropriate method depending on n modulo 4. } \usage{ magic(n) } \arguments{ \item{n}{Order of magic square. If a vector, return a list whose \eqn{i}{i}-th element is a magic square of order \code{n[i]}} } \details{ Calls either \code{magic.2np1()}, \code{magic.4n()}, or \code{magic.4np2()} depending on the value of \code{n}. Returns a magic square in standard format (compare the \code{magic.2np1()} et seq, which return the square as generated by the direct algorithm). } \references{William H. Benson and Oswald Jacoby. \emph{New recreations with magic squares}. Dover 1976. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic.2np1}}, \code{\link{magic.prime}}, \code{\link{magic.4np2}}, \code{\link{magic.4n}},\code{\link{lozenge}}, \code{\link{as.standard}}, \code{\link{force.integer}}} \examples{ magic(6) all(is.magic(magic(3:10))) ## The first eigenvalue of a magic square is equal to the magic constant: eigen(magic(10),FALSE,TRUE)$values[1] - magic.constant(10) ## The sum of the eigenvalues of a magic square after the first is zero: sum(eigen(magic(10),FALSE,TRUE)$values[2:10]) } \keyword{array} magic/man/is.magichypercube.Rd0000644000176200001440000002423613262761605016014 0ustar liggesusers\name{is.magichypercube} \alias{is.semimagichypercube} \alias{is.magichypercube} \alias{is.nasik} \alias{is.alicehypercube} \alias{is.perfect} \alias{is.diagonally.correct} \alias{is.latinhypercube} \title{magic hypercubes} \description{ Returns \code{TRUE} if a hypercube is semimagic, magic, perfect } \usage{ is.semimagichypercube(a, give.answers=FALSE, func=sum, boolean=FALSE, ...) is.diagonally.correct(a, give.answers = FALSE, func=sum, boolean=FALSE, ...) is.magichypercube(a, give.answers = FALSE, func=sum, boolean=FALSE, ...) is.perfect(a, give.answers = FALSE, func=sum, boolean=FALSE) is.latinhypercube(a, give.answers=FALSE) is.alicehypercube(a,ndim,give.answers=FALSE, func=sum, boolean=FALSE) } \arguments{ \item{a}{The hypercube (array) to be tested} \item{give.answers}{Boolean, with \code{TRUE} meaning to also return the sums} \item{func}{Function to be applied across each dimension} \item{ndim}{In \code{is.alicehypercube()}, dimensionality of subhypercube to take sums over. See the details section} \item{boolean}{Boolean, with \code{TRUE} meaning that the hypercube is deemed magic, semimagic, etc, if all applications of \code{func} evaluate to \code{TRUE}. If \code{boolean} is \code{FALSE}, the hypercube is magic etc if all applications of \code{func} are identical} \item{...}{Further arguments passed to \code{func()}} } \details{ (Although apparently non-standard, here a hypercube is defined to have dimension \eqn{d} and order \eqn{n}---and thus has \eqn{n^d} elements). \itemize{ \item A \dfn{semimagic hypercube} has all \dQuote{rook's move} sums equal to the magic constant (that is, each \eqn{\sum a[i_1,i_2,\ldots,i_{r-1},,i_{r+1}, \ldots,i_d]}{sum(a[i_1,i_2, \ldots,i_{r-1},,i_{r+1},\ldots,i_d])} with \eqn{1\leq r\leq d}{1 <= r <= d} is equal to the magic constant for all values of the \eqn{i}'s). In \code{is.semimagichypercube()}, if \code{give.answers} is \code{TRUE}, the sums returned are in the form of an array of dimension \code{c(rep(n,d-1),d)}. The first \code{d-1} dimensions are the coordinates of the projection of the summed elements onto the surface hypercube. The last dimension indicates the dimension along which the sum was taken over. Optional argument \code{func}, defaulting to \code{sum()}, indicates the function to be taken over each of the \code{d} dimensions. Currently requires \code{func} to return a scalar. \item A \dfn{Latin hypercube} is one in which each line of elements whose coordinates differ in only one dimension comprises the numbers \eqn{1} to \eqn{n} (or \eqn{0} to \eqn{n-1}), not necessarily in that order. Each integer thus appears \eqn{n^{d-1}} times. \item A \dfn{magic hypercube} is a semimagic hypercube with the additional requirement that all \eqn{2^{d-1}}{2^(d-1)} long (ie extreme point-to-extreme point) diagonals sum correctly. Correct diagonal summation is tested by \code{is.diagonally.correct()}; by specifying a function other than \code{sum()}, criteria other than the diagonals returning the correct sum may be tested. \item An \dfn{Alice hypercube} is a different generalization of a semimagic square to higher dimensions. It is named for A. M. Hankin (\dQuote{Alice}), who originally suggested it. A semimagic hypercube has all one-dimensional subhypercubes (ie lines) summing correctly. An Alice hypercube is one in which all \code{ndim}-dimensional subhypercubes have the same sum, where \code{ndim} is a fixed integer argument. Thus, if \code{a} is a hypercube of size \eqn{n^d}{n^d}, \code{is.alicehypercube(a,ndim)} returns \code{TRUE} if all \code{n^{d-ndim}} subhypercubes have the same sum. For example, if \code{a} is four-dimensional with dimension \eqn{5\times 5\times 5\times 5}{5x5x5x5} then \code{is.alicehypercube(a,1)} is \code{TRUE} if and only if \code{a} is a semimagic hypercube: all \eqn{{4\choose 1}5^3=500}{4*5^3=500} one-dimensional subhypercubes have the same sum. Then \code{is.alicehypercube(a,2)} is \code{TRUE} if all 2-dimensional subhypercubes (ie all \eqn{{4\choose 2}\times 5^2=150}{6x5^2=150} of the \eqn{5\times 5}{5x5} squares, for example \code{a[,2,4,]} and \code{a[1,1,,]}) have the same sum. Then \code{is.alicehypercube(a,3)} means that all 3d subhypercubes (ie all \eqn{{4\choose 3}\times 5^1=20}{4x5=20} of the \eqn{5\times 5\times 5}{5x5x5} cubes, for example \code{a[,,1,]} and \code{a[4,,,]}) have the same sum. For any hypercube \code{a}, \code{is.alicehypercube(a,dim(a))} returns \code{TRUE}. A semimagic hypercube is an Alice hypercube for any value of \code{ndim}. \item A \dfn{perfect magic hypercube} (use \code{is.perfect()}) is a magic hypercube with all nonbroken diagonals summing correctly. This is a seriously restrictive requirement for high dimensional hypercubes. As yet, this function does not take a \code{give.answers} argument. \item A \dfn{pandiagonal magic hypercube}, also \dfn{Nasik hypercube} (or sometimes just a \dfn{perfect hypercube}) is a semimagic hypercube with all diagonals, including broken diagonals, summing correctly. This is not implemented. } The terminology in this area is pretty confusing. In \code{is.magichypercube()}, if argument \code{give.answers=TRUE} then a list is returned. The first element of this list is Boolean with \code{TRUE} if the array is a magic hypercube. The second element and third elements are answers from\code{is.semimagichypercube()} and \code{is.diagonally.correct()} respectively. In \code{is.diagonally.correct()}, if argument \code{give.answers=TRUE}, the function also returns an array of dimension \code{c(q,rep(2,d))} (that is, \eqn{q\times 2^d}{q*2^d} elements), where \eqn{q}{q} is the length of \code{func()} applied to a long diagonal of \code{a} (if \eqn{q=1}{q=1}, the first dimension is dropped). If \eqn{q=1}, then in dimension \code{d} having index 1 means \code{func()} is applied to elements of \code{a} with the \eqn{d^{\rm th}}{d-th} dimension running over \code{1:n}; index 2 means to run over \code{n:1}. If \eqn{q>1}, the index of the first dimension gives the index of \code{func()}, and subsequent dimensions have indices of 1 or 2 as above and are interpreted in the same way. An example of a function for which these two are not identical is given below. If \code{func=f} where \code{f} is a function returning a vector of length \code{i}, \code{is.diagonally.correct()} returns an array \code{out} of dimension \code{c(i,rep(2,d))}, with \code{out[,i_1,i_2,...,i_d]} being \code{f(x)} where \code{x} is the appropriate long diagonal. Thus the \eqn{2^d} equalities \code{out[,i_1,i_2,...,i_d]==out[,3-i_1,3-i_2,...,3-i_d]} hold if and only if \code{identical(f(x),f(rev(x)))} is \code{TRUE} for each long diagonal (a condition met, for example, by \code{sum()} but not by the identity function or \code{function(x){x[1]}}). } \references{ \itemize{ \item R. K. S. Hankin 2005. \dQuote{Recreational mathematics with R: introducing the \pkg{magic} package}. R news, 5(1) \item Richards 1980. \dQuote{Generalized magic cubes}. \emph{Mathematics Magazine}, volume 53, number 2, (March). } } \author{Robin K. S. Hankin} \note{ On this page, \dQuote{subhypercube} is restricted to rectangularly-oriented subarrays; see the note at \code{subhypercubes}. Not all subhypercubes of a magic hypercube are necessarily magic! (for example, consider a 5-dimensional magic hypercube \code{a}. The square \code{b} defined by \code{a[1,1,1,,]} might not be magic: the diagonals of \code{b} are not covered by the definition of a magic hypercube). Some subhypercubes of a magic hypercube are not even semimagic: see below for an example. Even in three dimensions, being perfect is pretty bad. Consider a \eqn{5\times5\times 5}{5x5x5} (ie three dimensional), cube. Say \code{a=magiccube.2np1(2)}. Then the square defined by \code{sapply(1:n,function(i){a[,i,6-i]}, simplify=TRUE)}, which is a subhypercube of \code{a}, is not even semimagic: the rowsums are incorrect (the colsums must sum correctly because \code{a} is magic). Note that the diagonals of this square are two of the \dQuote{extreme point-to-point} diagonals of \code{a}. A \dfn{pandiagonal magic hypercube} (or sometimes just a \dfn{perfect hypercube}) is semimagic and in addition the sums of all diagonals, including broken diagonals, are correct. This is one seriously bad-ass requirement. I reckon that is a total of \eqn{\frac{1}{2}\left( 3^d-1\right)\cdot n^{d-1}}{(3^d-1)n^(d-1)/2} correct summations. This is not coded up yet; I can't see how to do it in anything like a vectorized manner. } \seealso{\code{\link{is.magic}}, \code{\link{allsubhypercubes}}, \code{\link{hendricks}}} \examples{ library(abind) is.semimagichypercube(magiccube.2np1(1)) is.semimagichypercube(magichypercube.4n(1,d=4)) is.perfect(magichypercube.4n(1,d=4)) # Now try an array with minmax(dim(a))==FALSE: a <- abind(magiccube.2np1(1),magiccube.2np1(1),along=2) is.semimagichypercube(a,g=TRUE)$rook.sums # is.semimagichypercube() takes further arguments: mymax <- function(x,UP){max(c(x,UP))} not_mag <- array(1:81,rep(3,4)) is.semimagichypercube(not_mag,func=mymax,UP=80) # FALSE is.semimagichypercube(not_mag,func=mymax,UP=81) # TRUE a2 <- magichypercube.4n(m=1,d=4) is.diagonally.correct(a2) is.diagonally.correct(a2,g=TRUE)$diag.sums ## To extract corner elements (note func(1:n) != func(n:1)): is.diagonally.correct(a2,func=function(x){x[1]},g=TRUE)$diag.sums #Now for a subhypercube of a magic hypercube that is not semimagic: is.magic(allsubhypercubes(magiccube.2np1(1))[[10]]) data(hendricks) is.perfect(hendricks) #note that Hendricks's magic cube also has many broken diagonals summing #correctly: a <- allsubhypercubes(hendricks) ld <- function(a){length(dim(a))} jj <- unlist(lapply(a,ld)) f <- function(i){is.perfect(a[[which(jj==2)[i]]])} all(sapply(1:sum(jj==2),f)) #but this is NOT enough to ensure that it is pandiagonal (but I #think hendricks is pandiagonal). is.alicehypercube(magichypercube.4n(1,d=5),4,give.answers=TRUE) } \keyword{array} magic/man/is.ok.Rd0000644000176200001440000000106013262761605013424 0ustar liggesusers\name{is.ok} \alias{is.ok} \title{does a vector have the sum required to be a row or column of a magic square?} \description{ Returns \code{TRUE} if and only if \code{sum(vec)==magic.constant(n,d=d))} } \usage{ is.ok(vec, n=length(vec), d=2) } \arguments{ \item{vec}{Vector to be tested} \item{n}{Order of square or hypercube. Default assumes order is equal to length of \code{vec}} \item{d}{Dimension of square or hypercube. Default of 2 corresponds to a square} } \author{Robin K. S. Hankin} \examples{ is.ok(magic(5)[1,]) } \keyword{array} magic/man/magic.constant.Rd0000644000176200001440000000155113262761605015316 0ustar liggesusers\name{magic.constant} \alias{magic.constant} \title{Magic constant of a magic square or hypercube} \description{ Returns the magic constant: that is, the common sum for all rows, columns and (broken) diagonals of a magic square or hypercube } \usage{ magic.constant(n,d=2,start=1) } \arguments{ \item{n}{Order of the square or hypercube} \item{d}{Dimension of hypercube, defaulting to \code{d=2} (a square)} \item{start}{Start value. Common values are 0 and 1} } \details{ If \code{n} is an integer, interpret this as the order of the square or hypercube; return \eqn{n({\rm start}+n^d-1)/2}{n(start+n^d-1)/2}. If \code{n} is a square or hypercube, return the magic constant for a normal array (starting at 1) of the same dimensions as \code{n}. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ magic.constant(4) } \keyword{array} magic/man/Frankenstein.Rd0000644000176200001440000000041213262761605015030 0ustar liggesusers\name{Frankenstein} \alias{Frankenstein} \docType{data} \title{A perfect magic cube due to Frankenstein} \description{ A perfect magic cube due to Frankenstein } \usage{data(Frankenstein)} \examples{ data(Frankenstein) is.perfect(Frankenstein) } \keyword{datasets} magic/man/allsums.Rd0000644000176200001440000000316013262761605014064 0ustar liggesusers\name{allsums} \alias{allsums} \title{Row, column, and two diagonal sums of arrays} \description{ Returns all rowsums, all columnsums, and all (broken) diagonal sums of a putative magic square. } \usage{ allsums(m,func=NULL, ...) } \arguments{ \item{m}{The square to be tested} \item{func}{Function, with default \code{NULL} interpreted as\code{sum()}, to be applied to the square rowwise, columnwise, and diagonalwise} \item{...}{Further arguments passed to \code{func()}} } \value{ Returns a list of four elements. In the following, \dQuote{sums} means \dQuote{the result of applying func()}. \item{rowsums}{All \eqn{n} row sums} \item{colsums}{All \eqn{n} column sums} \item{majors}{All \eqn{n} broken major diagonals (northwest-southeast). First element is the long (unbroken) major diagonal, tested by \code{is.magic()}} \item{minors}{All \eqn{n} broken minor diagonals (northeast-southwest). First element is the long (unbroken) minor diagonal.} } \author{Robin K. S. Hankin} \note{ If \code{func()} returns a vector, then the \code{allsums()} returns a list whose columns are the result of applying \code{func()}. See third and fourth examples below. Used by \code{is.magic()} et seq. The major and minor diagonals would benefit from being recoded in C. } \seealso{\code{\link{is.magic}},\code{\link{is.semimagic}},\code{\link{is.panmagic}}} \examples{ allsums(magic(7)) allsums(magic(7),func=max) allsums(magic(7),func=range) allsums(magic(7),func=function(x){x[1:2]}) allsums(magic(7),sort) # beware! compare apply(magic(7),1,sort) and apply(magic(7),2,sort) } \keyword{array} magic/man/perfectcube6.Rd0000644000176200001440000000046013262761605014761 0ustar liggesusers\name{perfectcube6} \alias{perfectcube6} \docType{data} \title{A perfect cube of order 6} \description{ A perfect cube of order 6 originally due to Trump } \usage{data(perfectcube6)} \examples{ data(perfectcube6) is.perfect(perfectcube6) is.magichypercube(perfectcube6[2:5,2:5,2:5]) } \keyword{datasets} magic/man/nqueens.Rd0000644000176200001440000000246113262761605014065 0ustar liggesusers\name{nqueens} \alias{nqueens} \alias{bernhardsson} \alias{bernhardssonA} \alias{bernhardssonB} \title{N queens problem} \description{ Solves the N queens problem for any n-by-n board. } \usage{ bernhardsson(n) bernhardssonA(n) bernhardssonB(n) } \arguments{ \item{n}{Size of the chessboard} } \details{ Uses a direct transcript of Bo Bernhardsson's method. All solutions (up to reflection and translation) for the 8-by-8 case given in the examples. } \references{ \itemize{ \item Bo Bernhardsson 1991. \dQuote{Explicit solutions to the n-queens problem for all \eqn{n}}. \emph{SIGART Bull.}, 2(2):7 \item Weisstein, Eric W. \dQuote{Queens Problem} From \emph{MathWorld--A Wolfram Web Resource} \url{http://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/notmagic.2n.Rd0000644000176200001440000000115713262761605014527 0ustar liggesusers\name{notmagic.2n} \alias{notmagic.2n} \title{An unmagic square} \description{ Returns a square of order \eqn{n=2m} that has been claimed to be magic, but isn't. } \usage{ notmagic.2n(m) } \arguments{ \item{m}{Order of square is \eqn{n=2m}} } \references{\dQuote{Magic Squares and Cubes}, Andrews, (book)} \author{Robin K. S. Hankin} \note{This took me a whole evening to code up. And I was quite pleased with the final vectorized form: it matches Andrews's (8 by 8) example square exactly. What a crock} \examples{ notmagic.2n(4) is.magic(notmagic.2n(4)) is.semimagic(notmagic.2n(4)) } \keyword{array} magic/man/panmagic.6npm1.Rd0000644000176200001440000000242713262761605015130 0ustar liggesusers\name{panmagic.6npm1} \alias{panmagic.4n} \alias{panmagic.6npm1} \alias{panmagic.6np1} \alias{panmagic.6nm1} \title{Panmagic squares of order 4n, 6n+1 and 6n-1} \description{ Produce a panmagic square of order \eqn{4n} or \eqn{6n\pm 1}{6n+/-1} using a classical method } \usage{ panmagic.6npm1(n) panmagic.6np1(m) panmagic.6nm1(m) panmagic.4n(m) } \arguments{ \item{m}{Function \code{panmagic.6np1(m)} returns a panmagic square of order \eqn{n=6m+1} for \eqn{m\geq 1}{m>=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/apl.Rd0000644000176200001440000000334013262761605013160 0ustar liggesusers\name{apl} \alias{apl} \alias{take} \alias{apldrop} \alias{apltake} \alias{apldrop<-} \alias{apltake<-} \title{Replacements for APL functions take and drop} \description{ Replacements for APL functions take and drop } \usage{ apldrop(a, b, give.indices=FALSE) apldrop(a, b) <- value apltake(a, b, give.indices=FALSE) apltake(a, b) <- value } \arguments{ \item{a}{Array} \item{b}{Vector of number of indices to take/drop. Length of \code{b} should not exceed \code{length(dim(a))}; if it does, an error is returned} \item{give.indices}{Boolean, with default \code{FALSE} meaning to return the appropriate subset of array \code{a}, and \code{TRUE} meaning to return the list of the selected elements in each of the dimensions. Setting to \code{TRUE} is not really intended for the end-user, but is used in the code of \code{apltake<-()} and \code{apldrop<-()}} \item{value}{elements to replace} } \details{ \code{apltake(a,b)} returns an array of the same dimensionality as \code{a}. Along dimension \code{i}, if \code{b[i]>0}, the first \code{b[i]} elements are retained; if \code{b[i]<0}, the last \code{b[i]} elements are retained. \code{apldrop(a,b)} returns an array of the same dimensionality as \code{a}. Along dimension \code{i}, if \code{b[i]>0}, the first \code{b[i]} elements are dropped if \code{b[i]<0}, the last \code{b[i]} elements are dropped. These functions do not drop singleton dimensions. Use \code{drop()} if this is desired. } \author{Robin K. S. Hankin} \examples{ a <- magichypercube.4n(m=1) apltake(a,c(2,3,2)) apldrop(a,c(1,1,2)) b <- matrix(1:30,5,6) apldrop(b,c(1,-2)) <- -1 b <- matrix(1:110,10,11) apltake(b,2) <- -1 apldrop(b,c(5,-7)) <- -2 b } \keyword{array} magic/man/magic.product.Rd0000644000176200001440000000313613262761605015146 0ustar liggesusers\name{magic.product} \alias{magic.product} \alias{magic.product} \alias{magic.product.fast} \title{Product of two magic squares} \description{ Gives a magic square that is a product of two magic squares. } \usage{ magic.product(a, b, mat=NULL) magic.product.fast(a, b) } \arguments{ \item{a}{First magic square; if \code{a} is an integer, use \code{magic(a)}.} \item{b}{as above} \item{mat}{Matrix, of same size as \code{a}, of integers treated as modulo 8. Default value of \code{NULL} equivalent to passing \code{a*0}. Each number from 0-7 corresponds to one of the 8 squares which have the same Frenicle's standard form, as generated by \code{transf()}. Then subsquares of the product square (ie tiles of the same size as \code{b}) are rotated and transposed appropriately according to their corresponding entry in \code{mat}. This is a lot easier to see than to describe (see examples section).} } \details{ Function \code{magic.product.fast()} does not take a \code{mat} argument, and is equivalent to \code{magic.product()} with \code{mat} taking the default value of \code{NULL}. The improvement in speed is doubtful unless \code{order(a)}\eqn{\gg}{>>}\code{order(b)}, in which case there appears to be a substantial saving. } \references{ William H. Benson and Oswald Jacoby. New recreations with magic squares, Dover 1976 (and that paper in JRM)} \author{Robin K. S. Hankin} \examples{ magic.product(magic(3),magic(4)) magic.product(3,4) mat <- matrix(0,3,3) a <- magic.product(3,4,mat=mat) mat[1,1] <- 1 b <- magic.product(3,4,mat=mat) a==b } \keyword{array} magic/man/strachey.Rd0000644000176200001440000000252313262761605014230 0ustar liggesusers\name{strachey} \alias{strachey} \title{Strachey's algorithm for magic squares} \description{ Uses Strachey's algorithm to produce magic squares of singly-even order. } \usage{ strachey(m, square=magic.2np1(m)) } \arguments{ \item{m}{magic square produced of order \code{n=2m+1}} \item{square}{magic square of order \code{2m+1} needed for Strachey's method. Default value gives the standard construction, but the method will work with any odd order magic square} } \details{ Strachey's method essentially places four identical magic squares of order \eqn{2m+1} together to form one of \eqn{n=4m+2}. Then \eqn{0,n^2/4,n^2/2,3n^2/4} is added to each square; and finally, certain squares are swapped from the top subsquare to the bottom subsquare. See the final example for an illustration of how this works, using a zero matrix as the submatrix. Observe how some 75s are swapped with some 0s, and some 50s with some 25s. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic.4np2}},\code{\link{lozenge}}} \examples{ strachey(3) strachey(2,square=magic(5)) strachey(2,square=magic(5)) \%eq\% strachey(2,square=t(magic(5))) #should be FALSE #Show which numbers have been swapped: strachey(2,square=matrix(0,5,5)) #It's still magic, but not normal: is.magic(strachey(2,square=matrix(0,5,5))) } \keyword{array} magic/man/magic.4n.Rd0000644000176200001440000000061013262761605014001 0ustar liggesusers\name{magic.4n} \alias{magic.4n} \title{Magic squares of order 4n} \description{ Produces an associative magic square of order \eqn{4n} using the delta-x method. } \usage{ magic.4n(m) } \arguments{ \item{m}{Order \eqn{n}{n} of the square is given by \eqn{n=4m}} } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ magic.4n(4) is.magic(magic.4n(5)) } \keyword{array} magic/man/cube2.Rd0000644000176200001440000000053613262761605013410 0ustar liggesusers\name{cube2} \alias{cube2} \docType{data} \title{A pantriagonal magic cube} \description{ A pantriagonal magic cube of order 4 originally due to Hendricks } \usage{data(cube2)} \details{ Meaning of \dQuote{pantriagonal} currently unclear } \source{ Hendricks } \examples{ data(cube2) is.magichypercube(cube2) is.perfect(cube2) } \keyword{datasets} magic/man/hadamard.Rd0000644000176200001440000000124113262761605014143 0ustar liggesusers\name{hadamard} \alias{hadamard} \alias{is.hadamard} \alias{sylvester} \title{Hadamard matrices} \description{ Various functionality for Hadamard matrices } \usage{ sylvester(k) is.hadamard(m) } \arguments{ \item{k}{Function \code{sylvester()} gives the \code{k}-th Sylvester matrix} \item{m}{matrix} } \details{ A \dfn{Hadamard matrix} is a square matrix whose entries are either +1 or -1 and whose rows are mutually orthogonal. } \references{ \dQuote{Hadamard matrix.} \emph{Wikipedia, The Free Encyclopedia.} 19 Jan 2009, 18:21 UTC. 20 Jan 2009 } \author{Robin K. S. Hankin} \examples{ is.hadamard(sylvester(4)) image(sylvester(5)) } \keyword{array} magic/man/is.square.palindromic.Rd0000644000176200001440000000542513262761605016624 0ustar liggesusers\name{is.square.palindromic} \alias{is.square.palindromic} \alias{is.centrosymmetric} \alias{is.persymmetric} \title{Is a square matrix square palindromic?} \description{ Implementation of various properties presented in a paper by Arthur T. Benjamin and K. Yasuda } \usage{ is.square.palindromic(m, base=10, give.answers=FALSE) is.centrosymmetric(m) is.persymmetric(m) } \arguments{ \item{m}{The square to be tested} \item{base}{Base of number expansion, defaulting to 10; not relevant for the \dQuote{sufficient} part of the test} \item{give.answers}{Boolean, with \code{TRUE} meaning to return additional information} } \details{ The following tests apply to a general square matrix \code{m} of size \eqn{n\times n}{n*n}. \itemize{ \item A \dfn{centrosymmetric} square is one in which \code{a[i,j]=a[n+1-i,n+1-j]}; use \code{is.centrosymmetric()} to test for this (compare an \emph{associative} square). Note that this definition extends naturally to hypercubes: a hypercube \code{a} is centrosymmetric if \code{all(a==arev(a))}. \item A \dfn{persymmetric square} is one in which \code{a[i,j]=a[n+1-j,n+1-i]}; use \code{is.persymmetric()} to test for this. \item A matrix is \dfn{square palindromic} if it satisfies the rather complicated conditions set out by Benjamin and Yasuda (see refs). } } \value{ These functions return a list of Boolean variables whose value depends on whether or not \code{m} has the property in question. If argument \code{give.answers} takes the default value of \code{FALSE}, a Boolean value is returned that shows whether the sufficient conditions are met. If argument \code{give.answers} is \code{TRUE}, a detailed list is given that shows the status of each individual test, both for the necessary and sufficient conditions. The value of the second element (named \code{necessary}) is the status of their Theorem 1 on page 154. Note that the necessary conditions do not depend on the base \code{b} (technically, neither do the sufficient conditions, for being a square palindrome requires the sums to match for \emph{every} base \code{b}. In this implementation, \dQuote{sufficient} is defined only with respect to a particular base). } \references{Arthur T. Benjamin and K. Yasuda. \emph{Magic \dQuote{Squares} Indeed!}, American Mathematical Monthly, vol 106(2), pp152-156, Feb 1999} \author{Robin K. S. Hankin} \note{ Every associative square is square palindromic, according to Benjamin and Yasuda. Function \code{is.square.palindromic()} does not yet take a \code{give.answers} argument as does, say, \code{is.magic()}. } \examples{ is.square.palindromic(magic(3)) is.persymmetric(matrix(c(1,0,0,1),2,2)) #now try a circulant: a <- matrix(0,5,5) is.square.palindromic(circulant(10)) #should be TRUE } \keyword{array} magic/man/as.standard.Rd0000644000176200001440000000646013262761605014614 0ustar liggesusers\name{as.standard} \alias{as.standard} \alias{is.standard} \alias{is.standard.toroidal} \title{Standard form for magic squares} \description{ Transforms a magic square or magic hypercube into Frenicle's standard form } \usage{ as.standard(a, toroidal = FALSE, one_minus=FALSE) is.standard(a, toroidal = FALSE, one_minus=FALSE) } \arguments{ \item{a}{Magic square or hypercube (array) to be tested or transformed} \item{toroidal}{Boolean, with default \code{FALSE} meaning to use Frenicle's method, and \code{TRUE} meaning to use additional transformations appropriate to toroidal connectivity} \item{one_minus}{Boolean, with \code{TRUE} meaning to use the transformation \eqn{x\longrightarrow n^2+1-x}{x -> n^2+1-x} if appropriate, and default \code{FALSE} meaning not to use this} } \details{ For a square, \code{as.standard()} transforms a magic square into Frenicle's standard form. The four numbers at each of the four corners are determined. First, the square is rotated so the smallest of the four is at the upper left. Then, element \code{[1,2]} is compared with element\code{[2,1]} and, if it is larger, the transpose is taken. Thus all eight rotated and transposed versions of a magic square have the same standard form. The square returned by \code{magic()} is in standard form. For hypercubes, the algorithm is generalized. First, the hypercube is reflected so that \code{a[1,1,...,1,1]} is the smallest of the \eqn{2^d} corner elements (eg \code{a[1,n,1,...,1,1]}). Next, \code{aperm()} is called so that \code{a[1,1,...,1,2] < a[1,1,...,2,1] < ... < a[2,1,...,1,1]}. Note that the inequalities are strict as hypercubes are assumed to be normal. As of version 1.3-1, \code{as.standard()} will accept arrays of any dimension (ie arrays \code{a} with \code{minmax(dim(a))==FALSE} will be handled sensibly). An array with any dimension of extent zero is in standard form by definition; dimensions of length one are dropped. If argument \code{toroidal} is \code{TRUE}, then the array \code{a} is translated using \code{ashift()} so that \code{a[1,1,...,1] == min(a)}. Such translations preserve the properties of semimagicness and pandiagonalness (but not magicness or associativity). It is easier (for me at least) to visualise this by considering two-dimensional arrays, tiling the plane with copies of \code{a}. Next, the array is shifted so that \code{a[2,1,1,...,1] < a[dim(a)[1],1,1,...,1]} and \code{a[1,2,1,..,1] < a[1,dim(a)[2],1,...,1]} and so on. Then \code{aperm()} is called as per the non-toroidal case above. \code{is.standard()} returns \code{TRUE} if the magic square or hypercube is in standard form. \code{is.standard()} and \code{as.standard()} check for neither magicness nor normality (use \code{\link{is.magic}} and \code{\link{is.normal}} for this). } \note{ There does not appear to be a way to make the third letter of \dQuote{Frenicle} have an acute accent, as it should do. } \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}, \code{\link{eq}}} \examples{ is.standard(magic.2np1(4)) as.standard(magic.4n(3)) as.standard(magichypercube.4n(1,5)) ##non-square arrays: as.standard(magic(7)[1:3,]) ## Toroidal transforms preserve pandiagonalness: is.pandiagonal(as.standard(hudson(11))) ## but not magicness: is.magic(as.standard(magic(10),TRUE)) } \keyword{array} magic/man/subsums.Rd0000644000176200001440000000515213262761605014110 0ustar liggesusers\name{subsums} \alias{subsums} \title{Sums of submatrices} \description{ Returns the sums of submatrices of an array; multidimensional moving window averaging} \usage{ subsums(a,p,func="sum",wrap=TRUE, pad=0) } \arguments{ \item{a}{Array to be analysed} \item{p}{Argument specifying the subarrays to be summed. If a vector of length greater than one, it is assumed to be of length \code{d=length(dim(a))}, and is interpreted to be the dimensions of the subarrays, with the size of the window's \eqn{n{^{\rm th}}}{n-th} dimension being \code{a[n]}. If the length of \code{p} is one, recycling is used. If not a vector, is assumed to be a matrix with \code{d} columns, each row representing the coordinates of the elements to be summed. See examples. } \item{func}{Function to be applied over the elements of the moving window. Default value of \code{sum} gives the sum as used in \code{is.2x2.correct()}; other choices might be \code{mean}, \code{prod}, or \code{max}. If \code{sum=""}, return the array of dimension \code{c(dim(a),prod(p))} where each hyperplane is a shifted version of \code{a}.} \item{wrap}{Boolean, with default value of \code{TRUE} meaning to view array \code{a} as a n-dimensional torus. Thus, if \code{x=subsums(a,p,wrap=TRUE)}, and if \code{dim(a)=c(a_1,...,a_d)} then \code{x[a_1,...,a_d]} is the sum of all corner elements of \code{a}. If \code{FALSE}, do not wrap \code{a} and return an array of dimension \code{dim(a)+p-1}.} \item{pad}{If \code{wrap} is \code{TRUE}, \code{pad} is the value used to pad the array with. Use a \dQuote{neutral} value here; for example, if \code{func=sum}, then use 0; if \code{max}, use \eqn{-\infty}{-Inf}.} } \details{ The offset is specified so that \code{allsums(a,v)[1,1,...,1]= sum(a[1:v[1],1:v[2],...,1:v[n]])}, where \code{n=length(dim(a))}. Function \code{subsums()} is used in \code{is.2x2.correct()} and \code{is.diagonally.correct()}. } \author{Robin K. S. Hankin} \examples{ data(Ollerenshaw) subsums(Ollerenshaw,c(2,2)) subsums(Ollerenshaw[,1:10],c(2,2)) subsums(Ollerenshaw, matrix(c(0,6),2,2)) # effectively, is.bree.correct() # multidimensional example. a <- array(1,c(3,4,2)) subsums(a,2) # note that p=2 is equivalent to p=c(2,2,2); # all elements should be identical subsums(a,2,wrap=FALSE) #note "middle" elements > "outer" elements #Example of nondefault function: x <- matrix(1:42,6,7) subsums(x,2,func="max",pad=Inf,wrap=TRUE) subsums(x,2,func="max",pad=Inf,wrap=FALSE) } \keyword{array} magic/man/minmax.Rd0000644000176200001440000000152713262761605013702 0ustar liggesusers\name{minmax} \alias{minmax} \title{are all elements of a vector identical?} \description{ Returns \code{TRUE} if and only if all elements of a vector are identical. } \usage{ minmax(x, tol=1e-6) } \arguments{ \item{x}{Vector to be tested} \item{tol}{Relative tolerance allowed} } \details{ If \code{x} is an integer, exact equality is required. If real or complex, a relative tolerance of \code{tol} is required. Note that functions such as \code{is.magic()} and \code{is.semimagichypercube()} use the default value for \code{tol}. To change this, define a new Boolean function that tests the sum to the required tolerance, and set \code{boolean} to \code{TRUE} } \author{Robin K. S. Hankin} \seealso{is.magic()} \examples{ data(Ollerenshaw) minmax(subsums(Ollerenshaw,2)) #should be TRUE, as per is.2x2.correct() } \keyword{array} magic/man/magichypercube.4n.Rd0000644000176200001440000000107413262761605015715 0ustar liggesusers\name{magichypercube.4n} \alias{magichypercube.4n} \title{Magic hypercubes of order 4n} \description{ Returns magic hypercubes of order 4n and any dimension. } \usage{ magichypercube.4n(m, d = 3) } \arguments{ \item{m}{Magic hypercube produced of order \eqn{n=4m}} \item{d}{Dimensionality of cube} } \details{ Uses a rather kludgy (but vectorized) method. I am not 100\% sure that the method does in fact produce magic squares for all orders and dimensions. } \author{Robin K. S. Hankin} \examples{ magichypercube.4n(1,d=4) magichypercube.4n(2,d=3) } \keyword{array} magic/man/magiccubes.Rd0000644000176200001440000000054113262761605014506 0ustar liggesusers\name{magiccubes} \alias{magiccubes} \docType{data} \title{Magic cubes of order 3} \description{ A list of four elements listing each fundamentally different magic cube of order 3 } \usage{data(magiccubes)} \source{ Originally discovered by Hendricks } \examples{ data(magiccubes) magiccubes$a1 sapply(magiccubes,is.magichypercube) } \keyword{datasets} magic/man/magic.prime.Rd0000644000176200001440000000165113262761605014602 0ustar liggesusers\name{magic.prime} \alias{magic.prime} \title{Magic squares prime order} \description{ Produces magic squares of prime order using the standard method } \usage{ magic.prime(n,i=2,j=3) } \arguments{ \item{n}{The order of the square} \item{i}{row number of increment} \item{j}{column number of increment} } \details{ Claimed to work for prime order, 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. } \references{\url{http://www.magic-squares.de/general/general.html}} \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/apad.Rd0000644000176200001440000000444513262761605013320 0ustar liggesusers\name{apad} \alias{apad} \title{Pad arrays} \description{ Generalized padding for arrays of arbitrary dimension } \usage{ apad(a, l, e = NULL, method = "ext", post = TRUE) } \arguments{ \item{a}{Array to be padded} \item{l}{Amount of padding to add. If a vector of length greater than one, it is interpreted as the extra extent of \code{a} along each of its dimensions (standard recycling is used). If of length one, interpret as the dimension to be padded, in which case the amount is given by argument \code{l}.} \item{e}{If \code{l} is of length one, the amount of padding to add to dimension \code{l}} \item{method}{String specifying the values of the padded elements. See details section.} \item{post}{Boolean, with default \code{TRUE} meaning to append to \code{a} and \code{FALSE} meaning to prepend.} } \details{ Argument \code{method} specifies the values of the padded elements. It can be either \dQuote{\code{ext}}, \dQuote{\code{mirror}}, or \dQuote{\code{rep}}. Specifying \code{ext} (the default) uses a padding value given by the \dQuote{nearest} element of \code{a}, as measured by the Manhattan metric. Specifying \code{mirror} fills the array with alternate mirror images of \code{a}; while \code{rep} fills it with unreflected copies of \code{a}. } \author{Robin K. S. Hankin} \note{ Function \code{apad()} does not work with arrays with dimensions of zero extent: what to pad it with? To pad with a particular value, use \code{adiag()}. The function works as expected with vectors, which are treated as one-dimensional arrays. See examples section. Function \code{apad()} is distinct from \code{adiag()}, which takes two arrays and binds them together. Both functions create an array of the same dimensionality as their array arguments but with possibly larger extents. However, the functions differ in the values of the new array elements. Function \code{adiag()} uses a second array; function \code{apad()} takes the values from its primary array argument. } \seealso{\code{\link{adiag}}} \examples{ apad(1:10,4,method="mirror") a <- matrix(1:30,5,6) apad(a,c(4,4)) apad(a,c(4,4),post=FALSE) apad(a,1,5) apad(a,c(5,6),method="mirror") apad(a,c(5,6),method="mirror",post=FALSE) } \keyword{array} magic/man/circulant.Rd0000644000176200001440000000401713346315074014370 0ustar liggesusers\name{circulant} \alias{circulant} \alias{is.circulant} \title{Circulant matrices of any order} \description{ Creates and tests for circulant matrices of any order } \usage{ circulant(vec,doseq=TRUE) is.circulant(m,dir=rep(1,length(dim(m)))) } \arguments{ \item{vec,doseq}{In \code{circulant()}, vector of elements of the first row. If \code{vec} is of length one, and \code{doseq} is \code{TRUE}, then interpret \code{vec} as the order of the matrix and return a circulant with first row \code{seq_len(vec)}} \item{m}{In \code{is.circulant()}, matrix to be tested for circulantism} \item{dir}{In \code{is.circulant()}, the direction of the diagonal. In a matrix, the default value (\code{c(1,1)}) traces the major diagonals} } \details{ A matrix \eqn{a} is \dfn{circulant} if all major diagonals, including broken diagonals, are uniform; ie if \eqn{a_{ij}=a_{kl}}{a[i,j]==a[k,j]} when \eqn{i-j=k-l} (modulo \eqn{n}). The standard values to use give \code{1:n} for the top row. In function \code{is.circulant()}, for arbitrary dimensional arrays, the default value for \code{dir} checks that \code{a[v]==a[v+rep(1,d)]==...==a[v+rep((n-1),d)]} for all \code{v} (that is, following lines parallel to the major diagonal); indices are passed through \code{process()}. For general \code{dir}, function \code{is.circulant()} checks that \code{a[v]==a[v+dir]==a[v+2*dir]==...==a[v+(n-1)*d]} for all \code{v}. A \dfn{Toeplitz} matrix is one in which \code{a[i,j]=a[i',j']} whenever \code{|i-j|=|i'-j'|}. See function \code{toeplitz()} of the \code{stats} package for details. } \references{Arthur T. Benjamin and K. Yasuda. \emph{Magic \dQuote{Squares} Indeed!}, American Mathematical Monthly, vol 106(2), pp152-156, Feb 1999} \author{Robin K. S. Hankin} \examples{ circulant(5) circulant(2^(0:4)) is.circulant(circulant(5)) a <- outer(1:3,1:3,"+")\%\%3 is.circulant(a) is.circulant(a,c(1,2)) is.circulant(array(c(1:4,4:1),rep(2,3))) is.circulant(magic(5)\%\%5,c(1,-2)) } \keyword{array} magic/man/magiccube.2np1.Rd0000644000176200001440000000141013262761605015076 0ustar liggesusers\name{magiccube.2np1} \alias{magiccube.2np1} \title{Magic cubes of order 2n+1} \description{ Creates odd-order magic cubes } \usage{ magiccube.2np1(m) } \arguments{ \item{m}{n=2m+1} } \references{website} \author{Robin K. S. Hankin} \seealso{\code{\link{magic}}} \examples{ #try with m=3, n=2*3+1=7: m <-7 n <- 2*m+1 apply(magiccube.2np1(m),c(1,2),sum) apply(magiccube.2np1(m),c(1,3),sum) apply(magiccube.2np1(m),c(2,3),sum) #major diagonal checks out: sum(magiccube.2np1(m)[matrix(1:n,n,3)]) #now other diagonals: b <- c(-1,1) f <- function(dir,v){if(dir>0){return(v)}else{return(rev(v))}} g <- function(jj){sum(magiccube.2np1(m)[sapply(jj,f,v=1:n)])} apply(expand.grid(b,b,b),1,g) #each diagonal twice, once per direction. } \keyword{array} magic/man/force.integer.Rd0000644000176200001440000000115013262761605015133 0ustar liggesusers\name{force.integer} \alias{force.integer} \title{Integerize array elements} \description{ Returns an elementwise \code{as.integer}-ed array. All magic squares should have integer elements. } \usage{ force.integer(x) } \arguments{ \item{x}{Array to be converted} } \author{Robin K. S. Hankin} \note{ Function \code{force.integer()} differs from \code{as.integer()} as the latter returns an integer vector, and the former returns an array whose elements are integer versions of \code{x}; see examples section below. } \examples{ a <- matrix(rep(1,4),2,2) force.integer(a) as.integer(a) } \keyword{array} magic/man/allsubhypercubes.Rd0000644000176200001440000000323513347530513015757 0ustar liggesusers\name{allsubhypercubes} \alias{allsubhypercubes} \title{Subhypercubes of magic hypercubes} \description{ Extracts all subhypercubes from an n-dimensional hypercube. } \usage{ allsubhypercubes(a) } \arguments{ \item{a}{The magic hypercube whose subhypercubes are computed} } \value{ Returns a list, each element of which is a subhypercube of \code{a}. Note that major diagonals are also returned (as n-by-1 arrays). The names of the list are the extracted subhypercubes. Consider \code{a <- magichypercube.4n(1,d=4)} (so n=4) and if \code{jj <- allsubhypercubes(a)}, consider \code{jj[9]}. The name of \code{jj[9]} is \code{"n-i+1,i,i,"}; its value is a square matrix. The columns of \code{jj[9]} may be recovered by \code{a[n-i+1,i,i,]} with \eqn{i=1\ldots n}{i=1...n} (\strong{NB}: that is, jj[[9]] == \code{cbind(a[n-1+1,1,1,], a[n-2+1,2,2,], a[n-3+1,3,3,], a[n-4+1,4,4,])} where \code{n=4}). The list does not include the whole array. } \author{Robin K. S. Hankin} \note{This function is a dog's dinner. It's complicated, convoluted, and needs an absurd use of the \code{eval(parse(text=...))} construction. Basically it sucks big time. BUT\ldots I cannot for the life of me see a better way that gives the same results, without loops, on hypercubes of arbitrary dimension. On my 256MB Linuxbox, \code{allsubhypercubes()} cannot cope with \code{d} as high as 5, for \code{n=4}. Heigh ho. The term \dQuote{subhypercube} does not include diagonally oriented entities at \code{is.magichypercube}. But it does here. } \seealso{\code{\link{is.perfect}}} \examples{ a <- magichypercube.4n(1,d=4) allsubhypercubes(a) } \keyword{array} magic/man/magic.package.Rd0000644000176200001440000000166513262761605015066 0ustar liggesusers\name{magic-package} \alias{magic-package} \docType{package} \title{ Magic squares and hypercubes; arbitrary dimensioned array manipulation } \description{ A collection of efficient, vectorized algorithms for the creation and investigation of magic squares and hypercubes, including a variety of functions for the manipulation and analysis of arbitrarily dimensioned arrays. The package includes methods for creating normal magic squares of any order greater than 2. The ultimate intention is for the package to be a computerized embodiment all magic square knowledge, including direct numerical verification of properties of magic squares (such as recent results on the determinant of odd-ordered semimagic squares). } \author{ Robin K. S. Hankin \email{rksh1@cam.ac.uk} } \keyword{ package } \examples{ magic(5) a <- magiccube.2np1(1) adiag(1,a) apad(a,2,1) allsubhypercubes(a) arev(a) apltake(a,c(2,2)) arot(a) arow(a,1) } magic/man/fnsd.Rd0000644000176200001440000000143413262761605013340 0ustar liggesusers\name{fnsd} \alias{fnsd} \title{First non-singleton dimension} \description{ Given an array, returns the first non-singleton dimension. Useful for emulating some of Matlab / Octave's multidimensional functions. If \code{n} is supplied, return the first \code{n} nonsingleton dimensions. } \usage{ fnsd(a,n) } \arguments{ \item{a}{An array} \item{n}{Integer. Return the first \code{n} nonsingleton dimensions} } \value{ Returns an integer vector with elements in the range \code{1} to \code{length(dim(a))}. } \author{Robin K. S. Hankin} \note{ Treats zero-extent dimensions as singletons. Case \code{n=0} now treated sensibly (returns a zero-length vector). } \seealso{\code{\link{arev}}} \examples{ a <- array(1:24,c(1,1,1,1,2,1,3,4)) fnsd(a) fnsd(a,2) } \keyword{array} magic/man/process.Rd0000644000176200001440000000117613262761605014067 0ustar liggesusers\name{process} \alias{process} \title{Force index arrays into range} \description{ Forces an (integer) array to have entries in the range 1-n, by (i) taking the entries modulo n, then (ii) setting zero elements to n. Useful for modifying index arrays into a form suitable for use with magic squares.} \usage{ process(x, n) } \arguments{ \item{x}{Index array to be processed} \item{n}{Modulo of arithmetic to be used} } \author{Robin K. S. Hankin} \examples{ # extract the broken diagonal of magic.2np1(4) that passes # through element [1,5]: a <- magic.2np1(4) index <- t(c(1,5)+rbind(1:9,1:9)) a[process(index,9)] } \keyword{array} magic/man/aplus.Rd0000644000176200001440000000237413347530513013532 0ustar liggesusers\name{aplus} \alias{aplus} \title{Generalized array addition} \description{ Given two arrays \code{a} and \code{b} with \code{length(dim(a))==length(dim(b))}, return a matrix with dimensions \code{pmax(dim(a),dim(b))} where \dQuote{overlap} elements are \code{a+b}, and the other elements are either 0, a, or b according to location. See details section. } \usage{ aplus(...) } \arguments{ \item{\dots}{numeric or complex arrays} } \details{ The function takes any number of arguments (the binary operation is associative). The operation of \code{aplus()} is understandable by examining the following \strong{pseudo}code: \itemize{ \item \code{outa <- array(0,pmax(a,b))} \item \code{outb <- array(0,pmax(a,b))} \item \code{outa[1:dim(a)] <- a} \item \code{outb[1:dim(a)] <- b} \item \code{return(outa+outb)} } See how \code{outa} and \code{outb} are the correct size and the appropriate elements of each are populated with \code{a} and \code{b} respectively. Then the sum is returned. } \author{Robin K. S. Hankin} \seealso{\code{\link{apad}}} \examples{ aplus(rbind(1:9),cbind(1:9)) a <- matrix(1:8,2,4) b <- matrix(1:10,5,2) aplus(a*100,b,b) } \keyword{ array } magic/man/arow.Rd0000644000176200001440000000154713347530513013357 0ustar liggesusers\name{arow} \alias{arow} \title{Generalized row and col} \description{ Given an array, returns an array of the same size whose elements are sequentially numbered along the \eqn{i^{\rm th}}{i-th} dimension. } \usage{ arow(a, i) } \arguments{ \item{a}{array to be converted} \item{i}{Number of the dimension} } \value{ An integer matrix with the same dimensions as \code{a}, with element \eqn{\left(n_1,n_2,\ldots n_d\right)}{(n1,n2, ..., n_d)} being \eqn{n_i}{n_i}. } \author{Robin K. S. Hankin} \note{ This function is equivalent to, but faster than, \code{function(a,i){do.index(a,function(x){x[i]})}}. However, it is much more complicated. The function is nominally the same as \code{slice.index()} but I have not checked all the edge cases. } \examples{ a <- array(0,c(3,3,2,2)) arow(a,2) (arow(a,1)+arow(a,2)+arow(a,3)+arow(a,4))\%\%2 } \keyword{array} magic/man/panmagic.4.Rd0000644000176200001440000000116413262761605014327 0ustar liggesusers\name{panmagic.4} \alias{panmagic.4} \title{Panmagic squares of order 4} \description{ Creates all fundamentally different panmagic squares of order 4. } \usage{ panmagic.4(vals = 2^(0:3)) } \arguments{ \item{vals}{a length four vector giving the values which are combined in each of the \eqn{2^4}{2^4} possible ways. Thus \code{vals=2^sample(0:3)} always gives a normal square (0-15 in binary).} } \references{\url{http://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/eq.Rd0000644000176200001440000000260713262761605013016 0ustar liggesusers \name{eq} \alias{eq} \alias{ne} \alias{gt} \alias{lt} \alias{ge} \alias{le} \alias{\%eq\%} \alias{\%ne\%} \alias{\%gt\%} \alias{\%lt\%} \alias{\%ge\%} \alias{\%le\%} \title{Comparison of two magic squares} \description{ Compares two magic squares according to Frenicle's method. Mnemonic is the old Fortran \dQuote{.GT.} (for \dQuote{Greater Than}) comparison et seq. To compare magic square \code{a} with magic square \code{b}, their elements are compared in rowwise order: \code{a[1,1]} is compared with \code{b[1,1]}, then \code{a[1,2]} with \code{b[1,2]}, up to \code{a[n,n]}. Consider the first element that is different, say \code{[i,j]}. Then \code{a