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

Merge branch 'puzzle-fix' into 'master'

gabriel: Fix the puzzle benchmark

See merge request !1
parents 5f245bf6 ed4970c4
...@@ -1424,22 +1424,25 @@ ...@@ -1424,22 +1424,25 @@
(defun fit (i j) (defun fit (i j)
(declare (fixnum 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) (and (aref *puzzle-p* i k)
(svref *puzzle* (+ j k)) (svref *puzzle* (the fixnum (+ j k)))
(return nil))) (return nil))))
(defun place (i j) (defun place (i j)
(declare (fixnum i j)) (declare (fixnum i j))
(let ((end (svref *piecemax* i))) (let ((end (svref *piecemax* i)))
(declare (fixnum end)) (declare (type fixnum end))
(dotimes (k end) (dotimes (k (1+ end))
(when (aref *puzzle-p* i k) (declare (type fixnum k))
(setf (svref *puzzle* (+ j k)) t))) (cond ((aref *puzzle-p* i k)
(setf (svref *piece-count* (svref *class* i)) (setf (svref *puzzle* (the fixnum (+ j k))) t))))
(the fixnum (- (the fixnum (svref *piece-count* (svref *class* i))) 1))) (setf (aref *piece-count* (aref *class* i))
(do ((k j (1+ k))) (the fixnum
(- (the fixnum
(aref *piece-count* (aref *class* i))) 1)))
(do ((k j (the fixnum (1+ k))))
((> k +puzzle-size+) ((> k +puzzle-size+)
; (terpri) ; (terpri)
; (princ "Puzzle filled") ; (princ "Puzzle filled")
...@@ -1454,10 +1457,10 @@ ...@@ -1454,10 +1457,10 @@
(do ((k 0 (1+ k))) (do ((k 0 (1+ k)))
((> k end)) ((> k end))
(when (aref *puzzle-p* i k) (when (aref *puzzle-p* i k)
(setf (svref *puzzle* (+ j k)) nil)) (setf (svref *puzzle* (+ j k)) nil)))
(setf (svref *piece-count* (svref *class* i)) (setf (svref *piece-count* (svref *class* i))
(the fixnum (+ (the fixnum (svref *piece-count* (svref *class* i))) (the fixnum (+ (the fixnum (svref *piece-count* (svref *class* i)))
1)))))) 1)))))
(defun trial (j) (defun trial (j)
(declare (fixnum j)) (declare (fixnum j))
...@@ -1546,7 +1549,7 @@ ...@@ -1546,7 +1549,7 @@
(cond ((fit 0 m) (setq n (place 0 m))) (cond ((fit 0 m) (setq n (place 0 m)))
(t (format t "~%Error."))) (t (format t "~%Error.")))
(cond ((trial n) (cond ((trial n)
;; (format t "~%Success in ~4D trials." kount) ;; (format t "~%Success in ~4D trials." *kount*)
) )
(t (format t "~%Failure."))))) (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