(import (scheme base)
        (scheme write)
        (scheme process-context))

(define failures '())

(define (record-failure label expected actual)
  (set! failures (cons (list label expected actual) failures)))

(define (check-equal label expected actual)
  (unless (equal? expected actual)
    (record-failure label expected actual)))

(define (check-true label value)
  (unless value
    (record-failure label #t value)))

(check-equal 'arithmetic 6 (+ 1 2 3))
(check-equal 'conditional 'larger (if (> 7 3) 'larger 'smaller))

(define (square-number n)
  (* n n))

(check-equal 'procedure-call 81 (square-number 9))
(check-equal 'composed-argument 25 (square-number (+ 2 3)))

(define unit-square-side 1)
(define default-width 7)

(check-equal 'constant-value 1 unit-square-side)
(check-equal 'named-width 7 default-width)

(define (rectangle-area width height)
  (* width height))

(define (rectangle-perimeter width height)
  (* 2 (+ width height)))

(define (triangle-area base height)
  (/ (* base height) 2))

(check-equal 'rectangle-area 42 (rectangle-area 7 6))
(check-equal 'rectangle-perimeter 26 (rectangle-perimeter 7 6))
(check-equal 'triangle-area 12 (triangle-area 8 3))

(define (safe-reciprocal n)
  (if (= n 0)
      'undefined
      (/ 1 n)))

(check-equal 'if-selected-branch 'undefined (safe-reciprocal 0))
(check-equal 'if-other-branch 1/4 (safe-reciprocal 4))

(define (number-kind n)
  (cond
    ((< n 0) 'negative)
    ((= n 0) 'zero)
    ((even? n) 'positive-even)
    (else 'positive-odd)))

(check-equal 'cond-negative 'negative (number-kind -3))
(check-equal 'cond-zero 'zero (number-kind 0))
(check-equal 'cond-even 'positive-even (number-kind 8))
(check-equal 'cond-odd 'positive-odd (number-kind 9))

(define (buzz-basic n)
  (cond
    ((= (remainder n 7) 0) 'buzz)
    ((= (remainder n 10) 7) 'buzz)
    (else n)))

(check-equal 'buzz-multiple 'buzz (buzz-basic 14))
(check-equal 'buzz-last-digit 'buzz (buzz-basic 27))
(check-equal 'buzz-other 31 (buzz-basic 31))

; Guard before recursion. Without this, negative inputs would keep moving
; farther from the base case and recur forever.
(define (factorial n)
  (cond
    ((or (not (integer? n)) (< n 0))
     (error "factorial: expected a nonnegative integer" n))
    ((<= n 1) 1)
    (else (* n (factorial (- n 1))))))

(check-equal 'factorial-zero 1 (factorial 0))
(check-equal 'factorial-one 1 (factorial 1))
(check-equal 'factorial-five 120 (factorial 5))

(define (euclid-gcd a b)
  (if (= b 0)
      a
      (euclid-gcd b (remainder a b))))

(check-equal 'euclid-gcd 6 (euclid-gcd 84 30))

(define sample-words '(scheme r7rs lists))

(check-equal 'first-symbol 'scheme (car sample-words))
(check-true 'list-is-pair (pair? sample-words))
(check-true 'proper-list (list? sample-words))
(check-equal 'list-tail '(r7rs lists) (cdr sample-words))

(define dotted-pair (cons 'left 'right))

(check-true 'dotted-pair-is-pair (pair? dotted-pair))
(check-true 'dotted-pair-is-not-list (not (list? dotted-pair)))
(check-equal 'dotted-pair-car 'left (car dotted-pair))
(check-equal 'dotted-pair-cdr 'right (cdr dotted-pair))

(define (sum-list numbers)
  (if (null? numbers)
      0
      (+ (car numbers) (sum-list (cdr numbers)))))

(check-equal 'structural-recursion 10 (sum-list '(1 2 3 4)))

(define (count-if predicate items)
  (cond
    ((null? items) 0)
    ((predicate (car items)) (+ 1 (count-if predicate (cdr items))))
    (else (count-if predicate (cdr items)))))

(check-equal 'higher-order-procedure
             2
             (count-if (lambda (n) (> n 5)) '(2 8 4 9)))

(check-equal 'map-square '(1 4 9 16) (map square-number '(1 2 3 4)))

(if (null? failures)
    (begin
      (display "Intro lesson 01 tests passed")
      (newline)
      (exit 0))
    (begin
      (display "Intro lesson 01 tests failed")
      (newline)
      (for-each (lambda (failure)
                  (write failure)
                  (newline))
                (reverse failures))
      (exit 1)))