(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)))

(define (make-card rank suit)
  (cons rank suit))

(define (card-rank card)
  (car card))

(define (card-suit card)
  (cdr card))

(define (make-hand . cards)
  cards)

(define (first-card hand)
  (car hand))

(define (rest-cards hand)
  (cdr hand))

(define (hand-total hand)
  (if (null? hand)
      0
      (+ (card-rank (first-card hand))
         (hand-total (rest-cards hand)))))

(define sample-hand
  (make-hand (make-card 3 'heart)
             (make-card 10 'club)
             (make-card 4 'diamond)))

(check-equal 'card-rank 10 (card-rank (make-card 10 'heart)))
(check-equal 'card-suit 'heart (card-suit (make-card 10 'heart)))
(check-equal 'first-card (make-card 3 'heart) (first-card sample-hand))
(check-equal 'hand-total 17 (hand-total sample-hand))
(check-equal 'empty-hand-total 0 (hand-total (make-hand)))

(define (make-card-number rank suit)
  (cond
    ((eq? suit 'heart) rank)
    ((eq? suit 'spade) (+ rank 13))
    ((eq? suit 'diamond) (+ rank 26))
    ((eq? suit 'club) (+ rank 39))
    (else (error "unknown suit" suit))))

(define (card-number-rank card)
  (let ((rank (remainder card 13)))
    (if (= rank 0) 13 rank)))

(define (card-number-suit card)
  (cond
    ((<= 1 card 13) 'heart)
    ((<= 14 card 26) 'spade)
    ((<= 27 card 39) 'diamond)
    ((<= 40 card 52) 'club)
    (else (error "card out of range" card))))

(check-equal 'card-number-value 30 (make-card-number 4 'diamond))
(check-equal 'card-number-rank 4 (card-number-rank (make-card-number 4 'diamond)))
(check-equal 'card-number-suit 'diamond (card-number-suit (make-card-number 4 'diamond)))
(check-equal 'card-number-king-rank 13 (card-number-rank (make-card-number 13 'club)))

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

(define (make-rat numerator denominator)
  (if (= denominator 0)
      (error "make-rat: zero denominator")
      (let* ((sign (if (< denominator 0) -1 1))
             (n (* sign numerator))
             (d (* sign denominator))
             (g (integer-gcd (abs n) d)))
        (cons (/ n g) (/ d g)))))

(define (rat-numerator rat)
  (car rat))

(define (rat-denominator rat)
  (cdr rat))

(define (rat-add a b)
  (make-rat (+ (* (rat-numerator a) (rat-denominator b))
               (* (rat-numerator b) (rat-denominator a)))
            (* (rat-denominator a) (rat-denominator b))))

(check-equal 'rat-reduce (cons 1 2) (make-rat 4 8))
(check-equal 'rat-sign (cons -1 3) (make-rat 2 -6))
(check-equal 'rat-add (cons 5 6) (rat-add (make-rat 1 2) (make-rat 1 3)))

(define (make-point x y)
  (cons x y))

(define (point-x point)
  (car point))

(define (point-y point)
  (cdr point))

(define (make-segment start end)
  (cons start end))

(define (segment-start segment)
  (car segment))

(define (segment-end segment)
  (cdr segment))

(define (midpoint-segment segment)
  (let ((start (segment-start segment))
        (end (segment-end segment)))
    (make-point (/ (+ (point-x start) (point-x end)) 2)
                (/ (+ (point-y start) (point-y end)) 2))))

(define sample-segment
  (make-segment (make-point 0 2) (make-point 4 6)))

(check-equal 'point-x 0 (point-x (segment-start sample-segment)))
(check-equal 'point-y 6 (point-y (segment-end sample-segment)))
(check-equal 'midpoint (make-point 2 4) (midpoint-segment sample-segment))

(define (make-interval lower upper)
  (if (> lower upper)
      (error "make-interval: lower is greater than upper" lower upper)
      (cons lower upper)))

(define (interval-lower interval)
  (car interval))

(define (interval-upper interval)
  (cdr interval))

(define (interval-width interval)
  (/ (- (interval-upper interval)
        (interval-lower interval))
     2))

(check-equal 'interval-lower 3 (interval-lower (make-interval 3 9)))
(check-equal 'interval-upper 9 (interval-upper (make-interval 3 9)))
(check-equal 'interval-width 3 (interval-width (make-interval 3 9)))

(define (functional-cons x y)
  (lambda (message)
    (cond
      ((eq? message 'car) x)
      ((eq? message 'cdr) y)
      (else (error "unknown pair message" message)))))

(define (functional-car pair)
  (pair 'car))

(define (functional-cdr pair)
  (pair 'cdr))

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

(check-equal 'functional-car 'left (functional-car functional-pair))
(check-equal 'functional-cdr 'right (functional-cdr functional-pair))

(define nested-list '((a b) c (d (e f))))

(check-equal 'nested-first '(a b) (car nested-list))
(check-equal 'nested-second 'c (cadr nested-list))
(check-equal 'nested-third '(d (e f)) (caddr nested-list))
(check-equal 'nested-deep '(e f) (cadr (caddr nested-list)))
(check-true 'nested-proper-list (list? nested-list))
(check-true 'cons-not-proper-list (not (list? (cons 'x 'y))))

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