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

4
test/test-csys.lisp
View file

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