cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

csys/space:neighbors: improvements

Browse source
This commit is contained in:
Helmut Merz 2026-09-27 18:23:23 +02:00
parent 7c3a719b31
commit 111cf87163
2 changed files with 20 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
csys/space.lisp
View file

@ -31,10 +31,9 @@
nil) nil)
(defun neighbors (spc loc &key (dist 2)) (defun neighbors (spc loc &key (dist 2))
(let* ((to (floor (sqrt dist))) (let* ((range (floor (sqrt dist)))
(from (- to))
nbrs) nbrs)
(util:with-iterator (loc-iterator from to) (util:with-iterator (loc-iterator range)
(lambda (rloc) (lambda (rloc)
(let* ((cloc (loc-add rloc loc)) (let* ((cloc (loc-add rloc loc))
(cell (fetch spc cloc))) (cell (fetch spc cloc)))
@ -45,21 +44,25 @@
(defun distance-sq (spc loc1 loc2)) (defun distance-sq (spc loc1 loc2))
(defun loc-iterator (from to &key (dim 2)) (defun loc-iterator (range &key (dim 2))
(labels ( (let* ((from (- range))
(inc (cur idx) (zero (make-array dim :initial-element 0))
(when (< idx dim) (cur (make-array dim :initial-element from)))
(let ((new (1+ (aref cur idx)))) (labels (
(setf (aref cur idx) new) (inc (cur &optional (idx 0))
(when (> new to) (when (< idx dim)
(setf (aref cur idx) from) (let ((new (1+ (aref cur idx))))
(setf cur (inc cur (1+ idx)))) (setf (aref cur idx) new)
cur)))) (when (> new range)
(let ((cur (make-array dim :initial-element from))) (setf (aref cur idx) from)
(setf cur (inc cur (1+ idx))))
cur))))
(lambda () (lambda ()
(when (equalp cur zero)
(setf cur (inc cur)))
(when cur (when cur
(prog1 (make-array dim :initial-contents cur) (prog1 (make-array dim :initial-contents cur)
(setf cur (inc cur 0)))))))) (setf cur (inc cur))))))))
(defun loc-add (l1 l2) (defun loc-add (l1 l2)
(let* ((dim (car (array-dimensions l1))) (let* ((dim (car (array-dimensions l1)))

4
test/test-csys.lisp
View file

@ -88,10 +88,10 @@
(== (space:fetch spc #(1 2)) 46) (== (space:fetch spc #(1 2)) 46)
(space:del spc #(1 1)) (space:del spc #(1 1))
(== (space:fetch spc #(1 1)) nil) (== (space:fetch spc #(1 1)) nil)
(util:with-iterator (space:loc-iterator -1 1) (util:with-iterator (space:loc-iterator 1)
(lambda (loc) (lambda (loc)
(push loc locs))) (push loc locs)))
(== (length locs) 9) (== (length locs) 8)
(== (car locs) #(1 1)) (== (car locs) #(1 1))
(== (car (last locs)) #(-1 -1)) (== (car (last locs)) #(-1 -1))
(== (car (space:neighbors spc #(1 1))) 46) (== (car (space:neighbors spc #(1 1))) 46)