Magic squares of odd order: Difference between revisions

Content added Content deleted
Line 1,825: Line 1,825:
Defining the magic square as two applications of ('''transpose . cycled''') to a simply ordered square.
Defining the magic square as two applications of ('''transpose . cycled''') to a simply ordered square.


<lang Haskell>import Data.List (transpose, maximumBy)
<lang Haskell>import Control.Monad (join)
import Data.List (maximumBy, transpose)
import Data.List.Split (chunksOf)
import Data.List.Split (chunksOf)
import Data.Ord (comparing)
import Data.Ord (comparing)



magicSquare :: Int -> [[Int]]
magicSquare :: Int -> [[Int]]
magicSquare n
magicSquare n
| 1 == mod n 2 = applyN 2 (transpose . cycled) $ plainSquare n
| 1 == mod n 2 =
applyN 2 (transpose . cycled) $
plainSquare n
| otherwise = []
| otherwise = []


⚫
plainSquare :: Int -> [[Int]]
⚫
plainSquare = chunksOf <*> enumFromTo 1 . (^ 2)



-------------------------- TEST ---------------------------
-------------------------- TEST ---------------------------
main :: IO ()
main :: IO ()
main =
⚫
main = mapM_ putStrLn $ showSquare . magicSquare <$> [3, 5, 7]
mapM_ putStrLn $
⚫
showSquare . magicSquare <$> [3, 5, 7]



------------------------- GENERIC -------------------------
------------------------- GENERIC -------------------------
Line 1,846: Line 1,858:
let n = length rows
let n = length rows
d = quot n 2
d = quot n 2
in zipWith
in zipWith
(\d xs -> take n $ drop (n - d) (cycle xs))
(\d xs -> take n $ drop (n - d) (cycle xs))
[d,subtract 1 d .. -d]
[d, subtract 1 d .. - d]
rows
rows

⚫
plainSquare :: Int -> [[Int]]
⚫
plainSquare = chunksOf <*> enumFromTo 1 . (^ 2)


-- FORMATTING ---------------------------------------------
------------------------ FORMATTING ----------------------
justifyRight :: Int -> a -> [a] -> [a]
justifyRight :: Int -> a -> [a] -> [a]
justifyRight n c = (drop . length) <*> (replicate n c ++)
justifyRight n c = (drop . length) <*> (replicate n c <>)


showSquare
showSquare :: Show a => [[a]] -> String
:: Show a
=> [[a]] -> String
showSquare rows =
showSquare rows =
⚫
( (\xs w -> unlines ((justifyRight w ' ' =<<) <$> xs))
⚫
let srows = fmap show <$> rows
w = succ $ maximum (length <$> concat srows)
<*> succ . maximum . fmap length . join
)
⚫
in unlines $ fmap (justifyRight w ' ' =<<) srows</lang>
⚫
$ fmap show <$> rows</lang>
{{Out}}
{{Out}}
<pre> 8 1 6
<pre> 8 1 6
Retrieved from "https://rosettacode.org/wiki/Magic_squares_of_odd_order"