;******************************************************************
; File: N-QUEENS.clp
; Content: Specific Module for Solving the N-queens Problem.
; This module must be used with the MAIN and SEARCH
; modules contained in the CCP.clp file
; Authors: Jean-Marc Labat and Michel Futtersack
; Version: 1.0 (September 1997)
; Contact: Jean-Marc.Labat,Michel.Futtersack@poleia.lip6.fr
;******************************************************************


;#################### the N-Queens Problem ##########################
; Place N queens on a NxN chessboard in such a way that no one queen
; could take another queen. We have chosen N = 12. Greater N is feasible
; but the time of computation grows exponentially !
;###################################################################



;#################### Modeling ##########################################
; A variable represents a queen in a row. For example, x1 represents
; the queen placed on the first row. We have to define a bijection of
; the set of rows {x1, x2,...x12} onto the set of columns {1, 2, ...12}
; In this modeling some constraints are implicit : only one variable
; is called x1 implies that only one queen will be placed on the first row
;##########################################################################

(defmodule PROPAG
(import MAIN deftemplate ?ALL))

;################## possible values for the variables ################

(deffacts PROPAG::queens
(var (name x1) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x2) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x3) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x4) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x5) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x6) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x7) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x8) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x9) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x10) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x11) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
(var (name x12) (possible-values (create$ 1 2 3 4 5 6 7 8 9 10 11 12)))
)

;################## description of the chessboard ##################

(deftemplate PROPAG::queen
(slot name)
(slot row)
)


(deffacts chessboard
(queen (name x1) (row 1))
(queen (name x2) (row 2))
(queen (name x3) (row 3))
(queen (name x4) (row 4))
(queen (name x5) (row 5))
(queen (name x6) (row 6))
(queen (name x7) (row 7))
(queen (name x8) (row 8))
(queen (name x9) (row 9))
(queen (name x10) (row 10))
(queen (name x11) (row 11))
(queen (name x12) (row 12))
(nb_variables 12)
(rank_of_printing 1)
(solution_to_be_printed 1)
)

;########################## Functions ###############################

(deffunction PROPAG::cassoc$ (?key ?Alist)
; useful for printing the solution
; cassoc$ returns the value associated with the key ?key in the association list ?Alist
(nth$ (+ 1 (member$ ?key ?Alist)) ?Alist)
)

;########################## Constraints propagation ##################

(defrule PROPAG::propagation-1
; if the column ?v has been chosen for the queen ?x then remove ?v
; from the list of possible values of the other queens not yet placed
(declare (salience 2))
(logical (level_search ?n))
(not (level_search ?n1&:(> ?n1 ?n)))
(var (name ?x) (value ?v&~nil)(level ?n))
?f <- (var (name ?y) (value nil) (level ?m)
(possible-values $?liste&:(member$ ?v ?liste)))
(not (var (name ?y) (level ?m1&:(> ?m1 ?m))))
=>
(bind ?var (member$ ?v ?liste))
(if (= ?m ?n)
then (modify ?f (possible-values (delete$ ?liste ?var ?var )))
else (duplicate ?f (level ?n) (possible-values (delete$ ?liste ?var ?var ))))
)


(defrule PROPAG::propagation-2
; if the queen ?x is placed in the ?n1 row and the ?v column then
; remove from the list of possible values of the queen ?y all the values
; correponding to the same diagonal
(logical (level_search ?n))
(not (level_search ?n1&:(> ?n1 ?n)))
(var (name ?x) (value ?v&~nil) (level ?n))
(queen (name ?x) (row ?n1))
(queen (name ?y) (row ?n2))
?f <- (var (name ?y) (value nil) (level ?m)
(possible-values $?liste&:(member$ (- ?v (- ?n1 ?n2)) ?liste)))
(not (var (name ?y) (level ?m1&:(> ?m1 ?m))))
=>
(bind ?var (member$ (- ?v (- ?n1 ?n2)) ?liste))
(if (= ?m ?n)
then (modify ?f (possible-values (delete$ ?liste ?var ?var)))
else (duplicate ?f (level ?n) (possible-values (delete$ ?liste ?var ?var))))
)

(defrule PROPAG::propagation-3
; like propagation-2, for the other diagonal
(logical (level_search ?n))
(not (level_search ?n1&:(> ?n1 ?n)))
(var (name ?x) (value ?v&~nil) (level ?n))
(queen (name ?x) (row ?n1))
(queen (name ?y) (row ?n2))
?f <- (var (name ?y) (value nil) (level ?m)
(possible-values $?liste&:(member$ (- ?v (- ?n2 ?n1)) ?liste)))
(not (var (name ?y) (level ?m1&:(> ?m1 ?m))))
=>
(bind ?var (member$ (- ?v (- ?n2 ?n1)) ?liste))
(if (= ?m ?n)
then (modify ?f (possible-values (delete$ ?liste ?var ?var)))
else (duplicate ?f (level ?n) (possible-values (delete$ ?liste ?var ?var))))
)

;############################ rules for printing the chessboard #######

(defrule PROPAG::customized_printing
; print the chessboard corresponding to a solution
(pb (state blocked)(level 0))
(solution (number ?n) (var-val $?list&:(> (length$ $?list) 0)))
(solution_to_be_printed ?n)
(queen (name ?queen) (row ?r))
(nb_variables ?nb)
?p <- (rank_of_printing ?r)
=>
(bind ?v (cassoc$ ?queen $?list))
(loop-for-count (?i 1 (- ?v 1)) do (printout t "* "))(printout t "X ")(loop-for-count (?i (+ ?v 1) ?nb) do (printout t "* "))(printout t crlf)
(assert (rank_of_printing (+ ?r 1)))
(retract ?p)
)

(defrule PROPAG::next_printing
; for printing the next solution if any
(declare (salience -10))
(pb (state blocked)(level 0))
(solution (number ?n))
?p<-(rank_of_printing ?r)
?q<-(solution_to_be_printed ?n)
=>
(printout t crlf crlf)
(retract ?p)
(assert (rank_of_printing 1))
(retract ?q)
(assert (solution_to_be_printed (+ ?n 1)))
)