;; Test code for CSSE 304 Assignment 6 (define (test-curry2) (let ([correct '( 6 (17 . 29) )] [answers (list (((curry2 -) 8) 2) (let([conscurry (curry2 cons)]) ((conscurry 17) 29)) )]) (display-results correct answers equal?))) (define (test-curried-compose) (let ([correct '(arg 1)] [answers (list (((curried-compose car) list) 'arg) (((curried-compose car) car) '((1 7) (2 9))) )]) (display-results correct answers equal?))) (define (test-compose) (let ([correct '(1 2)] [answers (list ((compose car car) '((1 7) (2 9))) ((compose car car cdr) '((1 7) (2 9))) )]) (display-results correct answers equal?))) (define (test-make-list-c) (let ([correct '( (7 7 7 7) (() () () () ()) () )] [answers (list ((make-list-c 4) 7) ((make-list-c 5) '()) ((make-list-c 0) 10) )]) (display-results correct answers equal?))) (define (test-let->application) (let ([correct '( ((lambda (a b) (let ((c b)) (+ a b c))) 4 5) ((lambda () (+ 2 3))) ((lambda (a b c) (let ((d 3)) (+ a b c d))) 2 1 5) )] [answers (list (let->application (quote (let ((a 4) (b 5)) (let ((c b)) (+ a b c))))) (let->application '(let () (+ 2 3))) (let->application '(let ([a 2] [b 1] [c 5]) (let ([d 3]) (+ a b c d)))) )]) (display-results correct answers equal?))) (define (test-let*->let ) (let ([correct '( (let ((x 0)) x) (let ((x 50)) (let ((y (+ x 50))) (let ((z (+ y 50))) z))) (let ((x (let ((y 1)) y))) (let ((z x)) x)) )] [answers (list (let*->let (quote (let* ((x 0)) x))) (let*->let (quote (let* ((x 50) (y (+ x 50)) (z (+ y 50))) z))) (let*->let (quote (let* ((x (let ((y 1)) y)) (z x)) x))) )]) (display-results correct answers equal?))) (define (test-filter-in) (let ([correct '( (2 3 5) (() () ()) (() (1 2)) ((1 2) (3 . 4)) () )] [answers (list (filter-in positive? '(-1 2 0 3 -6 5)) (filter-in null? '(() (1 2) (3 4) () ())) (filter-in list? '(() (1 2) (3 . 4) #2(4 5))) (filter-in pair? '(() (1 2) (3 . 4) #2(4 5))) (filter-in positive? '()) )]) (display-results correct answers equal?))) (define (test-filter-out) (let ([correct '( (-1 0 -6 0) ((1 2) (3 4)) ((3 . 4) #(4 5)) (() #(4 5)) () )] [answers (list (filter-out positive? '(-1 2 0 3 -6 5 0)) (filter-out null? '(() (1 2) (3 4) () ())) (filter-out list? '(() (1 2) (3 . 4) #2(4 5))) (filter-out pair? '(() (1 2) (3 . 4) #2(4 5))) (filter-out positive? '()) )]) (display-results correct answers equal?))) (define (test-sort-list-of-symbols) (let ([correct '( (ab b b c d f g m r) (b) () )] [answers (list (sort-list-of-symbols '(b c d g ab f b r m)) (sort-list-of-symbols '(b)) (sort-list-of-symbols '()) )]) (display-results correct answers equal?))) ;----------------------------------------------- (define display-results (lambda (correct results test-procedure?) (display ": ") (pretty-print (if (andmap test-procedure? correct results) 'All-correct `(correct: ,correct yours: ,results))))) (define sequal?-grading (lambda (l1 l2) (cond ((null? l1) (null? l2)) ((null? l2) (null? l1)) ((or (not (set?-grading l1)) (not (set?-grading l2))) #f) ((member (car l1) l2) (sequal?-grading (cdr l1) (rember-grading (car l1) l2))) (else #f)))) (define set?-grading (lambda (s) (cond [(null? s) #t] [(not (list? s)) #f] [(member (car s) (cdr s)) #f] [else (set?-grading (cdr s))]))) (define rember-grading (lambda (a ls) (cond ((null? ls) ls) ((equal? a (car ls)) (cdr ls)) (else (cons (car ls) (rember-grading a (cdr ls))))))) (define set-equals? sequal?-grading) (define find-edges ; e know that this node is in the graph before we do the call (lambda (graph node) (let loop ([graph graph]) (if (eq? (caar graph) node) (cadar graph) (loop (cdr graph)))))) ;; Problem 8 graph? (define set? ;; Is this list a set? If not, it is not a graph. (lambda (list) (if (null? list) ;; it's an empty set. #t (if (member (car list) (cdr list)) #f (set? (cdr list)))))) (define graph? (lambda (obj) (and (list? obj) (let ([syms (map car obj)]) (and (set? syms) (andmap symbol? syms) (andmap (lambda (x) (andmap (lambda (y) (member y (remove (car x) syms))) (cadr x))) obj)))))) (define graph-equal? (lambda (a b) (and (graph? a) (graph? b) (let ([a-nodes (map car a)] [b-nodes (map car b)]) (and (set-equals? a-nodes b-nodes) ; Now See if the edges from each node are equivalent in the two graphs. (let loop ([a-nodes a-nodes]) (if (null? a-nodes) #t (let ([a-edges (find-edges a (car a-nodes))] [b-edges (find-edges b (car a-nodes))]) (and (set-equals? a-edges b-edges) (loop (cdr a-nodes))))))))))) (define (test-graph-equal) (list (graph-equal? '((a (b)) (b (a))) '((b (a)) (a (b)))) (graph-equal? '((a (b c d)) (b (a c d)) (c (a b d)) (d (a b c))) '((b (a c d)) (c (a b d)) (a (b d c)) (d (b a c)))) (graph-equal? '((a ())) '((a ()))) (graph-equal? '((a (b c)) (b (a c)) (c (a b))) '((a (b c)) (b (a c)) (c (a b)))) (graph-equal? '() '()) )) (define g test-graph-equal) ;You can run the tests individually, or run them all ;#by loading this file (and your solution) and typing (r) (define (run-all) (display 'curry2) (test-curry2) (display 'curried-compose) (test-curried-compose) (display 'compose) (test-compose) (display 'make-list-c) (test-make-list-c) (display 'let->application) (test-let->application) (display 'let*->let ) (test-let*->let) (display 'filter-in) (test-filter-in) (display 'filter-out) (test-filter-out) (display 'sort-list-of-symbols) (test-sort-list-of-symbols) ) (define r run-all)