AuK/Durchläufe durch Graphen SS12
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Java</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))))
</code>
<run id="4f6f7d3ad38f0">(breite '(1 (2 (4) (5)) (3 (6) (7))))</run>
== Test 2.1: Tiefensuche mit Adjazenzliste ==
<code id="4f6f7fc5b7345">
(define graph
'((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)))
(define (expanding graph node)
(let ((c (assoc 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))
((member (car border) visited)(dfs* graph visited (cdr border) dest))
(else (dfs* graph
(cons (car border) visited)
(append (expanding 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 ==
<code id="4f72f3f017a18">
(define bft (lambda (graph src dst)
(letrec
([bft* (lambda (graph visited border dest)
(cond
[(null? border) #f]
[(eq? (car border) dest) (cons (car border) visited)]
[(memq (car border) visited)(bft* graph visited (cdr border) dest)]
[else (bft* graph
(cons (car border) visited)
(append (cdr border) (expand graph (car border)))
dest)]))])
(reverse (bft* graph '() (list src) dst)))))
</code>
<run id="4f72f3f017adb">(bft graph2 1 7)</run>
== Test 2.3: Tiefensuche mit Java (direkte Eingabe aller Kanten) ==
<code id="4f8d79526e612">System.out.println("Hello World!");</code>
== 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?)
;;anregung: in übung/vorlesung beliebigen graphen (orange) als liste übersetzen lassen und bfs/dfs testen
;;;;;;;; 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>