Решение упражнения 2.42 из SICP

3 February, 2008 (12:47) | Решения упражнений

Задача о восьми ферзях – это классический пример проблемы, которая решается перебором вариантов. Задача сама по себе, как и задача о Ханойских башнях, весьма интересна, а ее решение показывает несколько важных алгоритмических приемов.

Каркас процедуры решения за нас уже определили заботливые авторы, нам же осталось только задать представление позиций на доске константой empty-board и процедурой adjoin-position, а также реализовать проверку безопасности позиции процедурой-предикатом safe?.

Я предлагаю хранить позиции как списки номеров горизонталей, в которых располагаются ферзи. Список позиций тогда задается списком таких списков. Пустая доска обозначается пустым списком (списком из нуля элементов, так как на доске расставлено 0 ферзей). Для удобства операций при описании позиции ферзи в списке будут перечисляться в обратном порядке (от последнего добавленного к первому). Можно также описать такое задание как движение не слева направо по вертикалям, а справа налево.

Для пояснения рассмотрим доску 4х4, где ферзи расставлены слева направо во второй, четвертой, первой и третьей горизонталях.

queens-1.png

Эта позиция будет задаваться списком (3 1 4 2).

Итак, пустая доска задается пустым списком:

(define empty-board (list))

Для того, чтобы добавить к позиции еще одного ферзя, просто добавим номер горизонтали, на которой он расположен, в начало списка, обозначающего позицию:

(define (adjoin-position new-row k rest-of-queens)
  (cons new-row rest-of-queens))

Проверка позиции на безопасность заключается в том, чтобы пройти по всем ферзям с предпоследнего до первого и проверить безопасны ли они для последнего (по построению они гарантированно безопасны друг для друга). Эту задачу выполняет предикат queens-safe?. Проверка того, безопасен ли очередной ферзь для последнего выполняется предикатом queen-safe?, который проверяет два условия:

  1. стоят ли эти ферзи на одной горизонтали (равенство горизонталей),
  2. стоят ли эти ферзи на одной диагонали (равенство модуля разности между горизонталями и модулю разности между вертикалями).

Проверку того, стоят ли ферзи на одной вертикали делать не нужно, так как по построению все вертикали гарантированно различны.

Таким образом получаем следующее определение процедуры safe?:

(define (safe? k position)
  (define (queens-safe? queen-count rest-rows)
    (define (queen-safe? col row)
      (let ((last-col k) (last-row (car position)))
        (and (not (= last-row row))
             (not (= (abs (- last-row row))
                     (abs (- last-col col)))))))
    (cond ((null? rest-rows) true)
          ((queen-safe? queen-count (car rest-rows))
             (queens-safe? (- queen-count 1) (cdr rest-rows)))
          (else false)))
  (queens-safe? (- k 1) (cdr position)))

Собирая результат воедино, получим для доски 4х4 следующие две безопасные позиции:

> (queens 4)
((3 1 4 2) (2 4 1 3))

Для доски 5х5 существует 10 различных решений. Для доски 6х6 количество решений меньше, всего 4. Для доски 7х7 есть уже 40 решений. Для доски 8х8 ферзей можно расставить 92 способами. Доска 9х9 допускает 352 различных расстановки, а 10х10 – 724.

Одно из решений (первое, которое выдает наша программа) задачи о восьми ферзях (то есть для доски 8х8) изображено ниже:

queens-2.png

Правда, интересная задачка?

Comments

Comment from Кравцов Егор
Date: February 4, 2008, 12:13 am

Буквально сегодня решил самостоятельно. Решил проверить, узнав количество решений для доски 8х8 и попал на Ваш блог.

Был очень приятно удивлён, т.к. сам прорешиваю SICP )))

Comment from Sergey Khenkin
Date: February 4, 2008, 8:48 am

Егор, рад, что и вы тоже занимаетесь такими интересными задачами. Желаю успехов в этом начинании!

Вот, кстати, интересный отрывок из книги Явгения Яковлевича Гика “Шахматы и математика”:

“Очевидно, больше восьми мирных ферзей (как и ладей) на обычной доске расставить невозможно. Найти какое-нибудь расположение восьми ферзей, не угрожающих друг другу, легко. Значительно труднее подсчитать общее число расстановок, в чем, собственно, и состоит задача.

Любопытно, что многие авторы ошибочно приписывали эту задачу и ее решение самому К. Гауссу. На самом деле, она была впервые поставлена в 1848 г. немецким шахматистом М. Беццелем. Доктор Ф. Наук нашел 60 решений и опубликовал их в газете “Illustrierte Zeitung” от 1 июня 1850 г. Лишь после этого Гаусс заинтересовался задачей и нашел 72 решения, которые он сообщил в письме к своему другу астроному Шумахеру от 2 сентября 1850 г. Полный же набор решений, состоящий из 92 позиций, получил все тот же Ф. Наук. Он привел их в упомянутой газете от 21 сентября 1850 г. Эта хронология установлена известным немецким исследователем математических развлечений В. Аренсом.

Строгое доказательство того, что 92 решения исчерпывают все возможности, было получено лишь в 1874 г. английским математиком Д. Глэшером (при помощи теории определителей). Забегая вперед, отметим, что существенных решений (не совпадающих при отражениях и поворотах доски) имеется только двенадцать.

Известно много способов организовать эффективный поиск расположения восьми мирных ферзей (методы Пермантье, Ла-Ное, Гюнтера, Глэшера, Лакьера и др.). Эти способы описаны в многочисленной литературе по занимательной математике. В наш век ЭВМ задача такого сорта не вызвала бы столь живой интерес. Ведь достаточно составить несложную программу, и уже через несколько минут после ее введения в машину все 92 необходимые позиции будут выданы на печать.”

