main-a-star.scm 1.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. (import
  2. (except (rnrs base)
  3. let-values
  4. map
  5. error
  6. vector-map)
  7. (only (guile)
  8. lambda* λ
  9. simple-format
  10. current-output-port)
  11. ;; standard library
  12. (ice-9 pretty-print)
  13. ;; custom modules
  14. (fileio)
  15. (pipeline)
  16. (debug)
  17. (list-helpers)
  18. ;; hash tables
  19. (srfi srfi-69)
  20. ;; let-values
  21. (srfi srfi-11)
  22. ;; graph algos
  23. (a-star)
  24. (dijkstra)
  25. ;; distances
  26. (prefix (distances) distance:)
  27. (graph-model)
  28. (graph-reader)
  29. (graph-utils)
  30. )
  31. ;; (define input-filename "example-graphs/graph-01.txt")
  32. (define input-filename "example-graphs/graph-01.txt")
  33. (define-values (nodes distances-table nodes-table)
  34. (read-graph input-filename))
  35. (simple-format #t "node names: ~s\n" (hash-table-keys nodes-table))
  36. (define manhattan-node-distance
  37. (λ (source-node target-node)
  38. (distance:manhattan (node-y source-node)
  39. (node-y target-node)
  40. (node-x source-node)
  41. (node-x target-node))))
  42. (define get-node-distance
  43. (λ (source-node-name target-node-name)
  44. (hash-table-ref distances-table
  45. (cons source-node-name
  46. target-node-name))))
  47. (let ([start-node (hash-table-ref nodes-table "A")]
  48. [target-node (hash-table-ref nodes-table "O")])
  49. (pretty-print
  50. (routes->path (A* start-node
  51. target-node
  52. (hash-table-keys nodes-table)
  53. nodes-table
  54. get-node-distance
  55. manhattan-node-distance
  56. <)
  57. (node-name target-node)
  58. #:equal-test string=?)))