Commit a1119745 authored by Daniel Kochmański's avatar Daniel Kochmański

Merge branch 'puzzle-fix' into 'master'

gabriel: Fix the puzzle benchmark

See merge request !1
parents 5f245bf6 ed4970c4
......@@ -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.")))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment