Magic squares of doubly even order: Difference between revisions

Add Factor example
m (pointer to task code)
(Add Factor example)
Line 762:
16 50 51 13 12 54 55 9
57 7 6 60 61 3 2 64
</pre>
 
=={{header|Factor}}==
<lang factor>USING: arrays combinators.short-circuit formatting fry
generalizations kernel math math.matrices prettyprint sequences
;
IN: rosetta-code.doubly-even-magic-squares
 
: top? ( loc n -- ? ) [ second ] dip 1/4 * < ;
: bottom? ( loc n -- ? ) [ second ] dip 3/4 * >= ;
: left? ( loc n -- ? ) [ first ] dip 1/4 * < ;
: right? ( loc n -- ? ) [ first ] dip 3/4 * >= ;
: corner? ( loc n -- ? )
{
[ { [ top? ] [ left? ] } ]
[ { [ top? ] [ right? ] } ]
[ { [ bottom? ] [ left? ] } ]
[ { [ bottom? ] [ right? ] } ]
} [ 2&& ] map-compose 2|| ;
 
: center? ( loc n -- ? )
{ [ top? ] [ bottom? ] [ left? ] [ right? ] } [ not ]
map-compose 2&& ;
 
: backward? ( loc n -- ? ) { [ corner? ] [ center? ] } 2|| ;
: forward ( loc n -- m ) [ first2 ] dip * 1 + + ;
: backward ( loc n -- m ) tuck forward [ sq ] dip - 1 + ;
 
: (doubly-even-magic-square) ( n -- matrix )
[ dup 2array matrix-coordinates flip ] [ 3 dupn ] bi
'[ dup _ backward? [ _ backward ] [ _ forward ] if ]
matrix-map ;
 
ERROR: invalid-order order ;
 
: check-order ( n -- )
dup { [ zero? not ] [ 4 mod zero? ] } 1&& [ drop ]
[ invalid-order ] if ;
 
: doubly-even-magic-square ( n -- matrix )
dup check-order (doubly-even-magic-square) ;
 
: main ( -- )
{ 4 8 12 } [
dup doubly-even-magic-square dup
[ "Order: %d\n" printf ]
[ simple-table. ]
[ first sum "Magic constant: %d\n\n" printf ] tri*
] each ;
 
MAIN: main</lang>
{{out}}
<pre>
Order: 4
16 2 3 13
5 11 10 8
9 7 6 12
4 14 15 1
Magic constant: 34
 
Order: 8
64 63 3 4 5 6 58 57
56 55 11 12 13 14 50 49
17 18 46 45 44 43 23 24
25 26 38 37 36 35 31 32
33 34 30 29 28 27 39 40
41 42 22 21 20 19 47 48
16 15 51 52 53 54 10 9
8 7 59 60 61 62 2 1
Magic constant: 260
 
Order: 12
144 143 142 4 5 6 7 8 9 135 134 133
132 131 130 16 17 18 19 20 21 123 122 121
120 119 118 28 29 30 31 32 33 111 110 109
37 38 39 105 104 103 102 101 100 46 47 48
49 50 51 93 92 91 90 89 88 58 59 60
61 62 63 81 80 79 78 77 76 70 71 72
73 74 75 69 68 67 66 65 64 82 83 84
85 86 87 57 56 55 54 53 52 94 95 96
97 98 99 45 44 43 42 41 40 106 107 108
36 35 34 112 113 114 115 116 117 27 26 25
24 23 22 124 125 126 127 128 129 15 14 13
12 11 10 136 137 138 139 140 141 3 2 1
Magic constant: 870
</pre>
 
1,808

edits