#lang racket (require htdp/testing) ;; Use-it-or-lose-it! ;; ;; uniq ;; inputs: a list L ;; output: a list of all (top-level) elements in L, ;; but with each appearing only one time ;; ;; N calls to member == O(N**2) ;; (define (uniq L) (if (null? L) ;; if L is empty, so it the output '() (let* ((it (first L)) ;; our usual "it" (loseit (uniq (rest L))) ;; answer w/o "it" (useit (cons it loseit))) ;; answer w/ "it" (if (member it loseit) ;; the check or combination... loseit ;; the appropriate results useit)))) ;; Graphs! ;; here is the unicyclic graph (define Gu '( (C1 N) (C1 Y) (N Y) (C2 N) (C2 Y) (Y E) (E U) (U I) (I L) (L E))) ;; here is a small graph with a cycle (define Graph1 '( (a b) (b c) (c d) (d e) (e c) )) ;; reach? ;; inputs: a starting node a ;; an ending node b ;; a graph G ;; output: #t if b is reachable from a in G ;; #f otherwise ;; (a is always reachable from a, even w/o any edges) ;; ;; NOT EFFICIENT (it will be by the end of the term, however...) ;; (define (reach? a b G) (cond ( (equal? a b) #t ) ;; any node is reachable from itself ( (null? G) #f ) ;; nothing else is reachable in an empty G ( else (let* ( (EDGE (first G)) ; EDGE is "it" from x to y (R (rest G)) ; R is the rest of the edges! (loseit (reach? a b R)) ; can we get there w/o EDGE? (x (first EDGE)) ; c is the start of EDGE (y (second EDGE)) ; d is the end of EDGE (useit (and (reach? a x R) ; if we use EDGE we must (reach? y b R))) ) ; go a->x->y->b ; we need some kind of sound effect to accompany this next line! (or useit loseit))))) ;; tests (check-expect (reach? 'a 'a Graph1) #t) (check-expect (reach? 'z 'z Graph1) #t) (check-expect (reach? 'a 'b Graph1) #t) (check-expect (reach? 'a 'e Graph1) #t) (check-expect (reach? 'e 'd Graph1) #t) (check-expect (reach? 'e 'a Graph1) #f) (check-expect (reach? 'z 'a Graph1) #f) (check-expect (reach? 'C1 'L Gu) #t) (check-expect (reach? 'C1 'C2 Gu) #f) ;; sublists! ;; inputs: a list L of any elements ;; output: a list of sublists of L ;; ;; IS EFFICIENT (well, as efficient as possible: 2**N) ;; (define (sublists L) (if (null? L) ;; if L is empty, then there is one sublist '( () ) ;; and this is the LIST of that one sublist! (let* ( (it (first L)) ;; usually "it" is the first of L (R (rest L)) ;; R is shorter! (loseit (sublists R)) ;; all of the sublists w/o "it" (useit (map ;; how to get all of the sublists (lambda (S) (cons it S)) ;; w/ "it"? loseit)) ;; we cons it on each of the sublists! ) (append loseit useit)))) ;; need both sets in this case! ;; here, the tests are order-dependent... (check-expect (sublists '()) '(())) (check-expect (sublists '(1)) '(() (1))) (check-expect (sublists '(1 2)) '(() (2) (1) (1 2))) ;; here is a small graph with a cycle (define Gs '((a b) (b c) (c d) (d e) (e c)) ) ;; a larger graph used in the HW (define Gt '((e b) (a b) (e a) (a c) (a d) (a e) (b c) (b d) (d e) (b e) (c d) (c e)) ) ;; a weightier graph! (define Gtw '((e b 100) (a b 25) (e a 42) (a c 7) (a d 13) (a e 15) (b c 10) (b d 5) (d e 2) (b e 100) (c d 1) (c e 7)) ) ;; tests to try... ; (nodes Gt) ; (nodes Gs) ; (kids 'C1 Gu) ; (kids 'I Gu) ; (leaf? 'E Gu) ; (leaf? 'Q Gu) ; (gkids 'C1 Gu) ; (gkids 'I Gu) ; (reach? 'C1 'L Gu) ; (reach? 'C1 'C2 Gu) ; (subls '()) ; (subls '(1)) ; (subls '(1 2)) ;; more examples from class... (define (smush L) (foldr append '() L)) (define (nodes G) (uniq (smush G))) (check-expect (nodes Gu) '(C1 N C2 Y U I L E)) (define (kids n G) (map second (filter (lambda (e) (equal? (first e) n)) G))) (check-expect (kids 'C1 Gu) '(N Y)) (check-expect (kids 'I Gu) '(L)) (define (leaf? n G) (null? (kids n G))) (check-expect (leaf? 'I Gu) #f) (check-expect (leaf? 'absent Gu) #t) (define (gkids n G) (let* ((Kds (kids n G)) (LoGK (map (lambda (x) (kids x G)) Kds))) (uniq (smush LoGK)))) (check-expect (gkids 'C1 Gu)'(Y E)) (check-expect (gkids 'I Gu) '(E)) ;; how did we do? (generate-report)