From 5f4da018672624b28d761c1b35015a98b19653ad Mon Sep 17 00:00:00 2001
From: "Peter S. Housel" <housel@acm.org>
Date: Tue, 18 Feb 2020 21:20:06 -0800
Subject: [PATCH] gabriel: Fix the puzzle benchmark
According to the comments from Henry Baker and the papers referenced
from his page, the puzzle benchmark is supposed to arrive at a
solution in 2005 trials (as measured by *kount*). Due to off-by-one
and logic errors converting DO to DOTIMES, among other problems, the
code arrived at an incorrect solution in many fewer trials than are
actually necessary.
---
files/gabriel.lisp | 35 +++++++++++++++++++----------------
1 file changed, 19 insertions(+), 16 deletions(-)
diff --git a/files/gabriel.lisp b/files/gabriel.lisp
index e00d661..d5c2f3c 100644
--- a/files/gabriel.lisp
+++ b/files/gabriel.lisp
@@ -1424,22 +1424,25 @@
(defun fit (i j)
(declare (fixnum i j))
- (dotimes (k (svref *piecemax* i))
+ (dotimes (k (1+ (svref *piecemax* i)) t)
+ (declare (type fixnum k))
(and (aref *puzzle-p* i k)
- (svref *puzzle* (+ j k))
- (return nil)))
- t)
+ (svref *puzzle* (the fixnum (+ j k)))
+ (return nil))))
(defun place (i j)
(declare (fixnum i j))
(let ((end (svref *piecemax* i)))
- (declare (fixnum end))
- (dotimes (k end)
- (when (aref *puzzle-p* i k)
- (setf (svref *puzzle* (+ j k)) t)))
- (setf (svref *piece-count* (svref *class* i))
- (the fixnum (- (the fixnum (svref *piece-count* (svref *class* i))) 1)))
- (do ((k j (1+ k)))
+ (declare (type fixnum end))
+ (dotimes (k (1+ end))
+ (declare (type fixnum k))
+ (cond ((aref *puzzle-p* i k)
+ (setf (svref *puzzle* (the fixnum (+ j k))) t))))
+ (setf (aref *piece-count* (aref *class* i))
+ (the fixnum
+ (- (the fixnum
+ (aref *piece-count* (aref *class* i))) 1)))
+ (do ((k j (the fixnum (1+ k))))
((> k +puzzle-size+)
; (terpri)
; (princ "Puzzle filled")
@@ -1454,10 +1457,10 @@
(do ((k 0 (1+ k)))
((> k end))
(when (aref *puzzle-p* i k)
- (setf (svref *puzzle* (+ j k)) nil))
- (setf (svref *piece-count* (svref *class* i))
- (the fixnum (+ (the fixnum (svref *piece-count* (svref *class* i)))
- 1))))))
+ (setf (svref *puzzle* (+ j k)) nil)))
+ (setf (svref *piece-count* (svref *class* i))
+ (the fixnum (+ (the fixnum (svref *piece-count* (svref *class* i)))
+ 1)))))
(defun trial (j)
(declare (fixnum j))
@@ -1546,7 +1549,7 @@
(cond ((fit 0 m) (setq n (place 0 m)))
(t (format t "~%Error.")))
(cond ((trial n)
- ;; (format t "~%Success in ~4D trials." kount)
+ ;; (format t "~%Success in ~4D trials." *kount*)
)
(t (format t "~%Failure.")))))
--
GitLab