Entry tags:

ФП

Ещё пара слов про магические квадраты
Напишу ещё немного про магические квадраты, рассмотрение которых было начато здесь. Тема сия обширна, а потому, думаю, что она станет основой для моей очередной научно-популярной статьи, в коих я рассказываю о преимуществах функционального программирования над прочими подходами. Здесь же хочу зафиксировать некоторые интересные результаты, достигнутые в процессе оптимизации вычислений. Дело в том, что переборы бываю разные, а потому можно использовать те или иные ограничения для отсекания неныжных ветвей перебора, которые заведомо не приведут к должному результату.

После некоторого раздумья над тем, как можно оптимизировать переборный процесс, было найдено некоторое промежуточное решение, которое и представлено здесь. Необходимо отметить, что предыдущий алгоритм для осуществления перебора использовал понятие перестановки, поэтому самый внешний цикл работал именно по всем перестановкам для n2, что влекло за собой комбинаторный взрыв. Однако, если подумать, нет никакого смысла разбирать перестановки, у которых первые n чисел не составляют в сумме магическое число. То же самое справедливо и для остальных n-ок. Поэтому внешний цикл необходимо устраивать по размещениям из n2 по n, отсекая на этом этапе ненужные комбинации. Итого получилось достаточно прилично:

module MagicSquare
  (getMagicSquares)
where

(//) :: 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

arrangements 0 _ = [[]]
arrangements n l = [x:as | x <- l,
                           as <- (arrangements (n - 1) (l // x))]

constructSquares _ [] = [[]]
constructSquares n l  = [a ++ as | a <- (arrangements n l),
                                   sum a == s,
                                   as <- (constructSquares n (l /// a))]
  where s = magicSum n

permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations l  = [x:ps | x <- l,
                          ps <- (permutations (l // x))]

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

isMagic :: Int -> [Int] -> Bool
isMagic n ms = if (n^2 /= length ms)
                 then False
                 else (testH n s ms) && 
                      (testV n s ms) && 
                      (testD n s ms)
  where s = magicSum n

testH :: Num a => Int -> a -> [a] -> Bool
testH _ _ [] = True
testH n s ms = (sum (take n ms) == s) && 
               (testH n s (drop n ms))

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

testD :: Num a => Int -> a -> [a] -> Bool
testD n s ms = (sum [ms !! (i * (n + 1)) | i <- [0..(n - 1)]] == s) && 
               (sum [ms !! ((i + 1) * (n - 1)) | i <- [0..(n - 1)]] == s)

getMagicSquares :: Int -> [[Int]]
getMagicSquares n = [ms | ms <- permutations [1..(n^2)],
                         isMagic n ms]

getMagicSquares' n = [ms | ms <- constructSquares n [1..(n^2)],
                           isMagic n ms]

Главная функция здесь — arrangements, именно она вычисляет список размещений. Впрочем, она работает по тому же принципу, что и функция permutations, поэтому останавливать на ней своё внимание не сто́ит. Более интересна функция constructSquares, которая конструирует квадраты, среди которых ищутся магические. Конструирование производится по принципу, который обуславливает равенство сумм каждой n-ки магической сумме. Далее каждый квадрат проверяется на магичность уже́ разработанным способом.

В итоге получилось весьма интересно. Как видно, в целях сравнения был оставлен и предыдущий алгоритм. Функция getMagicSquares работает по старому алгоритму, а функция getMagicSquares' — по новому. Эти функции были запущены для аргумента 3 и выдали одинаковые результаты (что абсолютно прогнозировалось). Но времена, которые они затратили на вычисления, поражают: 28.98 секунд против 1.13 секунд. Итого имеем 25-кратное преимущество нового алгоритма, основанного на размещениях, перед старым.

Замеренные времена помогают оценить количество времени, которое необходимо для вычисления всех магических квадратов размерности 4 x 4 (и далее). Для визуализации этого вычисления можно построить график:


Диаграмма сия построена на основе следующих данных, замеренных при вычислении магических квадратов размерностями 1 x 1, 2 x 2 и 3 x 3. Замерялись такие параметры: количество шагов редукции, количество задействованных ячеек памяти и количество запусков процесса сборки мусора. Эти пааметры приведены в следующей таблице:

#	getMagicSquares			getMagicSquares'			Отношение величин
	Редукции	Память	Сборка	Редукции	Память	Сборка	Редукции	Память	Сборка
1	801	1352	0	975	1488	0	0.82	0.91	0.00
2	13742	19850	0	8983	13152	0	1.53	1.51	0.00
3	241655710	343801576	380	4780042	6693709	7	50.56	51.36	54.29
4	4.35586E+15	7.02455E+15		1.46905E+11	1.96168E+11		29650.92957	35808.87961

Красным шрифтом показаны вычисленные (прогнозируемые) значения. Само собой, представленный график нарисован на логарифмической шкале Y (равные расстояния на ней показывают равные отношения величин, но не разности). Но даже на ней видно, что сложность алгоритма квадратична (именно на алгоритмической шкале). Это ясно свидетельствует о том, что решать подобные задачи перебором невозможно. Впрочем, речь сейчас о другом. Итак, подсчитаны величины для размерности магического квадрата 4 x 4. Эти величины можно использовать для оценки времени, которое потребуется для перебора всех комбинаций. Не буду утомлять читателя занудными выкладками (кому интересно — пишите в комментариях), скажу лишь, что при той производительности, на которой всё это замерено, вычисление всех магических квадратов размерностью 4 x 4 с использованием перестановок займёт шестнадцать с половиной лет, а с использованием размещений — девять с половиной часов.