chickadee » aima » make-preferential-depth-first-world

Create a random-graph using depth-first search that nevertheless shows preference for connected nodes (á la Barabási-Albert).

The graph has no cycles.

n-nodes

The number of nodes in the graph (default: (default-n-nodes))

(define make-preferential-depth-first-world
  (case-lambda
    (() (make-preferential-depth-first-world (default-n-nodes)))
    ((n-nodes)
     (let* ((world (make-seed-world)) (start (random-start world)))
       (let iter ((node start)
                  (n-nodes (max 0 (- n-nodes (count-nodes world))))
                  (n-degrees (count-degrees world)))
         (if (zero? n-nodes)
           world
           (let ((location
                   (hash-table-ref/default world node (make-dirty-location))))
             (let ((n-neighbors (n-neighbors location)))
               (if (and (< n-neighbors 4)
                        (< (bsd-random-real) (/ n-neighbors n-degrees)))
                 (let* ((new-directions
                          (vector-fold
                            (lambda (direction directions neighbor)
                              (if (no-passage? neighbor)
                                (cons direction directions)
                                directions))
                            '()
                            (location-neighbors location)))
                        (new-direction
                          (list-ref
                            new-directions
                            (bsd-random (length new-directions)))))
                   (let ((new-node (make-node)))
                     (connect! world node new-node new-direction)
                     (iter new-node (- n-nodes 1) (+ n-degrees 2))))
                 (let* ((neighbors
                          (vector-fold
                            (lambda (direction neighbors neighbor)
                              (if (passage? neighbor)
                                (cons neighbor neighbors)
                                neighbors))
                            '()
                            (location-neighbors location)))
                        (neighbor
                          (list-ref
                            neighbors
                            (bsd-random (length neighbors)))))
                   (iter neighbor n-nodes n-degrees)))))))))))