Se me ocurrió una solución que utiliza el sistema de tipo Haskell. Busqué en Google un poco para una solución existente al problema en el nivel de valor , lo cambié un poco y luego lo elevé al nivel de tipo. Tomó mucho reinventar. También tuve que habilitar un montón de extensiones de GHC.
Primero, dado que los números enteros no están permitidos en el nivel de tipo, necesitaba reinventar los números naturales una vez más, esta 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
El algoritmo que adapté hace sumas y restas en naturales, así que tuve que reinventarlas también. Las funciones en el nivel de tipo se definen con el recurso a clases de tipo. Esto requiere las extensiones para múltiples clases de tipos de parámetros y dependencias funcionales. Las clases de tipos no pueden "devolver valores", por lo que usamos un parámetro adicional para eso, de manera similar 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
La recursión se implementa con aserciones de clase, por lo que la sintaxis parece un poco hacia atrás.
Lo siguiente fueron los booleanos:
data True -- type that represents truth
data False -- type that represents falsehood
Y una función para hacer comparaciones de desigualdad:
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
Y listas ...
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 también faltan en el nivel 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
Y con eso, toda la maquinaria de soporte que usé estaba en su lugar. ¡Es hora de abordar el problema en sí!
Comenzando con una función para probar si agregar una reina a un tablero existente está bien:
-- 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 el uso de aserciones de clase para obtener resultados intermedios. Debido a que los valores de retorno son en realidad un parámetro adicional, no podemos simplemente llamar a las aserciones directamente entre sí. Nuevamente, si ha usado PROLOG antes, puede encontrar este estilo un poco familiar.
Después de hacer algunos cambios para eliminar la necesidad de lambdas (que podría haber implementado, pero decidí irme para otro día), así es como se veía la solución 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]
mapEs una función de orden superior. Pensé que implementar metafunciones de orden superior sería demasiado complicado (nuevamente las lambdas), así que decidí una solución más simple: como sé qué funciones se asignarán, puedo implementar versiones especializadas mappara cada una, de modo que no funciones de orden 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)
Y la última metafunción se puede escribir ahora:
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
Todo lo que queda es algún tipo de controlador para persuadir a la maquinaria de verificación de tipos para encontrar las soluciones.
-- dummy value of type Eight
eight = undefined :: Eight
-- dummy function that asserts the Queens class
queens :: Queens n r => n -> r
queens = const undefined
Se supone que este metaprograma se ejecuta en el verificador de tipo, por lo que se puede iniciar ghciy solicitar el tipo de queens eight:
> :t queens eight
Esto excederá el límite de recursión predeterminado bastante rápido (es un mísero 20). Para aumentar este límite, necesitamos invocar ghcicon la -fcontext-stack=Nopción, donde Nestá la profundidad de pila deseada (N = 1000 y quince minutos no es suficiente). Todavía no he visto esta ejecución completa, ya que lleva mucho tiempo, pero me las he arreglado para hacerlo queens four.
Hay un programa completo en ideone con algo de maquinaria para imprimir bonitos los tipos de resultados, pero solo queens twopuede ejecutarse sin exceder los límites :(