Eu vim com uma solução que usa o sistema do tipo Haskell. Pesquisei um pouco por uma solução existente para o problema no nível de valor , mudei um pouco e levantei-a para o nível de tipo. Foi preciso muita reinvenção. Eu também tive que habilitar várias extensões do GHC.
Primeiro, como números inteiros não são permitidos no nível de tipo, eu precisava reinventar os números naturais mais uma vez, desta vez como tipos:
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
O algoritmo que adaptei faz acréscimos e subtrações aos naturais, então tive que reinventá-los também. As funções no nível de tipo são definidas com recurso às classes de tipo. Isso requer extensões para várias classes de tipo de parâmetro e dependências funcionais. As classes de tipo não podem "retornar valores"; portanto, usamos um parâmetro extra para isso, de maneira semelhante a 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
A recursão é implementada com asserções de classe, portanto, a sintaxe parece um pouco atrasada.
Em seguida foram os booleanos:
data True -- type that represents truth
data False -- type that represents falsehood
E uma função para fazer comparações de desigualdade:
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
E lista ...
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 também estão ausentes no nível de tipo ...
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
E com isso, todas as máquinas de apoio que eu usei estavam no lugar. Hora de resolver o problema em si!
Começando com uma função para testar se adicionar uma dama a um quadro existente está correto:
-- 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)]
Observe o uso de asserções de classe para obter resultados intermediários. Como os valores de retorno são realmente um parâmetro extra, não podemos simplesmente chamar as asserções diretamente uma da outra. Novamente, se você já usou o PROLOG antes, pode achar esse estilo um pouco familiar.
Depois de fazer algumas alterações para remover a necessidade de lambdas (que eu poderia ter implementado, mas decidi sair por mais um dia), é a aparência da solução original:
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é uma função de ordem superior. Eu pensei que a implementação de meta-funções de ordem superior seria muito complicada (mais uma vez as lambdas), então eu apenas segui com uma solução mais simples: como eu sei quais funções serão mapeadas, eu posso implementar versões especializadas de mapcada uma, para que elas não sejam funções de ordem superior.
-- 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)
E a última meta-função pode ser escrita agora:
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
Tudo o que resta é algum tipo de driver para persuadir o mecanismo de verificação de tipo para encontrar as soluções.
-- dummy value of type Eight
eight = undefined :: Eight
-- dummy function that asserts the Queens class
queens :: Queens n r => n -> r
queens = const undefined
Esse metaprograma deve ser executado no verificador de tipos, para que você possa iniciar ghcie solicitar o tipo de queens eight:
> :t queens eight
Isso excederá o limite de recursão padrão bastante rápido (são apenas 20). Para aumentar esse limite, precisamos chamar ghcicom a -fcontext-stack=Nopção, onde Nestá a profundidade da pilha desejada (N = 1000 e quinze minutos não é suficiente). Ainda não vi essa execução completa, pois leva muito tempo, mas consegui executá-la queens four.
Existe um programa completo em ideone com algumas máquinas para imprimir os tipos de resultados, mas só queens twopode ser executado sem exceder os limites :(