Я придумал решение, которое использует систему типов Haskell. Я немного погуглил существующее решение проблемы на уровне значений , немного изменил его, а затем поднял до уровня типа. Потребовалось много изобретений. Мне также пришлось включить несколько расширений GHC.
Во-первых, поскольку на уровне типов недопустимы целые числа, мне нужно было заново изобретать натуральные числа, на этот раз в виде типов:
data Zero -- type that represents zero
data S n -- type constructor that constructs the successor of another natural number
-- Some numbers shortcuts
type One = S Zero
type Two = S One
type Three = S Two
type Four = S Three
type Five = S Four
type Six = S Five
type Seven = S Six
type Eight = S Seven
Алгоритм, который я адаптировал, делает сложения и вычитания на натуральных объектах, поэтому мне пришлось их заново изобретать. Функции на уровне типов определяются с использованием классов типов. Это требует расширений для нескольких классов типов параметров и функциональных зависимостей. Классы типов не могут «возвращать значения», поэтому мы используем для этого дополнительный параметр, аналогично PROLOG.
class Add a b r | a b -> r -- last param is the result
instance Add Zero b b -- 0 + b = b
instance (Add a b r) => Add (S a) b (S r) -- S(a) + b = S(a + b)
class Sub a b r | a b -> r
instance Sub a Zero a -- a - 0 = a
instance (Sub a b r) => Sub (S a) (S b) r -- S(a) - S(b) = a - b
Рекурсия реализована с помощью утверждений классов, поэтому синтаксис выглядит немного назад.
Далее были логические:
data True -- type that represents truth
data False -- type that represents falsehood
И функция для сравнения неравенства:
class NotEq a b r | a b -> r
instance NotEq Zero Zero False -- 0 /= 0 = False
instance NotEq (S a) Zero True -- S(a) /= 0 = True
instance NotEq Zero (S a) True -- 0 /= S(a) = True
instance (NotEq a b r) => NotEq (S a) (S b) r -- S(a) /= S(b) = a /= b
И списки ...
data Nil
data h ::: t
infixr 0 :::
class Append xs ys r | xs ys -> r
instance Append Nil ys ys -- [] ++ _ = []
instance (Append xs ys rec) => Append (x ::: xs) ys (x ::: rec) -- (x:xs) ++ ys = x:(xs ++ ys)
class Concat xs r | xs -> r
instance Concat Nil Nil -- concat [] = []
instance (Concat xs rec, Append x rec r) => Concat (x ::: xs) r -- concat (x:xs) = x ++ concat xs
class And l r | l -> r
instance And Nil True -- and [] = True
instance And (False ::: t) False -- and (False:_) = False
instance (And t r) => And (True ::: t) r -- and (True:t) = and t
ifs также отсутствуют на уровне типа ...
class Cond c t e r | c t e -> r
instance Cond True t e t -- cond True t _ = t
instance Cond False t e e -- cond False _ e = e
И с этим все вспомогательные механизмы, которые я использовал, были на месте. Время заняться самой проблемой!
Начиная с функции для проверки правильности добавления ферзя на существующую доску:
-- Testing if it's safe to add a queen
class Safe x b n r | x b n -> r
instance Safe x Nil n True -- safe x [] n = True
instance (Safe x y (S n) rec,
Add c n cpn, Sub c n cmn,
NotEq x c c1, NotEq x cpn c2, NotEq x cmn c3,
And (c1 ::: c2 ::: c3 ::: rec ::: Nil) r) => Safe x (c ::: y) n r
-- safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)]
Обратите внимание на использование утверждений класса для получения промежуточных результатов. Поскольку возвращаемые значения на самом деле являются дополнительным параметром, мы не можем просто вызывать утверждения напрямую друг от друга. Опять же, если вы использовали PROLOG раньше, вам может показаться, что этот стиль немного знаком.
После того, как я сделал несколько изменений, чтобы убрать необходимость в лямбдах (которые я мог бы реализовать, но я решил уйти на другой день), вот как выглядело оригинальное решение:
queens 0 = [[]]
-- The original used the list monad. I "unrolled" bind into concat & map.
queens n = concat $ map f $ queens (n-1)
g y x = if safe x y 1 then [x:y] else []
f y = concat $ map (g y) [1..8]
mapявляется функцией более высокого порядка. Я думал, что реализация мета-функций более высокого порядка будет слишком хлопотной (опять же лямбда-выражения), поэтому я просто выбрал более простое решение: так как я знаю, какие функции будут отображаться, я могу реализовать специализированные версии mapдля каждой, чтобы они не были функции высшего порядка.
-- Auxiliary meta-functions
class G y x r | y x -> r
instance (Safe x y One s, Cond s ((x ::: y) ::: Nil) Nil r) => G y x r
class MapG y l r | y l -> r
instance MapG y Nil Nil
instance (MapG y xs rec, G y x g) => MapG y (x ::: xs) (g ::: rec)
-- Shortcut for [1..8]
type OneToEight = One ::: Two ::: Three ::: Four ::: Five ::: Six ::: Seven ::: Eight ::: Nil
class F y r | y -> r
instance (MapG y OneToEight m, Concat m r) => F y r -- f y = concat $ map (g y) [1..8]
class MapF l r | l -> r
instance MapF Nil Nil
instance (MapF xs rec, F x f) => MapF (x ::: xs) (f ::: rec)
И последняя мета-функция может быть написана сейчас:
class Queens n r | n -> r
instance Queens Zero (Nil ::: Nil)
instance (Queens n rec, MapF rec m, Concat m r) => Queens (S n) r
Все, что осталось, это какой-то драйвер, чтобы уговорить механизм проверки типов для выработки решений.
-- dummy value of type Eight
eight = undefined :: Eight
-- dummy function that asserts the Queens class
queens :: Queens n r => n -> r
queens = const undefined
Предполагается, что эта метапрограмма работает на контроллере типов, поэтому можно запустить ghciи запросить тип queens eight:
> :t queens eight
Это довольно быстро превысит установленный по умолчанию предел рекурсии (это жалкие 20). Чтобы увеличить этот предел, нам нужно вызвать ghciс -fcontext-stack=Nопцией, где Nжелаемая глубина стека (N = 1000 и пятнадцать минут недостаточно). Я еще не видел этот прогон до завершения, так как он занимает очень много времени, но мне удалось подойти к нему queens four.
На Ideone есть полная программа с некоторыми механизмами для красивой печати типов результатов, но они queens twoмогут работать только без превышения ограничений :(