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) '())

;(define tree-1
;'(1 (2 (4) (5)) (3 (6) (7))))
;scheme hasst mich, tree-1 lässt sich nicht definieren, allerdings explizit als parameter eingeben :\

(define node? (lambda (tree)
                (and 
                 (list? tree)
                 (= (length tree) 3))))

(define leaf? (lambda (tree)
                (and 
                 (list? tree)
                 (= (length tree) 1))))


(define tiefe (lambda (tree)
                (cond
                  [(leaf? tree) (list (car tree))]
                  [else 
                   (let( [element (car tree)]
                         [left (cadr tree)]
                         [right (caddr tree)])
                     (cons element
                           (append (tiefe left)
                                   (tiefe right))))])))
;(trace 'tiefe)

(tiefe '(1 (2 (4) (5)) (3 (6) (7))))

(define node? (lambda (tree)
                (and 
                 (list? tree)
                 (= (length tree) 3))))

(define leaf? (lambda (tree)
                (and 
                 (list? tree)
                 (= (length tree) 1))))


(define breite (lambda (tree)
                (cond
                  [(leaf? tree) (list (car tree))]
                  [else 
                   (let( [element (car tree)]
                         [left (cadr tree)]
                         [right (caddr tree)])
                     (append
                           (append (breite left)
                                   (breite right))
                           (list element)))])))
;(trace 'breite)

(breite '(1 (2 (4) (5)) (3 (6) (7))))

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

(define (expand graph node)
  (let ((c (assq node graph)))
    (if c (cdr c) '())))

(define dfs* (lambda(graph visited border path dest)
               (cond 
                 [(null? border) #f]
                 [(eq? (car border) dest) (cons (car border) path)]
                 [(memq (car border) visited)(dfs* graph visited (cdr border) path dest)]
                 [else (dfs* graph
                   (cons (car border) visited)
                   (append (expand graph (car border)) (cdr border))
                   (cons (car border) path)
                   dest)])))

(define (dfs graph src dst)
  (reverse (dfs* graph '() (list src) '() dst)))

(dfs graph2 1 7)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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

Inhaltsverzeichnis

Test: Tiefensuche

Test 1.1 Tiefensuche durch Baumstruktur

Test 1.2 Breitensuche mit Baumstruktur

Test 2.1: Tiefensuche mit Adjazenzliste

Test 2.2 Breitensuche mit Adjazenzliste

Test 3: Breitensuche

Suche