Step by Step solution about How to resolve the algorithm Magic squares of singly even order step by step in the Haskell programming language

The provided Haskell program generates magic squares, which are square grids of numbers where the sum of each row, column, and diagonal is the same. The specific type of magic square produced by the program is known as a LUX magic square, where the symbols L (left), U (up), and X (center) are used instead of numbers.

Here's a detailed explanation of the code:

1. Import Statements:

   • The program imports several modules from the Haskell standard library, including Data.Map.Strict, Data.List, Data.Maybe, Control.Monad, and Data.Monoid. These modules provide functionality for working with maps, lists, monads, and monoids.

2. magic Function:

   • The magic function takes an integer n as input and returns a magic square of size n. The magic square is represented as a list of lists of integers, where each inner list represents a row in the square.

3. hiResMap Function:

   • The hiResMap function takes an integer n as input and returns a map from coordinates to integers. The coordinates represent the positions in a high-resolution version of the magic square, and the integer values represent the numbers to be placed at those positions.

4. luxNums Function:

   • The luxNums function takes a coordinate, a character representing the type of cell (L, U, or X), and an initial number as input and returns a list of four coordinates with their corresponding numbers. These coordinates represent the positions in the LUX magic square where the numbers should be placed.

5. mapAsTable Function:

   • The mapAsTable function takes an integer nCols and a map from coordinates to integers as input and returns a list of lists of integers. The output represents the magic square as a table with nCols columns and the numbers arranged according to the input map.

6. luxMap Function:

   • The luxMap function takes an integer n as input and returns a map from coordinates to characters (L, U, or X). The coordinates represent the positions in the LUX magic square, and the characters represent the symbols to be placed at those positions.

7. luxPattern Function:

   • The luxPattern function takes an integer n as input and returns a list of strings representing the pattern of L, U, and X symbols in the LUX magic square.

8. siamMap Function:

   • The siamMap function takes an integer n as input and returns a map from coordinates to integers. The coordinates represent the positions in the Siamese version of the magic square, and the integer values represent the numbers to be placed at those positions. The Siamese version of a magic square is a variation where the numbers are arranged in a specific pattern.

9. nextSiam Function:

   • The nextSiam function takes an integer uBound, a map from coordinates to integers representing the Siamese magic square so far, and a coordinate as input and returns the next coordinate in the Siamese pattern.

10. hiRes Function:

    • The hiRes function takes a coordinate as input and returns a list of four coordinates at higher resolution. These coordinates represent the positions in the high-resolution version of the magic square that correspond to the input coordinate.

11. checked Function:

    • The checked function takes a magic square as input and returns a tuple containing the sum of the rows, columns, and diagonals of the square and a Boolean value indicating whether all the sums are equal.

12. table Function:

    • The table function takes a delimiter and a list of lists of strings as input and returns a list of strings representing the table with the provided delimiter.

13. main Function:

    • The main function is the entry point of the program. It generates LUX magic squares for sizes 1, 2, and 3, prints the squares as tables, and checks if they are valid magic squares (i.e., if all rows, columns, and diagonals sum to the same value).

import qualified Data.Map.Strict as M
import Data.List (transpose, intercalate)
import Data.Maybe (fromJust, isJust)
import Control.Monad (forM_)
import Data.Monoid ((<>))

magic :: Int -> [[Int]]
magic n = mapAsTable ((4 * n) + 2) (hiResMap n)

-- Order of square -> sequence numbers keyed by cartesian coordinates
hiResMap :: Int -> M.Map (Int, Int) Int
hiResMap n =
  let mapLux = luxMap n
      mapSiam = siamMap n
  in M.fromList $
     foldMap
       (\(xy, n) ->
           luxNums xy (fromJust (M.lookup xy mapLux)) ((4 * (n - 1)) + 1))
       (M.toList mapSiam)

-- LUX table coordinate -> L|U|X -> initial number -> 4 numbered coordinates
luxNums :: (Int, Int) -> Char -> Int -> [((Int, Int), Int)]
luxNums xy lux n =
  zipWith (\x d -> (x, n + d)) (hiRes xy) $
  case lux of
    'L' -> [3, 0, 1, 2]
    'U' -> [0, 3, 1, 2]
    'X' -> [0, 3, 2, 1]
    _ -> [0, 0, 0, 0]

-- 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) <$>
     (axis >>= \y -> [axis >>= \x -> [(x, y)]])

-- Dimension of LUX table -> LUX symbols keyed by coordinates
luxMap :: Int -> M.Map (Int, Int) Char
luxMap n =
  (M.fromList . concat) $
  zipWith
    (\y xs -> (zipWith (\x c -> ((x, y), c)) [0 ..] xs))
    [0 ..]
    (luxPattern n)

-- LUX dimension -> square of L|U|X cells with two mixed rows
luxPattern :: Int -> [String]
luxPattern n =
  let d = (2 * n) + 1
      [ls, us] = replicate n <$> "LU"
      [lRow, xRow] = replicate d <$> "LX"
  in replicate n lRow <> [ls <> ('U' : ls)] <> [us <> ('L' : us)] <>
     replicate (n - 1) xRow

-- Highest zero-based index of grid -> Siamese indices keyed by coordinates
siamMap :: Int -> M.Map (Int, Int) Int
siamMap n =
  let uBound = (2 * n)
      sPath uBound sMap (x, y) n =
        let newMap = M.insert (x, y) n sMap
        in if y == uBound && x == quot uBound 2
             then newMap
             else sPath uBound newMap (nextSiam uBound sMap (x, y)) (n + 1)
  in sPath uBound (M.fromList []) (n, 0) 1

-- 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 && b < 0 = (uBound, 1) -- Top right corner ?
        | a > uBound = (0, b) -- beyond right edge ?
        | b < 0 = (a, uBound) -- above top edge ?
        | isJust (M.lookup (a, b) sMap) = (a - 1, b + 2) -- already filled ?
        | otherwise = (a, b) -- Up one, right one.
  in alt (x + 1, y - 1)

-- LUX cell coordinate -> four coordinates at higher resolution
hiRes :: (Int, Int) -> [(Int, Int)]
hiRes (x, y) =
  let [col, row] = (* 2) <$> [x, y]
      [col1, row1] = succ <$> [col, row]
  in [(col, row), (col1, row), (col, row1), (col1, row1)]

-- TESTS ----------------------------------------------------------------------
checked :: [[Int]] -> (Int, Bool)
checked square = (h, all (h ==) t)
  where
    diagonals = fmap (flip (zipWith (!!)) [0 ..]) . ((:) <*> (return . reverse))
    h:t = sum <$> square <> transpose square <> diagonals square

table :: String -> [[String]] -> [String]
table delim rows =
  let justifyRight c n s = drop (length s) (replicate n c <> s)
  in intercalate delim <$>
     transpose
       ((fmap =<< justifyRight ' ' . maximum . fmap length) <$> transpose rows)

main :: IO ()
main =
  forM_ [1, 2, 3] $
  \n -> do
    let test = magic n
    putStrLn $ unlines (table " " (fmap show <$> test))
    print $ checked test
    putStrLn ""