AuK/Durchläufe durch Graphen SS12

Wiki-Quelltext dieser Seite.

<language>Scheme</language>
== Test: Tiefensuche ==

<code id="4f68b0ac368e7" hidden>(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)))))</code>

<code id="4f68afe40f6c1">
(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!!!

</code>

<run id="4f68afe40f72f">(tiefensuche '(1 2 3) '())</run>

== Test 1.1 Tiefensuche durch Baumstruktur ==

<code id="4f6f07043611d">
;(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)
</code>

<run id="4f6f0704361c9">
(tiefe '(1 (2 (4) (5)) (3 (6) (7))))
</run>

== Test 1.2 Breitensuche mit Baumstruktur ==

<code id="4f6f7d3ad381b">
(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)
</code>

<run id="4f6f7d3ad38f0">(breite '(1 (2 (4) (5)) (3 (6) (7))))</run>

== Test 2.1: Tiefensuche mit Adjazenzliste ==

<code id="4f6f7fc5b7345">
(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 src dst)
              (letrec 
                  ([dfs* (lambda (graph visited border dest)
               (cond 
                 [(null? border) #f]
                 [(eq? (car border) dest) (cons (car border) visited)]
                 [(memq (car border) visited)(dfs* graph visited (cdr border) dest)]
                 [else (dfs* graph
                   (cons (car border) visited)
                   (append (expand graph (car border)) (cdr border))
                   dest)]))])
                (reverse (dfs* graph '() (list src) dst)))))
</code>

<run id="4f6f7fc5b73f1">
(dfs graph2 1 7)
</run>

== Test 2.2 Breitensuche mit Adjazenzliste ==

== Test 3: Breitensuche ==

<code id="4f68d5a9c9378">

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 '()))))
</code>

<run id="4f68cd9f6c839">(breitensuche graph2 1 7)</run>