The Little Schemer

schemer.rkt

; some of this functions, specifically ones from the early chapters, aren't tested,
; as I schemed through them.

; atom?
(define atom?
  (lambda (x)
    (and (not (pair? x)) (not (null? x)))))

; lat?
(define lat?
  (lambda (l)
    (cond
      ((null? l) #t)
      ((atom? (car l)) (lat? (cdr l)))
      (else #f))))

; rember
(define rember
  (lambda (lat a)
    (cond
      ((null? lat) '())
      ((eq? (car lat) a) (cdr lat))
      (else (cons
             (car lat)
             (rember (cdr lat) a))))))

; member?
(define member?
  (lambda (l x)
    (cond
      ((null? l) #f)
      ((eq? (car l) x) #t)
      (else (member? (cdr l) x)))))

; firsts
(define firsts
  (lambda (l)
    (cond
      ((null? l) '())
      (else (cons
             (car (car l))
             (firsts (cdr l)))))))

; insertR
(define insertR
  (lambda (l old new)
    (cond
      ((null? l) '())
      ((eq? (car l) old) (cons
                          old (cons new (cdr l))))
      (else (cons (car l) (insertR (cdr l) old new))))))

; insertL
(define insertL
  (lambda (l old new)
    (cond
      ((null? l) '())
      ((eq? (car l) old) (cons
                          (new l)))
      (else (cons (car l) (insertL (cdr l) old new))))))

; subst
(define subst
  (lambda (l old new)
    (cond
      ((null? l) '())
      ((eq? (car l) old) (cons new (cdr l)))
      (else (cons (car l) (subst (cdr l) old new))))))

; subst2
(define subst2
  (lambda (l old1 old2 new)
    (cond
      ((null? l) '())
      ((or (eq? (car l) old1) (eq? (car l) old2)) (cons new (cdr l)))
      (else (cons (car l) (subst2 (cdr l) old1 old2 new))))))

; multirember
(define multirember
  (lambda (l a)
    (cond
      ((null? l) '())
      ((eq? (car l) a) (multirember (cdr l) a))
      (else (cons (car l) (multirember (cdr l) a))))))

; multi_insert_right
(define multi_insert_right
  (lambda (l a v)
    (cond
      ((null? l) '())
      ((eq? v (car l)) (cons v (cons a (multi_insert_right (cdr l) a v))))
      (else (cons (car l) (multi_insert_right (cdr l) a v))))))

; multi_insert_left
(define multi_insert_left
  (lambda (l a v)
    (cond
      ((null? l) '())
      ((eq? v (car l)) (cons a (cons v (multi_insert_left (cdr l) a v))))
      (else (cons (car l) (multi_insert_left (cdr l) a v))))))

; multi_subst
(define multi_subst
  (lambda (l a v)
    (cond
      ((null? l) '())
      ((eq? v (car l)) (cons a (multi_subst (cdr l) a v)))
      (else (cons (car l) (multi_subst (cdr l) a v ))))))

; Chapter 4
(define add1
  (lambda (n)
    (+ n 1)))

(define sub1
  (lambda (n)
    (- n 1)))

(define add
  (lambda (x y)
    (cond
      ((zero? y) x)
      (else (add (add1 x) (sub1 y))))))

(define sub
  (lambda (x y)
    (cond
      ((zero? y) x)
      (else (sub (sub1 x) (sub1 y))))))

(define add_tup
  (lambda (tup)
    (cond
      ((null? tup) 0)
      (else (add (car tup) (add_tup (cdr tup)))))))

(define multiply
  (lambda (x y)
    (cond
      ((zero? y) 0)
      (else (add x (multiply x (sub1 y)))))))

(define merge_tups
  (lambda (tup1 tup2)
    (cond
      ((null? tup1) tup2)
      ((null? tup2) tup1)
      (else (cons (add (car tup1) (car tup2)) (merge_tups (cdr tup1) (cdr tup2)))))))

(define bigger?
  (lambda (x y)
    (cond
      ((zero? x) #f)
      ((zero? y) #t)
      (else (bigger? (sub1 x) (sub1 y))))))

(define smaller?
  (lambda (x y)
    (bigger? y x)))

(define equal
  (lambda (x y)
    (not (or (bigger? x y) (smaller? x y)))))

(define pow
  (lambda (x y)
  (cond
    ((= y 0) 1)
    (else (multiply x (pow x (sub1 y)))))))
      
(define division
  (lambda (x y)
    (cond
      ((< x y) 0)
      (else (add1 (division (sub x y) y))))))
      
; length
(define len
  (lambda (l)
    (cond
      ((null? l) 0)
      (else (add1 (length (cdr l)))))))

(define pick
  (lambda (n l)
    (cond
      ((= n 1) (car l))
      (else (pick (- n 1) (cdr l))))))

(define rempick
  (lambda (n l)
    (cond
      ((= n 1) (cdr l))
      (else (cons (car l) (rempick (- n 1) (cdr l)))))))

(define no_nums
  (lambda (l)
    (cond
      ((null? l) '())
      ((number? (car l)) (no_nums (cdr l)))
      (else (cons (car l) (no_nums (cdr l)))))))

(define just_nums
  (lambda (l)
    (cond
      ((null? l) '())
      ((number? (car l)) (cons (car l) (just_nums (cdr l))))
      (else (just_nums (cdr l))))))

(define eqan?
  (lambda (a b)
    (cond
      ((and (number? a) (number? b)) (equal a b))
      ((or (number? a) (number? b)) #f)
      (else (eq? a b)))))

(define occur
  (lambda (a l)
    (cond
      ((null? l) 0)
      ((eqan? (car l) a) (add1 (occur a (cdr l))))
      (else (occur a (cdr l))))))

(define one?
  (lambda (n)
    (equal n 1)))

(define rempick_rewritten
  (lambda (n l)
    (cond
      ((one? n) (cdr l))
      (else (cons (car l) (rempick_rewritten (- n 1) (cdr l)))))))

; Chapter 5
(define rember*
  (lambda (a l)
    (cond
      ((null? l) '())
      ((and (atom? (car l)) (eqan? a (car l))) (rember* a (cdr l)))
      ((and (list? (car l))) (cons (rember* a (car l)) (rember* a (cdr l))))
      (else (cons (car l) (rember* a (cdr l)))))))

(define insertR*
  (lambda (find add l)
    (cond
      ((null? l) '())
      ((and (atom? (car l)) (eqan? find (car l))) (cons find (cons add (insertR* find add (cdr l)))))
      ((and (list? (car l))) (cons (insertR* find add (car l)) (insertR* find add (cdr l))))
      (else (cons (car l) (insertR* find add (cdr l)))))))

; >> (occur* 1 (list 1 1 1 (list 1 1 (list 3 1)) 4 1 (list 5)))
; 7
(define occur*
  (lambda (a l)
    (cond
      ((null? l) 0)
      ((and (atom? (car l)) (eqan? a (car l))) (add1 (occur* a (cdr l))))
      ((list? (car l)) (add (occur* a (car l)) (occur* a (cdr l))))
      (else (occur* a (cdr l))))))


; (subst* 1 2 (list 1 1 2 1 (list 4 1 2 1 (list 52 1 2 3) (list 1 1 12) 1 3 2 1) 1 1))
; >> (2 2 2 2 (4 2 2 2 (52 2 2 3) (2 2 12) 2 3 2 2) 2 2)
(define subst*
  (lambda (old new l)
    (cond
      ((null? l) '())
      ((and (atom? (car l)) (eqan? old (car l))) (cons new (subst* old new (cdr l))))
      ((and (list? (car l))) (cons (subst* old new (car l)) (subst* old new (cdr l))))
      (else (cons (car l) (subst* old new (cdr l)))))))

; (insertL* 1 2 (list 1 3 1 1 3 3 4 5 2 (list 4 3 2 1 1 1 (list 2 1 1 2 3) 3 1 1 4)))
; >> (2 1 3 2 1 2 1 3 3 4 5 2 (4 3 2 2 1 2 1 2 1 (2 2 1 2 1 2 3) 3 2 1 2 1 4))
(define insertL*
  (lambda (find add l)
    (cond
      ((null? l) '())
      ((and (atom? (car l)) (eqan? find (car l))) (cons add (cons find (insertL* find add (cdr l)))))
      ((and (list? (car l))) (cons (insertL* find add (car l)) (insertL* find add (cdr l))))
      (else (cons (car l) (insertL* find add (cdr l)))))))

; (member* 1 (list 2 2 2 (list 1 1)))
; >> #t
; (member* 10 (list 2 2 2 (list 2 2)))
; >> #f
(define member*
  (lambda (a l)
    (cond
      ((null? l) #f)
      ((and (atom? (car l)) (eqan? a (car l))) #t)
      ((list? (car l)) (or (member* a (car l)) (member* a (cdr l))))
      (else (member* a (cdr l))))))

; (leftmost (list (list (list 3))))
; >> 3
(define leftmost
  (lambda (l)
    (cond
      ((atom? (car l)) (car l))
      (else (leftmost (car l))))))

; (eqlist? (list (list (list 3) 2) 1) (list (list (list 3) 2) 1))
; >> #t
; (eqlist? (list (list (list 6) 2) 1) (list (list (list 3) 2) 1))
; >> #f
(define eqlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1) (null? l2)) #t)
      ((or (null? l1) (null? l2)) #f)
      ((and (atom? (car l1)) (atom? (car l2)) (eqan? (car l1) (car l2))) (eqlist? (cdr l1) (cdr l2)))
      ((and (list? (car l1)) (list? (car l2))) (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))))
      (else #f))))

; (equal? (list 2 (list 3)) (list 2 (list 3)))
; #t
(define equal??
  (lambda (s1 s2)
      (cond
       ((eqan? s1 s2) #t)
       ((or (atom? s1) (atom? s2)) #f)
       (else (eqlist? s1 s2)))))

; Chapter 6
; > (numbered? '(1 + 3))
; #t
; > (numbered? '(list + 3))
; #f
(define numbered?
  (lambda (exp)
    (cond
      ((atom? exp) (number? exp))
      (else (and (numbered? (car exp)) (numbered? (car (cdr (cdr exp)))))))))

; evaluates an arithmetic operation
; > (value '((2 pow 5) add 3))
; 35
(define value
  (lambda (exp)
    (cond
      ((atom? exp) exp)
      ((eq? (car (cdr exp)) 'add) (add (value (car exp)) (value (car (cdr (cdr exp))))))
      ((eq? (car (cdr exp)) 'multiply) (multiply (value (car exp)) (value (car (cdr (cdr exp))))))
      (else (pow (value (car exp)) (value (car (cdr (cdr exp)))))))))

; > (value1 '(add (pow 2 5) 3))
(define value1
  (lambda (exp)
    (cond
      ((atom? exp) exp)
      ((eq? (car exp) 'add) (add (value1 (car (cdr exp))) (value1 (car (cdr (cdr exp))))))
      ((eq? (car exp) 'multiply) (multiply (value1 (car exp)) (value1 (car (cdr (cdr exp))))))
      (else (pow (value1 (car (cdr exp))) (value1 (car (cdr (cdr exp)))))))))

(define 1st-sub-exp
  (lambda (exp)
    (car (cdr exp))))

(define 2nd-sub-exp
  (lambda (exp)
    (car (cdr (cdr exp)))))

(define operator
  (lambda (exp)
    (car exp)))

; same as above
; > (value2 '(add (pow 1 5) (multiply 3 7)))
; 22
(define value2
  (lambda (exp)
    (cond
      ((atom? exp) exp)
      ((eq? (operator exp) 'add) (add (value2 (1st-sub-exp exp)) (value2 (2nd-sub-exp exp))))
      ((eq? (operator exp) 'multiply) (multiply (1st-sub-exp exp) (value2 (2nd-sub-exp exp))))
      (else (pow (value2 (1st-sub-exp exp)) (value2 (2nd-sub-exp exp)))))))

; This is getting fun!
; (sero? (list))
(define sero?
  (lambda (n)
    (null? n)))

(define zdd
  (lambda (z)
    (cons '() z)))

(define zub
  (lambda (z)
    (cond
      ((null? z) '())
      (else (cdr z)))))

(define zadd
  (lambda (x y)
    (cond
      ((null? y) x)
      (else (zadd (zdd x) (zub y))))))

;helper to convert numbers to empty lists
; > (zadd (zconvert '() 4) (zconvert '() 4))
; (() () () () () () () ())
(define zconvert
  (lambda (x y)
    (cond
      ((zero? y) x)
      (else (zconvert (zdd x) (sub1 y))))))

; Chapter 7
; > (set? '(apple 3 pear))
; #t
; > (set? '(3 3 2))
; #f
(define set?
  (lambda (l)
    (cond
      ((null? l) #t)
      (else (and (not (member (car l) (cdr l))) (set? (cdr l)))))))

(define makeset
  (lambda (l)
    (cond
      ((null? l) l)
      ((member? (cdr l) (car l)) (cons (car l) (makeset (multirember (cdr l) (car l)))))
      (else (cons (car l) (makeset (cdr l)))))))

; last occurence
(define makeset1
  (lambda (l)
    (cond
     ((null? l) '())
     ((member? (cdr l) (car l)) (makeset (cdr l)))
     (else (cons (car l) (makeset1 (cdr l)))))))

; > (subset? '(1 2 3) '(1 2 3))
; #t
(define subset?
  (lambda (s1 s2)
    (cond
      ((null? s1) #t)
      (else (and (member? s2 (car s1)) (subset? (cdr s1) s2))))))

; > (eqset? '(1 2) '(1 2))
; #t
; > (eqset? '(2 1) '(2 1))
; #t
; > (eqset? '(3 2 1) '(2 1))
; #f
; The solution in the book uses the mathematical properties of sets.
(define eqset?
  (lambda (s1 s2)
    (cond
      ((and (null? s1) (null? s2)) #t)
      (else (and (eqan? (car s1) (car s2)) (eqset? (cdr s1) (cdr s2)))))))

; > (intersect? '(1 2 3) '(5 4 3))
; #t
; > (intersect? '(1 2 3) '(6 5 4))
; #f
(define intersect?
  (lambda (s1 s2)
    (cond
      ((null? s1) #f)
      (else (or (member? s2 (car s1)) (intersect? (cdr s1) s2))))))

; > (intersect '(1 2 3) '(5 4 3))
; (3)
(define intersect
  (lambda (s1 s2)
    (cond
      ((null? s1) '())
      ((member? s2 (car s1)) (cons (car s1) (intersect (cdr s1) s2)))
      (else (intersect (cdr s1) s2)))))

; > (union '(1 2 3) '(1 2 3))
; (1 2 3)
; > (union '(1 2 3 4) '(1))
; (4 3 2 1)
(define union
  (lambda (s1 s2)
    (cond
      ((null? s1) s2)
      ((not (member? s2 (car s1))) (union (cdr s1) (cons (car s1) s2)))
      (else (union (cdr s1) s2)))))