;;; Eight Queens
;;; generate and test
;;; generate part: generates all permutations in sorted order

;;; next permutation in lexicographic order

(defun next (perm)
  "Returns the next permutation after PERM in lexicographic order.
   If this is the last one, returns NIL.
   The lenght of PERM must be at least 1."
  (let ((triple (partition perm)))
    (if (null triple)
	nil
      (let* ((a (first triple))		; the first part
	     (p (second triple))		; the pivot
	     (b (third triple))		; the second part
	     (pair (locate p a))	; returns a dotted pair
	     (newp (first pair))
	     (newa (rest pair)))
	(append newa (cons newp b))
	)
      )
    )
  )

(defun partition (perm)
  "Partitions the permutation PERM into a maximal increasing prefix (MIP),
   a pivot (element right after the MIP), and the rest of the permutation.
   If there is no pivot, returns NIL, signalling the end of the series."
  (partaux () perm)
  )

(defun partaux (head tail)
  (cond
   ((null (cdr tail)) nil)
   ((> (first tail) (second tail))
    (list (cons (first tail) head) (second tail) (cddr tail)))
   (t (partaux (cons (first tail) head) (rest tail)))
   )
  )

(defun locate (p a)
  (locaux p () a)
  )

(defun locaux (p rhead tail)
  (if (or (null (cdr tail))
	  (> p (second tail)))
      (cons (first tail) (apprev rhead (cons p (cdr tail))))
    (locaux p (cons (car tail) rhead) (cdr tail))
    )
  )

(defun apprev (a b)
  (if (null a)
      b
    (apprev (cdr a) (cons (car a ) b))
    )
  )

(defun good (perm)
  "Predicate that returns T when PERM is a solution of the queens problem."
  (and (diff (plus-diags perm))
       (diff (minus-diags perm))
       )
  )

(defun diff (lista)
  "Returns T when all elements of LISTA are distinct."
  (if (< (length lista) 2)
      t
    (and (not (member (car lista) (cdr lista)))
	 (diff (cdr lista)))
    )
  )

(defun plus-diags (perm)
  (op-aux #'+ (length perm) perm)
  )

(defun minus-diags (perm)
  (op-aux #'- (length perm) perm)
  )

(defun op-aux (op n lista)
  (if (null lista)
      ()
    (cons (funcall op n (car lista)) (op-aux op (1- n) (cdr lista)))
    )
  )

(do ((j '(8 7 6 5 4 3 2 1) (next j))) ((not j)) (when (good j) (print j)))