Comment from nobody
Date: July 9, 2008, 10:21 pm

Строгое доказательство того, что 92 решения исчерпывают все возможности, было получено лишь в 1874 г. английским математиком Д. Глэшером (при помощи теории определителей).

Странно (ИМХО). Ведь даже если проделать алгоритм, описанный в SICP, вручную, это займёт не больше двух часов. Я впервые прочитал об этой задаче у Перельмана и там тоже упоминался этот алгоритм. Компьютера тогда у меня не было, поэтому я находил позиции вручную и рисовал палочки на бумажке (полностью позиции я не записывал). А ведь полный перебор это тоже доказательство?

Comment from Sergey Khenkin
Date: July 9, 2008, 10:35 pm

Возможно, математикам такое доказательство казалось недостаточно красивым для официальной публикации.

Comment from Dima
Date: August 20, 2008, 4:10 am

Вот версия safe? которая (мне кажется) немного проще, и берёт только один аргумент, упрощая етим queens (где фильтровать теперь можно прямо через safe? вместо лямбды):


(define (safe? layout)
(define (iter old-queens n)
(if (null? old-queens)
#t
(let ((new (car layout))
(old (car old-queens)))
(if (or (= new old)
(= new (+ old n))
(= new (- old n)))
#f
(iter (cdr old-queens) (+ n 1))))))
(iter (cdr layout) 1))

Comment from hub
Date: October 8, 2008, 12:21 pm

Если допустить, что позиция задается не как список (3 1 4 2), а как – ((3 4) (1 3) (4 2) (2 1)), т. е. переписываем adjoin-position так:

(define (adjoin-position row col seqs)  (cons (list row col) seqs))

(define (safe? col position)
  (let ((new (car position))
        (olds (cdr position)))
    (accumulate (lambda (old compared)
                  (let ((delta-row  (- (car new) (car old)))
                        (delta-col (- (cadr new) (cadr old))))
                    (and (not (= delta-row 0))
                         (not (= (abs delta-row)
                                 (abs delta-col)))
                         compared)))
                #t
                olds)))

Comment from Nergal
Date: November 23, 2009, 4:18 am

А если задавать список позиций как ((3 . 4) (1 . 3) (4 . 2) (2 . 1)), то переписываем так:

(define (adjoin-position r c rest) (cons (cons r c) rest))

(define (safe? k positions)
(null? (filter (lambda (pos)
(or (= (car pos) (caar positions))
(= (abs (- (car pos) (caar positions))) (abs (- (cdr pos) (cdar positions))))))
(cdr positions))))

Comment from Александр
Date: May 5, 2010, 6:17 pm

Очень долго ломал голову где же применить параметр k который передаётся процедуре (adjoin-position new-row k rest-of-queens), в итоге ничего не придумал =) и реализовал процедуру через append (т.к. у меня список вертикалей не обёрнут как у вас). Вы тоже этому параметру не нашли применение как я вижу, так что это получается ошибка в книге? Или автор имел в виду более хитрую реализацию алгоритма?

Comment from Алексей
Date: June 19, 2012, 5:47 pm

Было очень забавно и приятно выполнить это упражнение методом “фильтрации”, имея в багаже прочтение HTDP, где решение задачи о ферзях реализовывалось при помощи backtracking’a.

Comment from Denis Larionov
Date: December 24, 2016, 5:45 pm

пришлось немного переименовать оригинальные названия методов и параметров

(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-position)
        (filter
         (lambda (position) (safe? k position))
         (flatmap
          (lambda (k-1-position)
            (map (lambda (row)
                   (add-queen row k k-1-position))
                 (enumerate 1 board-size)))
          (queen-cols (- k 1))))))
  (queen-cols board-size))

(define empty-position (list))

(define (add-queen row k k-1-position) 
  (cons row k-1-position))

(define (safe? k position)
  (let ((added-queen-row (car position))
        (added-queen-col 1))
    (define (iter col tail)
      (if (null? tail)
          true        
          (let ((next-queen-row (car tail))
                (next-queen-col col))
            (if (or (= added-queen-row next-queen-row) ; -
                    ;(= added-queen-col next-queen-col) ; |
                    (= (+ added-queen-row added-queen-col) (+ next-queen-row next-queen-col)) ; \
                    (= (+ added-queen-row (- (+ 1 k) added-queen-col)) (+ next-queen-row (- (+ 1 k) next-queen-col))) ; /                 
                    )
                false
                (iter (+ 1 col) (cdr tail))))))    
    (iter 2 (cdr position))))

Comment from gumanovski
Date: July 13, 2017, 8:58 pm

Реализовывал позиции, как списки ((3 1) (1 2) (4 3) (2 4))

(define (adjoin-position new-row k rest-of-queens)
  (append rest-of-queens (list (list new-row k)))
)

(define empty-board (list))

(define (safe-horiz? currentqueen otherqueens)
  (null? (filter (lambda (x) (= (car currentqueen) (car x))) otherqueens))
)

(define (safe-diag? currentqueen otherqueens)
  (null? (filter (lambda (x) (= (abs (- (car currentqueen) (car x))) (abs (- (cadr currentqueen) (cadr x))))) otherqueens))
)

(define (safe? k positions)
  (let ((currentqueen (car (filter (lambda (x) (= (cadr x) k)) positions)))
	(otherqueens (filter (lambda (x) (not (= (cadr x) k))) positions)))
    (and (safe-horiz? currentqueen otherqueens) (safe-diag? currentqueen otherqueens))
)
)

Write a comment