Magic squares of odd order: Difference between revisions
m
→Siamese method
(Updated to work with Nim 1.4. Removed the '^' function.) |
m (→Siamese method) |
||
Line 1,833:
Encoding the traditional [[wp:Siamese_method|'Siamese' method]]
<lang haskell>
import Control.Monad (forM_)
import Data.
import qualified Data.
import Data.Maybe (fromJust, isJust)
magic :: Int -> [[Int]]
magic = mapAsTable <*> siamMap
-- Highest zero-based index of grid ->
-- 'Siamese' indices keyed by coordinates
siamMap :: Int -> M.Map (Int, Int) Int
siamMap n
|
where
uBound = n - 1▼
go n = sPath uBound (M.fromList [])
where
let newMap = M.insert (x, y) h sMap▼
h
uBound = n -
sPath uBound sMap (x, y) h
let newMap = M.insert (x, y) h
in if y == uBound && x == quot uBound
then
newMap
(nextSiam uBound sMap (x, y))
-- Highest index of square -> Siam xys so far -> xy ->
-- next xy coordinate
nextSiam :: Int -> M.Map (Int, Int) Int -> (Int, Int) -> (Int, Int)
nextSiam uBound sMap (x, y) =
let alt (a, b)
| a > uBound
|
-- above top edge ?
| b < 0 = (a, uBound)
-- already filled ?
| isJust (M.lookup (a, b) sMap) = (a - 1, b + 2)
| otherwise = (a, b) -- Up one, right one.
in alt (x + 1, y - 1)
-- Size of square -> integers keyed by coordinates
-- -> rows of integers
mapAsTable :: Int -> M.Map (Int, Int) Int -> [[Int]]
mapAsTable nCols xyMap =
let axis = [0 .. nCols - 1]
in fmap (fromJust . flip M.lookup xyMap)
checked :: [[Int]] -> (Int, Bool)
checked square =
let diagonals =
fmap (flip (zipWith (!!)) [0 ..]
. ( (:)
h:t = sum <$> square ++ transpose square ++ diagonals square▼
<*> (return . reverse)
in (h, all (h ==) t)▼
)
h : t =
sum <$> square
<> diagonals square
▲ in (h, all (h ==) t)
table :: String -> [[String]] -> [String]
table delim rows =
let justifyRight c n s =
drop
in intercalate delim <$>▼
(replicate n c <> s)
((fmap =<< justifyRight ' ' . maximum . fmap length) <$> transpose rows)▼
<$> transpose
<$> transpose rows
)
main :: IO ()
main =
forM_ [3, 5, 7] $
\n -> do
let test = magic n
putStrLn $ unlines (table " " (fmap show <$> test))
print $ checked test
putStrLn ""</lang>
{{Out}}
<pre>8 1 6
| |||