toogreat4u 127 Report post Posted September 18, 2008 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. 0 Share this post Link to post Share on other sites