Advertisement

graph search in scheme

Started by September 18, 2008 06:56 PM
-1 comments, last by toogreat4u 16 years, 2 months ago
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.

This topic is closed to new replies.

Advertisement