Magic squares of doubly even order: Difference between revisions

Content added Content deleted
(→‎{{header|Haskell}}: (added test))
(→‎{{header|Haskell}}: Adding comments, and a shorter route where order N is a power of 2)
Line 283: Line 283:


<lang Haskell>import Data.List (transpose)
<lang Haskell>import Data.List (transpose)

magicSquare :: Int -> [[Int]]
magicSquare :: Int -> [[Int]]
magicSquare n
magicSquare n
| (rem n 4) > 0 = []
| (rem n 4) > 0 = []
| otherwise = splitEvery n $
| otherwise = splitEvery n $
zipWith (\x i -> if x then i else limit - i)
-- Taken directly from the integer series where True
(concat $ concat $ concat $
-- and from the reverse of that series where False
scale $ fmap scale $ splitEvery 4 $ magicSeries 5)
zipWith (\x i -> if x then i else limit - i)
series
[1..sqr]
[1..sqr]
where
where
scale = replicate $ quot n 4
sqr = n * n
sqr = n * n
limit = sqr + 1
limit = sqr + 1
series
-- For powers of 2, the (append not) 'magic' series directly
-- yields the truth table that we need
| isPowerOf 2 n =
magicSeries $ floor (logBase 2 (fromIntegral sqr)) + 1
-- where n is not a power of 2, we can replicate a
-- minimum truth table, horizontally and vertically
| otherwise = (concat $ concat $ concat $
scale $ fmap scale $ splitEvery 4 $ magicSeries 5)
where scale = replicate $ quot n 4



------------------------------------------------------------------------
magicSeries :: Int -> [Bool]
magicSeries :: Int -> [Bool]
magicSeries n
magicSeries n
Line 304: Line 317:
where
where
xs = magicSeries (n - 1)
xs = magicSeries (n - 1)
splitEvery :: Int -> [a] -> [[a]]
splitEvery :: Int -> [a] -> [[a]]
splitEvery n xs
splitEvery n xs
Line 311: Line 324:
where
where
(gp, t) = splitAt n xs
(gp, t) = splitAt n xs
isPowerOf :: Int -> Int -> Bool
isPowerOf k n =
(until (\x -> (rem x k) /= 0)
(\x -> quot x k ) n) == 1
main :: IO ()
main :: IO ()
main = mapM_ (putStrLn . show) $ magicSquare 8
main = mapM_ (putStrLn . show) $ magicSquare 8

----------------------------------------------------------------------

-- Summed and checked
-- Summed and checked
checked :: Int -> (Int, Bool)
checked :: Int -> (Int, Bool)
Line 325: Line 343:
(transpose square) ++ -- cols
(transpose square) ++ -- cols
(diagonals square) -- diagonals
(diagonals square) -- diagonals
diagonals :: [[Int]] -> [[Int]]
diagonals :: [[Int]] -> [[Int]]
diagonals xs =
diagonals xs =
map (\x -> zipWith (!!) x [0..]) [xs, reverse xs]
map (\x -> zipWith (!!) x [0..]) [xs, reverse xs]
main2 :: IO ()
main2 :: IO ()
main2 = putStrLn $ show (checked 8)</lang>
main2 = putStrLn $ show (checked 8)</lang>