Plaster

;; with cons (defun dijkstra (vertices weight-of &key (src '(0 . 0)) previous-as-ref) (destructuring-bind (rows cols) (array-dimensions vertices) (let* ((distances (make-array (array-dimensions vertices) :initial-element most-positive-fixnum)) (previous (make-array (array-dimensions vertices) :initial-element nil)) (queue (serapeum:make-heap :test (lambda (u v) (< (aref distances (car u) (cdr u)) (aref distances (car v) (cdr v)))) :size (+ (max rows cols) 16))) (in-queue (make-array (array-dimensions vertices) :adjustable nil :element-type 'bit :initial-element 0))) (labels ((enqueue (item) (setf (aref in-queue (car item) (cdr item)) 1) (serapeum:heap-insert queue item)) (dequeue () (let ((min (serapeum:heap-extract-maximum queue))) (setf (aref in-queue (car min) (cdr min)) 0) min)) (neighbor-direction (i j direction) (let ((pos (case direction (up (cons (1- i) j)) (down (cons (1+ i) j)) (left (cons i (1- j))) (right (cons i (1+ j)))))) (unless (or (< (car pos) 0) (>= (car pos) rows) (< (cdr pos) 0) (>= (cdr pos) cols)) pos))) (neighbors (vertex) (destructuring-bind (i . j) vertex (remove-if #'null (mapcar (lambda (direction) (neighbor-direction i j direction)) '(up down left right)))))) (setf (aref distances (car src) (cdr src)) 0) (enqueue src) (loop while (serapeum:heap-maximum queue) for u = (dequeue) for neighbors = (neighbors u) do (destructuring-bind (i . j) u (dolist (v neighbors) (destructuring-bind (other-i . other-j) v (let ((alt (+ (aref distances i j) (funcall weight-of (aref vertices other-i other-j))))) (when (< alt (aref distances other-i other-j)) (when (zerop (aref in-queue other-i other-j)) (enqueue v)) (setf (aref distances other-i other-j) alt (aref previous other-i other-j) u))))))) (when previous-as-ref (with-matrix-indices (row col) vertices (setf (aref previous row col) (aref vertices row col)))) (values distances previous))))) (defstruct point2 (x 0 :type fixnum) (y 0 :type fixnum)) ;; with struct (defun dijkstra2 (vertices weight-of &key (src (make-point2 :x 0 :y 0)) previous-as-ref) (destructuring-bind (rows cols) (array-dimensions vertices) (let* ((distances (make-array (array-dimensions vertices) :initial-element most-positive-fixnum)) (previous (make-array (array-dimensions vertices) :initial-element nil)) (queue (serapeum:make-heap :test (lambda (u v) (< (aref distances (point2-x u) (point2-y u)) (aref distances (point2-x v) (point2-y v)))) :size (+ (max rows cols) 16))) (in-queue (make-array (array-dimensions vertices) :adjustable nil :element-type 'bit :initial-element 0))) (labels ((enqueue (item) (setf (aref in-queue (point2-x item) (point2-y item)) 1) (serapeum:heap-insert queue item)) (dequeue () (let ((min (serapeum:heap-extract-maximum queue))) (setf (aref in-queue (point2-x min) (point2-y min)) 0) min)) (neighbor-direction (i j direction) (let ((pos (case direction (up (make-point2 :x (1- i) :y j)) (down (make-point2 :x (1+ i) :y j)) (left (make-point2 :x i :y (1- j))) (right (make-point2 :x i :y (1+ j)))))) (unless (or (< (point2-x pos) 0) (>= (point2-x pos) rows) (< (point2-y pos) 0) (>= (point2-y pos) cols)) pos))) (neighbors (vertex) (remove-if #'null (mapcar (lambda (direction) (neighbor-direction (point2-x vertex) (point2-y vertex) direction)) '(up down left right))))) (setf (aref distances (point2-x src) (point2-y src)) 0) (enqueue src) (loop while (serapeum:heap-maximum queue) for u = (dequeue) for neighbors = (neighbors u) do (dolist (v neighbors) (with-slots ((other-i x) (other-j y)) v (let ((alt (+ (aref distances (point2-x u) (point2-y u)) (funcall weight-of (aref vertices other-i other-j))))) (when (< alt (aref distances other-i other-j)) (when (zerop (aref in-queue other-i other-j)) (enqueue v)) (setf (aref distances other-i other-j) alt (aref previous other-i other-j) u)))))) (when previous-as-ref (with-matrix-indices (row col) vertices (setf (aref previous row col) (aref vertices row col)))) (values distances previous)))))