Haskell tip sistemini kullanan bir çözüm buldum. Var olan bir çözüm için değer seviyesindeki soruna biraz göz attım, biraz değiştirdim ve sonra da tür düzeyine yükselttim. Çok fazla yeniden icat aldı. Ayrıca bir sürü GHC uzatması sağlamak zorunda kaldım.
Birincisi, tamsayılar tür düzeyinde izin verilmediğinden, doğal sayıları bir kez daha yeniden icat etmem gerekiyordu, bu kez türler:
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
Uyarladığım algoritma, doğalları toplamalar ve çıkarmalar yapıyor, bu yüzden bunları da yeniden icat etmek zorunda kaldım. Tip seviyesindeki fonksiyonlar, resort tipine ve tip sınıflarına göre tanımlanır. Bu, çoklu parametre tipi sınıfları ve işlevsel bağımlılıklar için uzantıları gerektirir. Tip sınıfları "değerleri döndüremez", bu yüzden PROLOG'a benzer şekilde bunun için fazladan bir parametre kullanırız.
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
Özyineleme, sınıf iddialarıyla uygulanır, böylece sözdizimi biraz geriye bakar.
Sırada booleanlar vardı:
data True -- type that represents truth
data False -- type that represents falsehood
Ve eşitsizlik karşılaştırması yapacak bir fonksiyon:
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
Ve listeler ...
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
if
Ayrıca tür düzeyinde eksik ...
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
Ve bununla birlikte, kullandığım tüm destekleyici makineler yerindeydi. Sorunun kendisiyle mücadele zamanı!
Mevcut bir panoya bir kraliçe ekleyip tamamlamadığınızı test etmek için bir işlevle başlamak:
-- 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)]
Ara sonuçların elde edilmesi için sınıf iddialarının kullanıldığına dikkat edin. Dönüş değerleri aslında fazladan bir parametre olduğundan, iddiaları doğrudan birbirimizden arayamayız. Yine, eğer PROLOG'u daha önce kullandıysanız, bu tarzı biraz tanıdık bulabilirsiniz.
Lambda ihtiyacını ortadan kaldırmak için birkaç değişiklik yaptıktan sonra (uygulayabildiğim, ancak başka bir gün için ayrılmaya karar verdim), özgün çözüm şöyle görünüyordu:
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
daha yüksek dereceli bir fonksiyondur. Daha yüksek dereceli meta-fonksiyonlar uygulamanın çok fazla güçlük olacağını düşündüm (yine lambdalar), bu yüzden daha basit bir çözüm buldum: hangi fonksiyonların haritalanacağını bildiğim map
için, her biri için özel versiyonlar uygulayabiliyorum , ki bunlar üst düzey fonksiyonlar.
-- 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)
Ve son meta-fonksiyon şimdi yazılabilir:
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
Geriye kalan tek şey, çözümleri kontrol etmek için tip kontrol makinelerini koaksiyel bir tür sürücü.
-- dummy value of type Eight
eight = undefined :: Eight
-- dummy function that asserts the Queens class
queens :: Queens n r => n -> r
queens = const undefined
Bu meta-programın tip denetleyicisi üzerinde çalışması gerekiyordu, böylece biri ateşlenip aşağıdakileri ghci
isteyebilir queens eight
:
> :t queens eight
Bu, varsayılan yineleme sınırını oldukça hızlı aşacaktır (yaklaşık olarak 20). Bu sınırı artırmak için, çağırmak için gereken ghci
ile -fcontext-stack=N
seçenek, N
istenen yığın derinliği (N = 1000 ve on beş dakika yeterli değildir). Bu koşuyu henüz tamamlanmamıştı, çünkü çok uzun zaman alıyor, ama koşmayı başardım queens four
.
Orada tam bir programdır oldukça sonuç türlerini yazdırmak için bazı makinelerle ideone üzerinde, ama orada sadece queens two
sınırlarını aşmadan çalıştırabilirsiniz :(