Sign in to follow this  
toogreat4u

graph search in scheme

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)
              min)))
  (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)
           l)
          ((p? (car l))
           (helper res (cdr l)))
          (#t
           (helper (cons car l) res) (cdr l))))
  (helper (list) l))

(define (make-bucket)
  (list))

(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)
         #f)
        ((= key (car (car b)))
         (car b))
        (#t
         (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))
            (#t
             (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)
             'end)
            (#t
             (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)))
          (#t
           (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

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

Sign in to follow this