Загальний Лісп, 737
самовідповідь
(lambda(n &aux(d 1))#2=(catch'$(let((s(* n n))(c d))(labels((R(w % @ b ! &aux r h v a)(loop for u from % below s do(setf h(mod u n)v(floor u n)a #4=(aref b u))(when(< 0(logand a w)4)(and(= 6 w)!(throw'! t))(let((b(copy-seq b))(o 5))(loop for(K D)on'(-1 -2 -1 2 1 -2 1 2)for y =(+ K v)for x =(+(or D -1)h)for u =(and(< -1 y n)(< -1 x n)(+(* y n)x))if u do #1=(if(< #4#4)(setf #4#(logand #4#o(if(= w o)3 0)))))(#8=dotimes(y N)(#8#(x N)(let((u(+(* y n)x))(o 6))(if(or(= x h)(= y v)(=(abs(- h x))(abs(- v y))))#1#))))(setf #4#w r(or(cond((= w 5)(R 6 @ U b !))((R 5 @ U b())t)((catch'!(R 5 0 0 b t))t)(t(and(=(decf c)0)(incf d)(or(format t"~%(lambda(&aux(n ~A)(d ~A))~%~S)"n d'#2#)(throw'$ B)))t))r)))))r))(R 5 0 0(fill(make-array s)3)())))))
Приклад
Вставте вище в REPL, який повертає об'єкт функції:
#<FUNCTION (LAMBDA (N &AUX (D 1))) {1006D1010B}>
Назвіть це (зірка прив’язана до останнього повернутого значення):
QN> (funcall * 4)
Це видає наступне на стандартний вихід:
(lambda(&aux(n 4)(d 2))
#1=(CATCH '$
(LET ((S (* N N)) (C D))
(LABELS ((R (W % @ B ! &AUX R H V A)
(LOOP FOR U FROM % BELOW S
DO (SETF H (MOD U N)
V (FLOOR U N)
A #2=(AREF B U)) (WHEN (< 0 (LOGAND A W) 4)
(AND (= 6 W) !
(THROW '! T))
(LET ((B (COPY-SEQ B))
(O 5))
(LOOP FOR (K D) ON '(-1
-2
-1 2
1 -2
1 2)
FOR Y = (+ K V)
FOR X = (+
(OR D -1)
H)
FOR U = (AND
(< -1 Y N)
(< -1 X N)
(+ (* Y N)
X))
IF U
DO #3=(IF (< #2# 4)
(SETF #2#
(LOGAND
#2#
O
(IF (=
W
O)
3
0)))))
(DOTIMES (Y N)
(DOTIMES (X N)
(LET ((U
(+ (* Y N) X))
(O 6))
(IF (OR (= X H)
(= Y V)
(=
(ABS
(- H X))
(ABS
(- V
Y))))
#3#))))
(SETF #2# W
R
(OR
(COND
((= W 5)
(R 6 @ U B !))
((R 5 @ U B
NIL)
T)
((CATCH '!
(R 5 0 0 B
T))
T)
(T
(AND
(= (DECF C)
0)
(INCF D)
(OR
(FORMAT T
"~%(lambda(&aux(n ~A)(d ~A))~%~S)"
N D
'#1#)
(THROW '$
B)))
T))
R)))))
R))
(R 5 0 0 (FILL (MAKE-ARRAY S) 3) NIL)))))
Також значення, повернене цією функцією:
#(5 0 0 0 0 0 0 6 0 0 0 2 0 2 0 0)
... що є буквальним масивом. Число 5 представляє королеви, 6 - для лицарів, а все інше означає порожню клітинку, за винятком того, що є більше інформації, яка зберігається всередині. Якщо ми скопіюємо повернуту функцію до repl, отримаємо нову функцію.
#<FUNCTION (LAMBDA (&AUX (N 4) (D 2))) {100819148B}>
І ми можемо викликати це без аргументів:
QN> (funcall * )
Цей виклик повертає нове рішення #(5 0 0 0 0 0 0 2 0 0 0 6 0 0 2 0)та джерело іншої функції (тут не показано). Якщо оригінальна функція або остання згенерована не знайшла рішення, нічого не друкується і нічого не повертається.
Внутрішні значення
|----------+--------+---------+--------+-----------------|
| | Binary | Decimal | Symbol | Meaning |
|----------+--------+---------+--------+-----------------|
| Empty | 000 | 0 | - | safe for none |
| | 001 | 1 | q | safe for queen |
| | 010 | 2 | n | safe for knight |
| | 011 | 3 | # | safe for both |
|----------+--------+---------+--------+-----------------|
| Occupied | 101 | 5 | Q | a queen |
| | 110 | 6 | K | a knight |
|----------+--------+---------+--------+-----------------|
Я використовував для створення занадто мало рішень. Тепер я поширюю, яка клітина безпечна для королеви та для лицаря, незалежно. Наприклад, ось вихід n = 5 із симпатичним друком:
Q - - - -
- - - n N
- q - n n
- # n - n
- n # # -
Коли ми розмістили королеву Q, позиції, які віддаляються від лицаря від цієї королеви, як і раніше безпечні для королеви і позначаються q. Так само, лицарі, доступні лише королевам, безпечні для інших лицарів. Значення розрядні і -ед, щоб представляти можливі рухи, і деякі комірки доступні без будь-якого елемента.
Точніше, ось послідовність дощок, що ведуть до наступного рішення (зліва направо), де вільні комірки поступово обмежуються різними значеннями:
# # # # # # q - - - q # - - - - - # - - - - - # - - - - - n
# # # # # # - - Q - - - - - Q - - - - - Q - - - - - Q - - -
# # # # # # q - - - q # q - - - - - Q - - - - - Q - - - - -
# # # # # # - q - q - # - q - - - n - - - - - n - - - - - n
# # # # # # # # - # # - n n - n N - - - - n N - - - - - N -
# # # # # # # # - # # # # # - n n n - # - - n n - n - - n N
Підхід, який не має душі
Безголовка, коментована версія
(defun queens-and-knights
(n ; size of problem
fn ; function called for each solution
;; AUX parameters are like LET* bindings but shorter.
&aux
;; total number of cells in a board
(s (* n n)))
(labels
;; Define recursive function R
((R (w ; what piece to place: 5=queen, 6=knight
% ; min position for piece of type W
@ ; min position for the other kind of piece
b ; current board
! ; T iff we are in "check" mode (see below)
&aux
r ; result of this function: will be "true" iff we can
; place at least one piece of type W on the board b
h ; current horizontal position
v ; current vertical position
a ; current piece at position (h,v)
)
(loop
;; only consider position U starting from position %,
;; because any other position below % was already visited
;; at a higher level of recursion (e.g. the second queen
;; we place is being placed in a recursive call, and we
;; don't visit position before the first queen).
for u from % below s
do
(setf h (mod u n) ; Intialize H, V and A
v (floor u n) ;
a (aref b u)) ;
;; Apply an AND mask to current value A in the board
;; with the type of chess piece W. In order to consider
;; position U as "safe", the result of the bitwise AND
;; must be below 4 (empty cell) and non-null.
(when (< 0 (logand a w) 4)
;; WE FOUND A SAFE PLACE TO PUT PIECE W
(when (and ! (= 6 w))
;; In "check" mode, when we place a knight, we knwo
;; that the check is successful. In other words, it
;; is possible to place an additional queen and
;; knight in some board up the call stack. Instead
;; of updating the board we can directly exit from
;; here (that gave a major speed improvement since
;; we do this a lot). Here we do a non-local exit to
;; the catch named "!".
(throw '! t))
;; We make a copy of current board b and bind it to the
;; same symbol b. This allocates a lot of memory
;; compared to the previous approach where I used a
;; single board and an "undo" list, but it is shorter
;; both in code size and in runtime.
(let ((b (copy-seq b)))
;; Propagate knights' constraints
(loop
;; O is the other kind of piece, i.e. queen here
;; because be propagate knights. This is used as
;; a mask to remove knights pieces as possible
;; choices.
with o = 5
;; The list below is arranged so that two
;; consecutive numbers form a knight-move. The ON
;; iteration keyword descend sublist by sublist,
;; i.e. (-1 -2), (-2 -1), (-1 2), ..., (2 NIL). We
;; destructure each list being iterated as (K D),
;; and when D is NIL, we use value -1.
for (K D) on '(-1 -2 -1 2 1 -2 1 2)
;; Compute position X, Y and index U in board,
;; while checking that the position is inside the
;; board.
for y = (+ K v)
for x = (+ (or D -1) h)
for u = (and (< -1 y n)
(< -1 x n)
(+(* y n)x))
;; if U is a valid position...
if u
do
;; The reader variable #1# is affected to the
;; following expression and reused below for
;; queens. That's why the expression is not
;; specific to knights. The trick here is to
;; use the symbols with different lexical
;; bindings.
#1=(when (< (aref b u) 4) ; empty?
(setf (aref b u)
(logand
;; Bitwise AND of current value ...
(aref b u)
;; ... with o: position U is not a
;; safe place for W (inverse of O)
;; anymore, because if we put a W
;; there, it would attack our
;; current cell (H,V).
o
;; ... and with zero (unsafe for
;; all) if our piece W is also a
;; knight (resp. queen). Indeed, we
;; cannot put anything at position
;; U because we are attacking it.
(if (= w o) 3 0)))))
;; Propagate queens' constraints
(dotimes (y N)
(dotimes (x N)
(let ((u(+(* y n)x))(o 6))
(if (or (= x h)
(= y v)
(= (abs(- h x)) (abs(- v y))))
;; Same code as above #1=(if ...)
#1#))))
(setf
;; Place piece
(aref b u) w
;; Set result value
r (or (cond
;; Queen? Try to place a Knight and maybe
;; other queens. The result is true only if
;; the recursive call is.
((= w 5) (R 6 @ U b !))
;; Not a queen, so all below concern
;; knights: we always return T because
;; we found a safe position.
;; But we still need to know if
;; board B is an actual solution and
;; call FN if it is.
;; ------------------------------------
;; Can be place a queen too? then current
;; board is not a solution.
((R 5 @ U b()) t)
;; Try to place a queen and a knight
;; without constraining the min positions
;; (% and @); this is the "check" mode that
;; is represented by the last argument to
;; R, set to T here. If it throws true,
;; then board B is a duplicate of a
;; previous one, except that it is missing
;; pieces due to constraints % and @. The
;; "check" mode is a fix to a bug where we
;; reported as solutions boards where there
;; was still room for other pieces.
((catch'!(R 5 0 0 b t)) t)
;; Default case: we could not add one more
;; layer of pieces, and so current board B
;; is a solution. Call function FN.
(t (funcall fn b) t))
;; R keeps being true if it already was for
;; another position.
r)))))
;; Return result R
r))
;; Start search with a queen and an empty board.
(R 5 0 0 (fill (make-array s) 3) nil)))
Дублікати та помилки
Моє перше рішення виводило дублюючі рішення. Щоб вирішити це, я ввів два прилавки для королеви та лицарів. Лічильник для королеви (відповідних лицарів) відслідковує перше місце на дошці, де існує королева (респ. Лицар): я додаю королеву (відповідно, лицаря) лише на посадах, які відповідають цій мінімальній позиції.
Цей метод заважає мені переглядати рішення, які вже були знайдені в попередніх ітераціях, тому що я повторюю позицію, що зростає з королевою (відповідно, лицарем).
Однак Сліфаар зауважив, що існують рішення, для яких може бути місце для королеви та лицарів, що суперечить правилам. На деякий час мені хотілося повернутися до звичайного пошуку та зберігати всі відомі рішення для запобігання дублікатів, які здавались занадто дорогими (як з точки зору байтів, так і з використанням пам'яті).
Натомість, ось що я зараз роблю: коли знайдена дошка потенційного рішення, я намагаюся додати рівно одну королеву та одного лицаря, не враховуючи лічильників (тобто для всіх комірок на дошці). Якщо це можливо, то поточна плата є дублікатом попередньої, і я відкидаю рішення.
Тести
|---+---------+------------+--------------|
| N | boards | seconds | bytes |
|---+---------+------------+--------------|
| 3 | 0 | 0 | 32768 |
| 4 | 40 | 0 | 360416 |
| 5 | 172 | 0 | 3440016 |
| 6 | 2836 | 0.085907 | 61251584 |
| 7 | 23876 | 1.265178 | 869666288 |
| 8 | 383586 | 24.991300 | 17235142848 |
| 9 | 6064506 | 524.982987 | 359952648832 |
|---+---------+------------+--------------|
Quine-ification
У мене були різні ідеї зробити послідовні лайки. Найпростіший - це, мабуть, сформувати всі рішення спочатку у вигляді списку рядків та записати послідовні лайки, які з’являються із цього списку в кожному поколінні. Однак це, здається, не було коротшим, ніж сучасний підхід. Крім того, я намагався переписати рекурсивний код за допомогою спеціального стеку та скидати всі змінні стану кожного разу, коли я знаходжу рішення; мета полягає в тому, що наступний крок може бути оброблений як продовження поточного кроку. Можливо, це краще підходить для мови на основі стека. Поточний досить простий і покладається на загальні змінні зчитувача Lisp, якими завжди цікаво користуватися.