# 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.

## 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
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))

(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.

1. 1
2. 2
3. 3
4. 4
frob
15
5. 5

• 16
• 12
• 20
• 12
• 13
• ### Forum Statistics

• Total Topics
632155
• Total Posts
3004474

×