#lang scheme
(require "../random.ss"
"../schemeunit.ss"
(planet schematics/schemeunit:2:10/test)
(planet schematics/schemeunit:2:10/graphical-ui))
(define (absolute-value x)
(if (< x 0) (- x) x))
(define (area-of-circle r)
(* pi r r))
(define-struct circle (radius color))
(define-struct rectangle (width height color))
(define (area sh)
(cond
[(circle? sh) (area-of-circle (circle-radius sh))]
[(rectangle? sh) (* (rectangle-width sh) (rectangle-height sh))]))
(define (sum ns)
(cond
[(empty? ns) 0]
[(cons? ns) (+ (car ns) (sum (cdr ns)))]))
(define-struct node (value left right))
(define (bt-contains? bt n)
(cond
[(symbol? bt) #f]
[(node? bt) (or (= (node-value bt) n)
(bt-contains? (node-left bt) n)
(bt-contains? (node-right bt) n))]))
(define (pay hrs)
(+ 50 (* 8 hrs)))
(define (build-list-squares n)
(if (<= n 0)
empty
(cons (sqr n) (build-list-squares (- n 1)))))
(define (double ns)
(if (empty? ns)
empty
(cons (* 2 (first ns))
(double (rest ns)))))
(define (insert n ns)
(cond
[(empty? ns) (list n)]
[(cons? ns) (if (<= n (first ns))
(cons n ns)
(cons (first ns) (insert n (rest ns))))]))
(define (insert-sort ns)
(cond
[(empty? ns) empty]
[(cons? ns) (insert (first ns) (insert-sort (rest ns)))]))
(define (count-files d)
(cond
[(empty? d) 0]
[(string? (first d)) (+ 1 (count-files (rest d)))]
[else (+ (count-files (first d)) (count-files (rest d)))]))
(define (dir->files d)
(cond
[(empty? d) empty]
[(string? (first d)) (cons (first d) (dir->files (rest d)))]
[else (append (dir->files (first d)) (dir->files (rest d)))]))
(define (random-shape)
(random-case
(make-circle (random-positive-real) 'red)
(make-rectangle (random-positive-real) (random-positive-real) 'blue)))
(define (random-bt-of random-value)
(random-case
'leaf
(make-node (random-value)
(random-bt-of random-value)
(random-bt-of random-value))
#:weight 1/3))
(define (sorted? ns)
(cond
[(empty? ns) #t]
[(and (cons? ns) (empty? (cdr ns))) #t]
[(and (cons? ns) (cons? (cdr ns)))
(and (<= (first ns) (first (rest ns)))
(sorted? (rest ns)))]))
(define (random-directory max-depth)
(random-case
empty
(cons (random-string) (random-directory (sub1 max-depth)))
#:weight (- 1 (/ 1 max-depth))
(cons (random-directory (sub1 max-depth))
(random-directory (sub1 max-depth)))
#:weight (- 1 (/ 1 max-depth))))
(test/graphical-ui
(test-suite "Tutorial"
(test-suite "Success"
(test-suite "Section 1"
(test-suite "absolute-value"
(test-random ([x (random-real)]) (check-pred real? (absolute-value x)))
(test-random ([x (random-real)]) (check <= 0 (absolute-value x))))
(test-suite "area-of-circle"
(test-random ([r (random-positive-real)])
(check-pred real? (area-of-circle r)))
(test-random ([r (random-positive-real)])
(check <= 0 (area-of-circle r))))
(test-suite "area"
(test-random ([sh (random-shape)])
(check-pred real? (area sh)))
(test-random ([sh (random-shape)])
(check <= 0 (area sh))))
(test-suite "sum"
(test-random ([ns (random-list random-number)])
(check-pred number? (sum ns))))
(test-suite "bt-contains?"
(test-random ([n (random-integer/uniform 1 10)]
[bt (random-bt-of
(lambda () (random-integer/uniform 1 10)))])
(check-pred boolean? (bt-contains? bt n)))))
(test-suite "Section 2"
(test-suite "pay"
(test-random ([hrs (random-natural)])
(check-pred integer? (pay hrs))))
(test-suite "build-list-squares"
(test-random ([n (random-natural)]
[sqrs (build-list-squares n)])
(for ([i sqrs]) (check-pred integer? i))))
(test-suite "double"
(test-random ([ns (random-list random-integer)]
[ds (double ns)])
(for ([i ds]) (check-pred even? i))))
(test-suite "insert"
(test-random ([n (random-integer)]
[ns (sort (random-list random-integer) <)])
(check-pred sorted? ns)))
(test-suite "insert-sort"
(test-random ([ns (random-list random-integer)])
(check-pred sorted? (insert-sort ns))))
(test-suite "files"
(test-random ([d (random-directory 4)])
(check = (count-files d) (length (dir->files d)))))))
(test-suite "Failure"
(test-suite "Section 1"
(test-random ([x (random-real)])
(check-pred negative? (absolute-value x)))
(test-random ([r (random-positive-real)])
(check < (area-of-circle r) 0))
(test-random ([sh (random-number)])
(check-pred number? (area sh)))
(test-random ([n (random-real)]
[bt (random-bt-of random-real)])
(check bt-contains? bt n)))
(test-suite "Section 2"
(test-random ([ns (random-list random-integer)
#:where (lambda (x) (andmap inexact? x))])
#t)
(test-random ([ns (random-list random-natural #:len 20)
#:where sorted?])
#t)
(test-random ([d (random-directory 4)]) (fail))))))