Я придумав рішення, яке використовує систему типу Haskell. Я трохи погукнув Google для існуючого рішення проблеми на рівні значення , трохи змінив її, а потім підняв її до рівня типу. Потрібно було багато винаходити. Я також повинен був включити купу розширень 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можуть працювати лише без перевищення меж :(