tests.scm

;;; Test cases for Scheme.
;;;
;;; In order to run only a prefix of these examples, add the line
;;;
;;; (exit)
;;;
;;; after the last test you wish to run.

;; empty lambda, lambda with number with parameters 

(define errored-lambda-1 (lambda (5) (5)))
; expect Error: Non-symbol: 5

(define errored-lambda-2 (lambda))
; expect Error: too few operands in form

(define errored-function-1 (+ (lambda (x) (x) 5)))
; expect Error: operand 0 ((lambda x x)) is not a number

(define (lots-of-operations num1 num2)
  (cond 
    ((> 15 num1)
      (cond 
        ((< 3 (- num1 3))
          (- num2 16))
        (else
          (- num2 10))
        )
      )
    ((< 2 num1)
      (- 1 (* (+ 2 num1) 4)))
    (else 
      (- num1 num2))
    )
  )
; expect lots-of-operations

(lots-of-operations 0 0)
; expect -10

(lots-of-operations 11244 13414)
; expect -44983

(lots-of-operations 0 212)
; expect 202

*
; expect #[*]

even?
; expect #[even?]

display
; expect #[display]

(odd? (+ 31 (* 4 (- 37 9))))
; expect True

(- 2 0)
; expect 2 

(- 0 2)
; expect -2 

(/ 0 25)
; expect 0 

(/ 25 0)
; expect Error: division by zero

(* 0 0)
; expect 0 

(* 0 87)
; expect 0 

(* (+ 2 2)(- 0 1)(* 5 (- 2 (+ 5 (/ 6 2) 0))))
; expect 120

(define jessica 081897)
; expect jessica 

jessica 
; expect 81897

(define plus-ten (lambda (x) (+ x 10)))
; expect plus-ten

(plus-ten 11)
; expect 21

(define mult-two (lambda (x) (* x 2)))
; expect mult-two

(mult-two 5)
; expect 10

(define (sum-of-mult-two-of-plus-ten x y)
  (+ (mult-two (plus-ten x)) 
    (mult-two (plus-ten y)))
)
; expect sum-of-mult-two-of-plus-ten

(sum-of-mult-two-of-plus-ten 3 4)
; expect 54

(sum-of-mult-two-of-plus-ten (- 0 10)(- 0 15))
; expect -10

'donald
; expect donald

'(1 (2 three . (4 . 5)))
; expect (1 (2 three 4 . 5))

