Классическая задача расстановки безопасных фигур для махараджи, Common Lisp

Классическая задача расстановки безопасных фигур для махараджи

;; Пункт (point или pt) задает положение фигуры на доске. Пункт определяется как точечная пара, в которой
;; первый элемент задает номер вертикали (координата x), а второй --- номер горизонтали (координата y).

;; Функция-предикат safep определяет, находятся ли две фигуры в безопасном положении друг к другу. Для
;; пары магарадж это значит, что они не находятся на одной горизонтали, вертикали, диагонали, а также в
;; положении хода конем (1 пункт в одном направлении и 3 пункта в другом). Для эффективности мы не
;; проверяем нахождение на одной вертикали, так как все пункты в программе генерируются на разных
;; вертикалях.

(defun safep (pt1 pt2)
  (let* ((x1 (car pt1))
	 (y1 (cdr pt1))
	 (x2 (car pt2))
	 (y2 (cdr pt2))
	 (dx (abs (- x1 x2)))
	 (dy (abs (- y1 y2))))
    (and
     (/= y1 y2) ; на разных горизонталях
     (/= dx dy) ; на разных диагоналях
     (or (/= dx 2) (/= dy 1)) ; не ход коня (вариант 1)
     (or (/= dx 1) (/= dy 2)) ; не ход коня (вариант 2)
     )))
	    
;; Позиция (position, pos или p) определяет расположение на доске нескольких фигур. Позиция задается
;; списком пунктов, в которых расположены фигуры. Позиция может быть полной или завершенной (complete),
;; когда уже расставлено необходимое количество фигур, либо частичной (partial), когда заполнена только
;; часть вертикалей. Кроме того, позиция может быть правильной (valid) и неправильной (invalid). В
;; правильной позиции все фигуры расположены безопасно. Однако в мы будем генерировать только правильные
;; позиции.

;; Функция-предикат allowedp проверяет, является ли пункт pt допустимым дополнением для позиции p. Пункт
;; допустим, если фигура, расположенная в нем, находится в безопасном положении ко всем остальным фигурам
;; в позиции. Другими словами, добавление пункта к правильной позиции создает новую правильную
;; позицию. Для эффективности мы предполагаем, что заданная позиция p правильная, а вертикаль пункта pt
;; (координата y) не совпадает ни с одной из вертикалей (координат y) для фигур в позиции.

(defun allowedp (pt p)
  (every #'(lambda (pt1) (safep pt pt1)) p))

;; Функция extend расширяет заданную частичную позицию p. Для этого функции передается общий размер
;; задачи n и количество фигур k, которые еще нужно расставить. Позиции строятся таким образом, чтобы
;; первая фигура в списке имела максимальный номер вертикали imax. Поэтому вертикаль для новой фигуры
;; перебирается от imax+1 до n-k+1 (тем самым оставляется место еще для k-1 фигуры), а горизонталь --- от
;; 1 до n. Из всех сгенерированных пунктов отбираются допустимые в заданной позиции, и затем для каждого
;; допустимого пункта строится новая правильная позиция путем включения этого пункта в заданную
;; позицию. В результате возвращается список допустимых позиций, размер которых на единицу больше размера
;; заданной частичной позиции.

(defun extend (n k p)
  (loop for i from (1+ (caar p)) to (1+ (- n k))
	append (loop for j from 1 to n
		     for pt = (cons i j)
		     when (allowedp pt p)
		     collect (cons pt p))))

;; Функция solve рекурсивно преобразует список правильных позиций размера i-1 в список правильных позиций
;; размера i. Пусть размер доски равен n, количество фигур, которые еще нужно расставить, равно k, и у
;; нас уже построен список правильных позиций. Если k=0, то все фигуры расставлены, все позиции полные, и
;; продолжать вычисления не нужно, просто возвращаем список полных правильных позиций (по сути, решение
;; задачи). В противном случае каждая позиция из исходного списка может быть рекурсивно расширена с
;; помощью extend до списка правильных позиций, где установлено на одну фигуру больше. Достаточно
;; объединить эти списки в один и продолжить рекурсивное вычисление теперь уже для k-1 фигур.

(defun solve (n k ps)
  (if (= k 0)
      ps
    (solve n (1- k)
	     (apply #'append
		    (map 'list #'(lambda (p) (extend n k p)) ps)))))

;; Главная функция place принимает два аргумента --- общий размер доски n и количество фигур для
;; расстановки k. Эта функция готовит начальные данные для solve, а именно, формирует список n^2 позиций
;; размера 1, где первая фигура последовательно ставится на все пункты доски. Затем вызывается solve для
;; получения списка решений, и в конце каждое решение приводится к каноническому виду. А именно, все
;; пункты в позиции упорядочены по убыванию номеру вертикали, в то время, как удобнее читать позицию по
;; увеличению номера вертикали. Поэтому для каждой позиции вызывается функция reverse.

(defun place (n k)
  (map 'list #'reverse
       (solve n (1- k)
	      (loop for i from 1 to n
		    append (loop for j from 1 to n
				 collect (list (cons i j)))))))

;; Функция pretty просто аккуратно выводит список решений и возвращает их количество

(defun pretty (ps)
  (dolist (p ps (length ps))
    (princ p)
    (princ (format nil "~%"))))

;; Пример вызова при N=12, то есть, расстановка 12 магарадж

(princ (pretty (place 10 9)))


run \| edit \| history \| help	0

λ

                                      .NET NoSQL database for rapid development