Entry tags:

ФП

Тема магических квадратов неисчерпаема
Продолжаем рассмотрение темы магических квадратов в рамках моих заметок про «Функциональное программирование», которая была начата здесь. Предыдущая запись на эту тему показывала более или менее быстрый переборный алгоритм, который по расчётам должен был выдать все магические квадраты размером 4 x 4 не более, чем за десять часов. Ну и решил я это дело проверить, а заодно получить все такие магические квадраты для будущего использования.

Но перед этим захотелось мне привести алгоритм в божеский вид с точки зрения универсальности, а также написа́ть методы для корректного отображения квадратов на экране (чтобы в виде квадратов рисовались, а не в виде несуразных списков чисел). Вот вам, заинтересованные мои читатели, небольшой исходный код, который решает обе задачи — делает предыдущий алгоритм более универсальным, а также реализует экземпляр класса Show для типа, описывающего магический квадрат:

{-# OPTIONS -fglasgow-exts #-}

module Main where

data Square a =
  Square
  {
    dimension :: Int,
    values    :: [a]
  }

newtype MagicList f = ML [f]

class Magic f where
  isMagic         :: f -> Bool
  getMagicFigures :: Int -> MagicList f

instance Magic (Square Int) where
  isMagic (Square d v) = if (d^2 /= length v)
                           then False
                           else (testH ms d v) && 
                                (testV ms d v) && 
                                (testD ms d v)
    where ms = magicSum d

  getMagicFigures d = ML [square | square <- constructSquares d [1..(d^2)],
                                   isMagic square]

instance Show a => Show (Square a) where
  show (Square d v) = if (null v)
                        then "+" ++ (showLine d)
                        else "+" ++ (showLine d) ++
                             "\n|" ++ showRow (take d v) ++
                             "\n" ++ show (Square d (drop d v))
    where showRow []     = ""
          showRow (x:xs) = (showCell x) ++ (showRow xs)

          showCell x     = " " ++ (replicate (nLength d2 - nLength x) ' ') ++
                           (show x) ++ " |"

          showLine 0 = ""
          showLine i = "-" ++ (replicate (nLength d2) '-') ++ "-+" ++
                       (showLine (i - 1))

          nLength x = length $ show x

          d2 = d^2

instance Show a => Show (MagicList (Square a)) where
  show (ML [])     = ""
  show (ML (x:xs)) = show x ++ "\n\n" ++ show (ML xs)

(//) :: Eq a => [a] -> a -> [a]
[] // y     = []
(x:xs) // y = if (x == y)
                then xs
                else x:(xs // y)

(///) :: Eq a => [a] -> [a] -> [a]
s /// [] = s
s /// (x:xs) = (s // x) /// xs

magicSum :: Integral a => a -> a
magicSum d = div (sum [1..(d^2)]) d

arrangements :: (Num a, Eq b) => a -> [b] -> [[b]]
arrangements 0 _ = [[]]
arrangements d l = [x:as | x <- l,
                           as <- (arrangements (d - 1) (l // x))]

constructSquares :: Int -> [Int] -> [Square Int]
constructSquares d [] = [Square d []]
constructSquares d l  = [Square d (a ++ as) | a <- (arrangements d l),
                                              sum a == ms,
                                              (Square d as) <- (constructSquares d (l /// a))]
  where ms = magicSum d

testH :: Int -> Int -> [Int] -> Bool
testH _ _ [] = True
testH ms d v = (sum (take d v) == ms) && 
               (testH ms d (drop d v))

testV :: Int -> Int -> [Int] -> Bool
testV ms d v = testV' ms d d v
  where testV' _ 0 _ _  = True
        testV' ms a d v = (sum [v !! ((a - 1) + (j * d)) | j <- [0..(d - 1)]] == ms) && 
                          (testV' ms (a - 1) d v)

testD :: Int -> Int -> [Int] -> Bool
testD ms d v = (sum [v !! (i * (d + 1)) | i <- [0..(d - 1)]] == ms) && 
               (sum [v !! ((i + 1) * (d - 1)) | i <- [0..(d - 1)]] == ms)

main :: Int -> IO ()
main d = print (getMagicFigures d :: MagicList (Square Int))

Как видно, сам алгоритм не изменился, для магических фигур (любых) описан интерфейсный класс, а тип данных для описания магических квадратов сделан в виде отдельного АТД, для которого реализованы экземпляры классов Magic и Show. Всё.

Далее этот исходный код был откомпилирован в GHC с параметром -O, после чего получившийся исполняемый модуль был запущен на выходные в прошлую пятницу с выводом результатов в файл. Нынче утром я обнаружил полученный файл, который был размером в полтора мегабайта, и в коем были записаны все магические квадраты размером 4 x 4. Их оказалось 7040. Вот первый и последний из полученного списка:

+----+----+----+----+
|  1 |  2 | 15 | 16 |
+----+----+----+----+
| 12 | 14 |  3 |  5 |
+----+----+----+----+
| 13 |  7 | 10 |  4 |
+----+----+----+----+
|  8 | 11 |  6 |  9 |
+----+----+----+----+

+----+----+----+----+
| 16 | 15 |  2 |  1 |
+----+----+----+----+
|  5 |  3 | 14 | 12 |
+----+----+----+----+
|  4 | 10 |  7 | 13 |
+----+----+----+----+
|  9 |  6 | 11 |  8 |
+----+----+----+----+

Как видно, эти оба квадрата изоморфны друг другу — они получаются банальным отражением по вертикали.

Написанные функции show для новых типов данных (Square a и MagicList (Square a)) выводили найденные магические фигуры именно в таком виде. И главное заключается в том, что для получения других типов магических фигур достаточно описать тип для их представления и сделать его экземпляром класса Magic. После этого можно запускать процесс поиска. Вот, я знаю, что Ломео по результатам обсуждения этих вопросов со мной реализовал иной тип данных для представления магических квадратов же, где, по его словам, имеется выигрыш как и в способе (простоте представления), так и в скорости проверки квадрата на магичность. Просим поделиться...

P. S.: Тех моих читателей, кому тема сия неинтересна, прошу набраться терпения. Всё это пишу я в рамках подготовки материалов для моей новой научно-популярной статьи в журнал для школьников «Потенциал». Ибо обучение подрастающего поколения — благое дело.