From bbd1bd1392d482287936fde54cb2cea808eb2bae Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 2 Oct 2018 17:12:44 -0400 Subject: Move pathfinding module to math directory. --- Makefile.am | 2 +- chickadee/math/path-finding.scm | 77 +++++++++++++++++++++++++++++++++++++++++ chickadee/path-finding.scm | 77 ----------------------------------------- 3 files changed, 78 insertions(+), 78 deletions(-) create mode 100644 chickadee/math/path-finding.scm delete mode 100644 chickadee/path-finding.scm diff --git a/Makefile.am b/Makefile.am index 1ae2d24..2b27ba2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -53,6 +53,7 @@ SOURCES = \ chickadee/math/rect.scm \ chickadee/math/grid.scm \ chickadee/math/easings.scm \ + chickadee/math/path-finding.scm \ chickadee/render/color.scm \ chickadee/render/gl.scm \ chickadee/render/gpu.scm \ @@ -73,7 +74,6 @@ SOURCES = \ chickadee/scripting/script.scm \ chickadee/scripting/channel.scm \ chickadee/scripting.scm \ - chickadee/path-finding.scm \ chickadee.scm \ chickadee/sdl.scm diff --git a/chickadee/math/path-finding.scm b/chickadee/math/path-finding.scm new file mode 100644 index 0000000..d89c2fc --- /dev/null +++ b/chickadee/math/path-finding.scm @@ -0,0 +1,77 @@ +;;; Copyright © 2017 David Thompson +;;; +;;; Chickadee is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Chickadee is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; . + +;;; Commentary: +;; +;; Generalized A* pathfinding algorithm. +;; +;;; Code + +(define-module (chickadee math path-finding) + #:use-module (chickadee heap) + #:use-module (srfi srfi-9) + #:export (make-path-finder + path-finder? + a*)) + +(define-record-type + (%make-path-finder frontier came-from cost-so-far) + path-finder? + (frontier path-finder-frontier) + (came-from path-finder-came-from) + (cost-so-far path-finder-cost-so-far)) + +(define (make-path-finder) + "Create a new path finder object." + (%make-path-finder (make-heap (lambda (a b) (< (cdr a) (cdr b)))) + (make-hash-table) + (make-hash-table))) + +(define (a* path-finder start goal neighbors cost distance) + "Return a list of nodes forming a path from START to GOAL using +PATH-FINDER. NEIGHBORS is a procedure that accepts a node and returns +a list of nodes that neighbor it. COST is a procedure that accepts +two neighboring nodes and returns the cost of moving from the first to +the second as a number. DISTANCE is a procedure that accepts two +nodes and returns an approximate distance between them." + (let ((frontier (path-finder-frontier path-finder)) + (came-from (path-finder-came-from path-finder)) + (cost-so-far (path-finder-cost-so-far path-finder))) + (heap-insert! frontier (cons start 0)) + (hashq-set! came-from start #f) + (hashq-set! cost-so-far start 0) + (let loop () + (unless (heap-empty? frontier) + (let ((current (car (heap-min frontier)))) + (heap-remove! frontier) + (unless (eq? current goal) + (for-each (lambda (next) + (let ((new-cost (+ (hashq-ref cost-so-far current) + (cost current next)))) + (when (or (not (hashq-ref cost-so-far next)) + (< new-cost (hashq-ref cost-so-far next))) + (hashq-set! cost-so-far next new-cost) + (let ((priority (+ new-cost (distance goal next)))) + (heap-insert! frontier (cons next priority))) + (hashq-set! came-from next current)))) + (neighbors current)) + (loop))))) + ;; Walk backwards to build the path from start to goal as a list. + (let loop ((node goal) + (path '())) + (if (eq? node start) + (cons start path) + (loop (hashq-ref came-from node) (cons node path)))))) diff --git a/chickadee/path-finding.scm b/chickadee/path-finding.scm deleted file mode 100644 index 9af01f8..0000000 --- a/chickadee/path-finding.scm +++ /dev/null @@ -1,77 +0,0 @@ -;;; Copyright © 2017 David Thompson -;;; -;;; Chickadee is free software: you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published -;;; by the Free Software Foundation, either version 3 of the License, -;;; or (at your option) any later version. -;;; -;;; Chickadee is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see -;;; . - -;;; Commentary: -;; -;; Generalized A* pathfinding algorithm. -;; -;;; Code - -(define-module (chickadee path-finding) - #:use-module (chickadee heap) - #:use-module (srfi srfi-9) - #:export (make-path-finder - path-finder? - a*)) - -(define-record-type - (%make-path-finder frontier came-from cost-so-far) - path-finder? - (frontier path-finder-frontier) - (came-from path-finder-came-from) - (cost-so-far path-finder-cost-so-far)) - -(define (make-path-finder) - "Create a new path finder object." - (%make-path-finder (make-heap (lambda (a b) (< (cdr a) (cdr b)))) - (make-hash-table) - (make-hash-table))) - -(define (a* path-finder start goal neighbors cost heuristic) - "Return a list of nodes forming a path from START to GOAL using -PATH-FINDER. NEIGHBORS is a procedure that accepts a node and returns -a list of nodes that neighbor it. COST is a procedure that accepts -two neighboring nodes and the cost of moving from the first to the -second as a number. HEURISTIC is a procedure that accepts two nodes -and returns an approximate distance between them." - (let ((frontier (path-finder-frontier path-finder)) - (came-from (path-finder-came-from path-finder)) - (cost-so-far (path-finder-cost-so-far path-finder))) - (heap-insert! frontier (cons start 0)) - (hashq-set! came-from start #f) - (hashq-set! cost-so-far start 0) - (let loop () - (unless (heap-empty? frontier) - (let ((current (car (heap-min frontier)))) - (heap-remove! frontier) - (unless (eq? current goal) - (for-each (lambda (next) - (let ((new-cost (+ (hashq-ref cost-so-far current) - (cost current next)))) - (when (or (not (hashq-ref cost-so-far next)) - (< new-cost (hashq-ref cost-so-far next))) - (hashq-set! cost-so-far next new-cost) - (let ((priority (+ new-cost (heuristic goal next)))) - (heap-insert! frontier (cons next priority))) - (hashq-set! came-from next current)))) - (neighbors current)) - (loop))))) - ;; Walk backwards to build the path from start to goal as a list. - (let loop ((node goal) - (path '())) - (if (eq? node start) - (cons start path) - (loop (hashq-ref came-from node) (cons node path)))))) -- cgit v1.2.3