Jump to content
  • Advertisement
Sign in to follow this  

graph search in scheme

This topic is 3620 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

Recommended Posts

I have already posted this under IDA* algorithm in scheme but I figured since I havent had a response in a couple of days I'll repost and hopefully someone will get back to me. Here is my problem: I am trying to design a graph search algorithm were the algorithm is stated as so

function GRAPH-SEARCH(problem, fring) returns a solution, or failure

closed <-- an empty set
fringe <-- Insert(make-node (initial-state[problem], fringe)

loop do
  if EMPTY? (fringe) then return failure
  node <-- REMOVE_FIRST (fringe)
  if GOAL-TEST[problem](STATE[node]) then return solution (node)
  if STATE[node] is not closed then
      add STATE[node] to closed
      fringe <-- Insert-all(EXPAND(node, problem, fringe)

I understand the closed list stores every expanded node and the fringe/open list is the unexpanded nodes. The algorithm basically checks the current node and if it matches a node on the closed list it discards it instead of being expanded. So with that said I have no clue how to correlate that understanding to scheme code. I know the hash table will be used to store the closed list and the open list will be a priority queue (like a heap or something) but other than that I am very lost in how this will be implemented. Here is my priority queue:

;; priority queue stuff
(define (make-priority-queue maxsize)
  ;; algorithm based on 1 origen indexing
  (define (refl i) (vector-ref heap(- i 1)))
  (define (set!l i x) (vector-set! heap(- i 1) x))
  ;; heap representation
  (define (parent i) (floor (/ i 2)))
  (define (left i) (* 2 i))
  (define (right i) (+ (* 2 i) 1))
  (define (exchange! i j)
    (let ((x (refl i))) (set!l i (refl j)) (set!l j x)))
  ;; extract min key - O(log(n))
  (define (extract-min)
    (if (< heapsize 1) "priority queue underflow error"
        (let ((min (refl 1)))
              (set!l 1 (refl heapsize))
              (set!l heapsize 0) ; make the array past heapsize look pretty
              (set! heapsize(- heapsize 1))
              (heapify! 1)
  (define (heapify! i)
    (define(minof j i)
      (if (and (<= j heapsize) (< (refl j) (refl i))) j i))
    (let ((min (minof (right i) (minof (left i) i))))
      (if (not (= min i)) (begin (exchange! i min) (heapify! min)))))
  (define (insert key)
    (cond ((>= heapsize maxsize) "priority queue overflow error")
          (else (set! heapsize (+ heapsize 1))
                (set!l heapsize +inf.0)
                (decrease-key heapsize key))))
  (define (decrease-key i key)
    (define (propagate-up i)
      (cond ((and (> i 1) (> (refl (parent i)) (refl i)))
            (exchange! i (parent i)) (propagate-up (parent i)))
            (else 'done)))
    (cond ((> key (refl i)) "error")
          (else (set!l i key) (propagate-up i))))
  ;;; data
  (define heapsize 0)
  (define heap(make-vector maxsize))
  (lambda (m)
    (case m
      ((insert) (lambda (x) (insert x) heap))
      ((extract-min) (extract-min)))))

(define(insert q x) ((q 'insert) x))
(define(extract-min q) (q 'extract-min))

Here is the hash-table that Anyonomous P developed:

;; hashtable stuff
(define (remove-if p? l)
  (define (helper res l)
    (cond ((null? l)
          ((p? (car l))
           (helper res (cdr l)))
           (helper (cons car l) res) (cdr l))))
  (helper (list) l))

(define (make-bucket)

(define (bucket-remove b key)
  (remove-if (lambda (x) (= key (car x))) b))

(define (bucket-add b key val)
  (cons (cons key val) (bucket-remove b key)))

(define (bucket-search b key)
  (cond ((null? b)
        ((= key (car (car b)))
         (car b))
         (bucket-search (cdr b) key))))

(define (make-chains n)
  (let ((v (make-vector n)))
    (define (fill-vector idx)
      (cond ((= idx (vector-length v))
             (cons 0 v))
             (vector-set! v idx (make-bucket))
             (fill-vector (+ 1 idx)))))
    (fill-vector 0)))

(define (insert-chains! c f key val)
  (let* ((num-elts (car c))
         (v (cdr c))
         (size (vector-length v))
         (idx (hash-idx f key size))
         (bucket (vector-ref v idx)))
    (vector-set! v idx (bucket-add bucket key val))
    (set-car! c (+ num-elts 1))))

(define (store-k-v chains f k-v)
  (insert-chains! chains f (car k-v) (cdr k-v)))

(define (hash-idx f key size)
  (remainder (f key) size))

(define (lookup-chains c f key)
  (let* ((v (cdr c))
         (size (vector-length v))
         (idx (hash-idx f key size)))
    (bucket-search (vector-ref v idx) key)))

(define (chains-for-each c f)
  (let* ((v (cdr c))
         (size (vector-length v)))
    (define (v-for-each idx)
      (cond ((= idx size)
             (for-each f (vector-ref v idx))
             (v-for-each (+ idx 1)))))
    (v-for-each 0)))

(define (chains-fill c)
  (car c))

(define (chains-size c)
  (vector-length (cdr c)))

(define (make-hash f)
  (cons f (make-chains 4)))

(define (hash-store! h key val)
  (let* ((f (car h))
         (chains (cdr h))
         (num-elts (chains-fill chains))
         (size (chains-size chains)))
    (cond ((< size (* num-elts 2))
           (let ((new-chains (make-chains (* 2 size))))
             (chains-for-each chains
                              (lambda (x) (store-k-v new-chains f x)))
             (set-cdr! h new-chains)
             (hash-store! h key val)))
           (insert-chains! chains f key val)))))

(define (hash-lookup h key)
  (lookup-chains (cdr h) (car h) key))

That is where I stand and I am struggling to figure out how to develop the graph search algorithm from here. I have a limited understanding of scheme and this seems like this might be a little over my head but I dont have much of choice in which language I can use. So if anyone has any suggestions on how to do it that would be great.

Share this post

Link to post
Share on other sites
Sign in to follow this  

  • Advertisement

Important Information

By using GameDev.net, you agree to our community Guidelines, Terms of Use, and Privacy Policy.

We are the game development community.

Whether you are an indie, hobbyist, AAA developer, or just trying to learn, GameDev.net is the place for you to learn, share, and connect with the games industry. Learn more About Us or sign up!

Sign me up!