(eval (cons 'car '('(1 2 . 3))))
; expect 1

(begin (* (+ 8 3) 5))
; expect 55

(define x (begin (display 55) (newline) '(* 44 10)))
; expect 55 ; x

(* (eval x) (eval x))
; expect 193600

(define donald (lambda (x) (* x (* 7 10))))
; expect donald

(donald 6)
; expect 420

(define (cube x)
  (* x x x)
)
; expect cube

(cube 1000)
; expect 1000000000

(define (over-or-under x y)
  (cond 
    ((> x y) 1)
    ((= x y) 0)
    ((< x y) -1)
    )
)
; expect over-or-under

(over-or-under 0.45 0.44)
; expect 1

(define loost
  (cons (list 1) (list 2 (cons 3 4) 5)) 
)
; expect loost

'loost
; expect loost

loost
; expect ((1) 2 (3 . 4) 5)

(define (remove item lst)
  (cond 
    ((null? lst) 
      nil)
    ((= (car lst) item) 
      (remove item (cdr lst)))
    (else 
      (cons (car lst) (remove item (cdr lst)))))
)
; expect remove

(remove 3 nil)
; expect ()

(remove 3 '(1 3 5))
; expect (1 5)

(remove 5 '(5 3 5 5 1 4 5 4))
; expect (3 1 4 4)

(define (filter f lst)
  (cond 
    ((null? lst) 
      nil)
    ((f (car lst))
      (cons (car lst) (filter f (cdr lst))))
    (else (filter f (cdr lst)))
)
)
; expect filter

(define one-to-five (list 1 2 3 4 5))
; expect one-to-five

(define (less-than-three n)
  (cond
  ((< 3 n) True)
  (else False)
)
)
; expect less-than-three

(filter less-than-three one-to-five)
; expect (4 5)

(define (make-adder num)
   (lambda (x) (+ x num))
)
; expect make-adder

(define add-6 (make-adder 6))
; expect add-6

(add-6 6)
; expect 12

(define (composed f g)
  (lambda (x) (f (g x)))
)
; expect composed 

(define add-12 (composed add-6 add-6))
; expect add-12

(add-12 15)
; expect 27

(define (caar x) (car (car x)))
(define (cadr x) (car (cdr x)))
(define (cddr x) (cdr (cdr x)))
(define (cadar x) (car (cdr (car x))))

(define (map proc items)
  (if (null? items) nil (cons (proc (car items)) (map proc (cdr items))))
  )
; expect map 

(define (cons-all first rests)
  (cond
    ((null? rests) nil)
    (else (cons
      (append (cons first nil) (car rests))
      (cons-all first (cdr rests))))))
; expect cons-all

(define (zip pairs)
  (list (map car pairs) (map cadr pairs)))
; expect zip

(define (enumerate s)
  (define orig_len (length s))
  (define (recur s)
    (cond
    ((null? s) nil)
    (else (cons (cons (- orig_len (length s)) (cons (car s) nil)) (recur (cdr s))))))
  (recur s)
  )
; expect enumerate

(enumerate '(0 1 2 3 4))
; expect ((0 0) (1 1) (2 2) (3 3) (4 4))

(enumerate ())
; expect ()

(define (list-change total denoms)
  (cond
  ((null? denoms) cons nil)
  ((= total 0) cons(cons nil nil))
  ((> (car denoms) total) (list-change total (cdr denoms)))
  (else (append 
    (cons-all (car denoms) (list-change (- total (car denoms)) denoms))
    (list-change total (cdr denoms))))))
;expect list-change

(list-change 5 (list 0))
; expect Error: maximum recursion depth exceeded

(list-change 0 (list 0))
; expect (())

(list-change 69 (list 100 9 8 7 6))
; expect ((9 9 9 9 9 9 9 6) (9 9 9 9 9 9 8 7) (9 9 9 9 9 8 8 8) (9 9 9 9 9 6 6 6 6) (9 9 9 9 8 7 6 6 6) (9 9 9 9 7 7 7 6 6) (9 9 9 8 8 8 6 6 6) (9 9 9 8 8 7 7 6 6) (9 9 9 8 7 7 7 7 6) (9 9 9 7 7 7 7 7 7) (9 9 9 6 6 6 6 6 6 6) (9 9 8 8 8 8 7 6 6) (9 9 8 8 8 7 7 7 6) (9 9 8 8 7 7 7 7 7) (9 9 8 7 6 6 6 6 6 6) (9 9 7 7 7 6 6 6 6 6) (9 8 8 8 8 8 8 6 6) (9 8 8 8 8 8 7 7 6) (9 8 8 8 8 7 7 7 7) (9 8 8 8 6 6 6 6 6 6) (9 8 8 7 7 6 6 6 6 6) (9 8 7 7 7 7 6 6 6 6) (9 7 7 7 7 7 7 6 6 6) (9 6 6 6 6 6 6 6 6 6 6) (8 8 8 8 8 8 8 7 6) (8 8 8 8 8 8 7 7 7) (8 8 8 8 7 6 6 6 6 6) (8 8 8 7 7 7 6 6 6 6) (8 8 7 7 7 7 7 6 6 6) (8 7 7 7 7 7 7 7 6 6) (8 7 6 6 6 6 6 6 6 6 6) (7 7 7 7 7 7 7 7 7 6) (7 7 7 6 6 6 6 6 6 6 6))

(define (check-special form)
  (lambda (expr) (equal? form (car expr))))

(define lambda? (check-special 'lambda))
(define define? (check-special 'define))
(define quoted? (check-special 'quote))
(define let?    (check-special 'let))

(define (analyze expr)
  (cond ((atom? expr)
         expr
         )
        ((quoted? expr)
          expr
         )
        ((or (lambda? expr)
             (define? expr))
         (let ((form   (car expr))
               (params (cadr expr))
               (body   (cddr expr)))
           (if (list? body) (cons form (cons params (map analyze body))) (cons form (cons params (map analyze (cadr body)))))          
           ))
        ((let? expr)
         (let ((values (cadr expr))
               (body   (cddr expr)))
           (cons (cons 'lambda (cons (car (zip values)) (map analyze body))) (map analyze (cadr (zip values))))
           ))
        (else
         (cons (car expr)(map analyze (cdr expr)))
         )
 )
)
; expect analyze

(analyze '(let ((a 1) (b 2)) (+ a b)))
; expect ((lambda (a b) (+ a b)) 1 2)

(analyze '(let ((a 1)) (let ((b a)) b)))
; expect ((lambda (a) ((lambda (b) b) a)) 1) 

(analyze '(let ((a 1)) (let ((b a)) ((let ((a b))  a)))))
; expect ((lambda (a) ((lambda (b) ((let ((a b)) a))) a)) 1)

(define (levelup humor style)
  (if (or (> humor 2) (> style 1)) (- (+ humor style) 3))) 
; expect levelup

(levelup 5 6)
; expect 8

(define (improve original potential)
    (if (<= potential 0) potential
      (or False
        (and 12 24
          (let ((rank original))
            (+ rank (levelup (/ original 2) (/ original 3))))))))
; expect improve
  
(improve 6 1)
; expect 8

(improve 1 0)
; expect 0



;;; These are examples from several sections of "The Structure
;;; and Interpretation of Computer Programs" by Abelson and Sussman.

;;; License: Creative Commons share alike with attribution

;;; 1.1.1




10
; expect 10

(+ 137 349)
; expect 486

(- 1000 334)
; expect 666

(* 5 99)
; expect 495

(/ 10 5)
; expect 2

(+ 2.7 10)
; expect 12.7

(+ 21 35 12 7)
; expect 75

(* 25 4 12)
; expect 1200

(+ (* 3 5) (- 10 6))
; expect 19

(+ (* 3 (+ (* 2 4) (+ 3 5))) (+ (- 10 7) 6))
; expect 57

(+ (* 3
      (+ (* 2 4)
         (+ 3 5)))
   (+ (- 10 7)
      6))
; expect 57


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Move the following (exit) line to run additional tests. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;; 1.1.2

(define size 2)
; expect size
size
; expect 2

(* 5 size)
; expect 10

(define pi 3.14159)
(define radius 10)
(* pi (* radius radius))
; expect 314.159

(define circumference (* 2 pi radius))
circumference
; expect 62.8318





;;; 1.1.4

(define (square x) (* x x))
; expect square
(square 21)
; expect 441

(define square (lambda (x) (* x x))) ; See Section 1.3.2
(square 21)
; expect 441

(square (+ 2 5))
; expect 49

(square (square 3))
; expect 81

(define (sum-of-squares x y)
  (+ (square x) (square y)))
(sum-of-squares 3 4)
; expect 25

(define (f a)
  (sum-of-squares (+ a 1) (* a 2)))
(f 5)
; expect 136



;;; 1.1.6

(define (abs x)
  (cond ((> x 0) x)
        ((= x 0) 0)
        ((< x 0) (- x))))
(abs -3)
; expect 3

(abs 0)
; expect 0

(abs 3)
; expect 3

(define (a-plus-abs-b a b)
  ((if (> b 0) + -) a b))
(a-plus-abs-b 3 -2)
; expect 5

;;; 1.1.7

(define (sqrt-iter guess x)
  (if (good-enough? guess x)
      guess
      (sqrt-iter (improve guess x)
                 x)))
(define (improve guess x)
  (average guess (/ x guess)))
(define (average x y)
  (/ (+ x y) 2))
(define (good-enough? guess x)
  (< (abs (- (square guess) x)) 0.001))
(define (sqrt x)
  (sqrt-iter 1.0 x))
(sqrt 9)
; expect 3.00009155413138

(sqrt (+ 100 37))
; expect 11.704699917758145

(sqrt (+ (sqrt 2) (sqrt 3)))
; expect 1.7739279023207892

(square (sqrt 1000))
; expect 1000.000369924366

;;; 1.1.8

(define (sqrt x)
  (define (good-enough? guess)
    (< (abs (- (square guess) x)) 0.001))
  (define (improve guess)
    (average guess (/ x guess)))
  (define (sqrt-iter guess)
    (if (good-enough? guess)
        guess
        (sqrt-iter (improve guess))))
  (sqrt-iter 1.0))
(sqrt 9)
; expect 3.00009155413138

(sqrt (+ 100 37))
; expect 11.704699917758145

(sqrt (+ (sqrt 2) (sqrt 3)))
; expect 1.7739279023207892

(square (sqrt 1000))
; expect 1000.000369924366

;;; 1.3.1

(define (cube x) (* x x x))
(define (sum term a next b)
  (if (> a b)
      0
      (+ (term a)
         (sum term (next a) next b))))
(define (inc n) (+ n 1))
(define (sum-cubes a b)
  (sum cube a inc b))
(sum-cubes 1 10)
; expect 3025

(define (identity x) x)
(define (sum-integers a b)
  (sum identity a inc b))
(sum-integers 1 10)
; expect 55

;;; 1.3.2

((lambda (x y z) (+ x y (square z))) 1 2 3)
; expect 12

(define (f x y)
  (let ((a (+ 1 (* x y)))
        (b (- 1 y)))
    (+ (* x (square a))
       (* y b)
       (* a b))))
(f 3 4)
; expect 456

(define x 5)
(+ (let ((x 3))
     (+ x (* x 10)))
   x)
; expect 38

(let ((x 3)
      (y (+ x 2)))
  (* x y))
; expect 21


;;; 2.1.1

(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))
(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))
(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

(define x (cons 1 2))
(car x)
; expect 1

(cdr x)
; expect 2

(define x (cons 1 2))
(define y (cons 3 4))
(define z (cons x y))
(car (car z))
; expect 1

(car (cdr z))
; expect 3


z
; expect ((1 . 2) 3 . 4)

(define (make-rat n d) (cons n d))
(define (numer x) (car x))
(define (denom x) (cdr x))
(define (print-rat x)
  (display (numer x))
  (display '/)
  (display (denom x))
  (newline))
(define one-half (make-rat 1 2))
(print-rat one-half)
; expect 1/2 ; okay

(define one-third (make-rat 1 3))
(print-rat (add-rat one-half one-third))
; expect 5/6 ; okay

(print-rat (mul-rat one-half one-third))
; expect 1/6 ; okay

(print-rat (add-rat one-third one-third))
; expect 6/9 ; okay

(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))
(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))
(print-rat (add-rat one-third one-third))
; expect 2/3 ; okay

(define one-through-four (list 1 2 3 4))
one-through-four
; expect (1 2 3 4)

(car one-through-four)
; expect 1

(cdr one-through-four)
; expect (2 3 4)

(car (cdr one-through-four))
; expect 2

(cons 10 one-through-four)
; expect (10 1 2 3 4)

(cons 5 one-through-four)
; expect (5 1 2 3 4)

(define (map proc items)
  (if (null? items)
      nil
      (cons (proc (car items))
            (map proc (cdr items)))))
(map abs (list -10 2.5 -11.6 17))
; expect (10 2.5 11.6 17)

(map (lambda (x) (* x x))
     (list 1 2 3 4))
; expect (1 4 9 16)

(define (scale-list items factor)
  (map (lambda (x) (* x factor))
       items))
(scale-list (list 1 2 3 4 5) 10)
; expect (10 20 30 40 50)

(define (count-leaves x)
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))
(define x (cons (list 1 2) (list 3 4)))
(count-leaves x)
; expect 4

(count-leaves (list x x))
; expect 8




;;; 2.2.3

(define (odd? x) (= 1 (remainder x 2)))
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))
(filter odd? (list 1 2 3 4 5))
; expect (1 3 5)

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))
(accumulate + 0 (list 1 2 3 4 5))
; expect 15

(accumulate * 1 (list 1 2 3 4 5))
; expect 120

(accumulate cons nil (list 1 2 3 4 5))
; expect (1 2 3 4 5)

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))
(enumerate-interval 2 7)
; expect (2 3 4 5 6 7)

(define (enumerate-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (list tree))
        (else (append (enumerate-tree (car tree))
                      (enumerate-tree (cdr tree))))))
(enumerate-tree (list 1 (list 2 (list 3 4)) 5))
; expect (1 2 3 4 5)

;;; 2.3.1

(define a 1)

(define b 2)

(list a b)
; expect (1 2)

(list 'a 'b)
; expect (a b)

(list 'a b)
; expect (a 2)

(car '(a b c))
; expect a

(cdr '(a b c))
; expect (b c)

(define (memq item x)
  (cond ((null? x) false)
        ((eq? item (car x)) x)
        (else (memq item (cdr x)))))
(memq 'apple '(pear banana prune))
; expect False

(memq 'apple '(x (apple sauce) y apple pear))
; expect (apple pear)

(define (equal? x y)
  (cond ((pair? x) (and (pair? y)
                        (equal? (car x) (car y))
                        (equal? (cdr x) (cdr y))))
        ((null? x) (null? y))
        (else (eq? x y))))

(equal? '(1 2 (three)) '(1 2 (three)))
; expect True

(equal? '(1 2 (three)) '(1 2 three))
; expect False

(equal? '(1 2 three) '(1 2 (three)))
; expect False

;;; Peter Norvig tests (http://norvig.com/lispy2.html)

(define double (lambda (x) (* 2 x)))
(double 5)
; expect 10

(define compose (lambda (f g) (lambda (x) (f (g x)))))
((compose list double) 5)
; expect (10)

(define apply-twice (lambda (f) (compose f f)))
((apply-twice double) 5)
; expect 20

((apply-twice (apply-twice double)) 5)
; expect 80

(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1))))))
(fact 3)
; expect 6

(fact 50)
; expect 30414093201713378043612608166064768844377641568960512000000000000

(define (combine f)
  (lambda (x y)
    (if (null? x) nil
      (f (list (car x) (car y))
         ((combine f) (cdr x) (cdr y))))))
(define zip (combine cons))
(zip (list 1 2 3 4) (list 5 6 7 8))
; expect ((1 5) (2 6) (3 7) (4 8))

(define riff-shuffle (lambda (deck) (begin
    (define take (lambda (n seq) (if (<= n 0) (quote ()) (cons (car seq) (take (- n 1) (cdr seq))))))
    (define drop (lambda (n seq) (if (<= n 0) seq (drop (- n 1) (cdr seq)))))
    (define mid (lambda (seq) (/ (length seq) 2)))
    ((combine append) (take (mid deck) deck) (drop (mid deck) deck)))))
(riff-shuffle (list 1 2 3 4 5 6 7 8))
; expect (1 5 2 6 3 7 4 8)

((apply-twice riff-shuffle) (list 1 2 3 4 5 6 7 8))
; expect (1 3 5 7 2 4 6 8)

(riff-shuffle (riff-shuffle (riff-shuffle (list 1 2 3 4 5 6 7 8))))
; expect (1 2 3 4 5 6 7 8)

;;; Additional tests

(apply square '(2))
; expect 4

(apply + '(1 2 3 4))
; expect 10

(apply (if false + append) '((1 2) (3 4)))
; expect (1 2 3 4)

(if 0 1 2)
; expect 1

(if '() 1 2)
; expect 1

(or false true)
; expect True

(or)
; expect False

(and)
; expect True

(or 1 2 3)
; expect 1

(and 1 2 3)
; expect 3

(and False (/ 1 0))
; expect False

(and True (/ 1 0))
; expect Error

(or 3 (/ 1 0))
; expect 3

(or False (/ 1 0))
; expect Error

(or (quote hello) (quote world))
; expect hello

(if nil 1 2)
; expect 1

(if 0 1 2)
; expect 1

(if (or false False #f) 1 2)
; expect 2

(define (loop) (loop))
(cond (false (loop))
      (12))
; expect 12

((lambda (x) (display x) (newline) x) 2)
; expect 2 ; 2

(define g (mu () x))
(define (high f x)
  (f))

(high g 2)
; expect 2

(define (print-and-square x)
  (print x)
  (square x))
(print-and-square 12)
; expect 12 ; 144

(/ 1 0)
; expect Error

(define addx (mu (x) (+ x y)))
(define add2xy (lambda (x y) (addx (+ x x))))
(add2xy 3 7)
; expect 13


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Scheme Implementations ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; len outputs the length of list s
(define (len s)
  (if (eq? s '())
    0
    (+ 1 (len (cdr s)))))
(len '(1 2 3 4))
; expect 4


;;;;;;;;;;;;;;;;;;;;
;;; Extra credit ;;;
;;;;;;;;;;;;;;;;;;;;


; Tail call optimization tests

(define (sum n total)
  (if (zero? n) total
    (sum (- n 1) (+ n total))))
(sum 1001 0)
; expect 501501

(define (sum n total)
  (cond ((zero? n) total)
        (else (sum (- n 1) (+ n total)))))
(sum 1001 0)
; expect 501501

(define (sum n total)
  (begin 2 3
    (if (zero? n) total
      (and 2 3
        (or false
          (begin 2 3
            (let ((m n))
              (sum (- m 1) (+ m total)))))))))
(sum 1001 0)
; expect 501501

(exit)