Durchläufe durch Graphen SS12

(import debugging) (define amb-fail '*) (define initialize-amb-fail (lambda () (set! amb-fail (lambda () (error "amb" "It fails"))))) 
(initialize-amb-fail) (define-syntax amb (syntax-rules () ((amb alt ...) (let ((+prev-amb-fail amb-fail)) (call/cc (lambda (+sk) (call/cc 
(lambda (+fk) (set! amb-fail (lambda () (set! amb-fail +prev-amb-fail) (+fk 'fail))) (+sk alt))) ... (+prev-amb-fail))))))) (define-syntax 
bag-of (syntax-rules () ((bag-of e) (let ((+prev-amb-fail amb-fail) (+results '())) (if (call/cc (lambda (+k) (set! amb-fail (lambda () (+k 
#f))) (let ((+v e)) (set! +results (cons +v +results)) (+k #t)))) (amb-fail)) (set! amb-fail +prev-amb-fail) (reverse! +results))))) (define 
choice (lambda (ls) (eval (cons 'amb (map (lambda (x) (list 'quote x)) ls))))) (define multichoice (lambda (ls n) (if (= n 0) '() (let ((item 
(choice ls))) (cons item (multichoice (delete item ls) (- n 1))))))) (define delete (lambda (item ls) (cond ((null? ls) '()) ((eqv? (car ls) 
item) (cdr ls)) (else (cons (car ls) (delete item (cdr ls))))))) (define randomchoice (lambda (n) (letrec ((enumerate (lambda (i) (if (= i 0) 
'() (cons i (enumerate (- i 1))))))) (let ((numberlist (enumerate n))) (choice numberlist)))))

(define tiefensuche (lambda (knoten besucht)
              (cond
                [(null? knoten) besucht]
                [else
                 (display (tiefensuche (cdr knoten) (cons (car knoten) besucht)))
		 (newline)
                 (tiefensuche (cdr knoten) besucht)])))

;einführungsbeispiel zur arbeitsweise von dfs
;später andere dfs-impl. zu graph1!!!

(tiefensuche '(1 2 3) '())

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Vordefinitionen ;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;; 1: QUEUE ;;;;;;;;;;;;;;;;;

(define create-queue '())

(define enqueue (lambda (queue element)
                  (append queue (list element)))) ;;auch rappend genannt

(define front car)
(define dequeue cdr)

;;;;;;;; 2: GRAFEN ;;;;;;;;;;;;;;;;

(define graph1
  '((1 2 4)
    (2 1 4)
    (3 3 5)
    (4 5)
    (5 3)))

(define graph2
  '((1 2 3)
    (2 1 4 5)
    (3 1 6 7)
    (4 2)
    (5 2)
    (6 3)
    (7 3)))

;;nur 1 graphen definieren, queue-impl. ggf verbergen (evtl. selber schreiben lassen?)

;;;;;;;; 3: FKT ;;;;;;;;;;;;;;;;;;;
(define (strip-duplicates ls)
  (let loop ((rest ls)
             (so-far '()))
    (if (null? rest)
        so-far
        (loop (cdr rest)
              (let ((first (car rest)))
                (if (member first (cdr rest))
                    so-far
                    (cons first so-far)))))))


(define breitensuche (lambda (graph start ziel)
                       (letrec ([bfs (lambda (end queue graph besucht)
                                       (write 'Layer: )
                                       (display queue)
                                       (newline)
                                       (cond
                                         [(equal? end (front (front queue))) (strip-duplicates (append besucht (list end)))]
                                         ;[(equal? end (front (front queue))) (remove-duplicates (append besucht (list end)))]
                                         ;oberes für vollständigen durchlauf und visited-liste, unübersichtliche ausgabe
                                         ;unteres für leichte übersicht durchlaufener kanten
                                         [(list? (assoc end queue)) (write 'Traversed.)]
                                         [else
                                          (bfs end 
                                               (append (dequeue queue)
                                                       (letrec ([new-paths (lambda (path node net)
                                                           (map (lambda (n) (cons n path)) (cdr (assoc node net))))])
                                                       (new-paths (front queue) (front (front queue)) graph)))
                                               graph
                                               (append besucht (list (front (front queue)))))]))])
                          (bfs ziel (list (list start)) graph '()))))

(breitensuche graph2 1 7)

Durchläufe durch Graphen SS12

Test: Tiefensuche

Test 2: Breitensuche

Suche