the little schemer.rkt

#lang racket

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

; Do it, Do It Again, and Again
(define (lat? l)
  (if (pair? l)
      (and (atom? (car l)) (lat? (cdr l)))
      (null? l)))

(define member?
  (λ (a l)
    (and (pair? l)
         (or (eq? (car l) a)
             (member? a (cdr l))))))

; Cons the Magnificent
(define rember
  (λ (a lat)
    (if (null? lat)
        '()
        (if (eq? a (car lat))
            (cdr lat)
            (cons (car lat) (rember a (cdr lat)))))))



(define firsts
  (λ (l)
    (if (null? l)
        '()
        (cons (car (car l)) (firsts (cdr l))))))

(define insertR
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons old (cons new (cdr lat)))
            (cons (car lat) (insertR new old (cdr lat)))))))

(define insertL
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons new lat)
            (cons (car lat) (insertL new old (cdr lat)))))))

(define subst
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons new (cdr lat))
            (cons (car lat) (subst new old (cdr lat)))))))

(define multirember
  (λ (a lat)
    (if (null? lat)
        '()
        (if (eq? a (car lat))
            (multirember a (cdr lat))
            (cons (car lat) (multirember a (cdr lat)))))))

(define multiinsertR
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons old (cons new (multiinsertR new old (cdr lat))))
            (cons (car lat) (multiinsertR new old (cdr lat)))))))

(define multiinsertL
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons new (cons old (multiinsertL new old (cdr lat))))
            (cons (car lat) (multiinsertL new old (cdr lat)))))))

(define multisubst
  (λ (new old lat)
    (if (null? lat)
        '()
        (if (eq? old (car lat))
            (cons new (multisubst new old (cdr lat)))
            (cons (car lat) (multisubst new old (cdr lat)))))))

; Numbers Games
(define add1
  (λ (n)
    (+ 1 n)))

(define sub1
  (λ (n)
    (- n 1)))

;(define zero?
;  (λ (n)
;    (= 0 n)))

(define add
  (λ (m n)
    (if (zero? m)
        n
        (add (sub1 m) (add1 n)))))

(define sub
  (λ (m n)
    (if (zero? n)
        m
        (sub (sub1 m) (sub1 n)))))


(define tup?
  (λ (lat)
    (if (null? lat)
        #t
        (and (number? (car lat)) (tup? (cdr lat))))))

(define addtup
  (λ (lat)
    (if (null? lat)
        0
        (add (car lat) (addtup (cdr lat))))))

(define ×
  (λ (m n)
    (if (zero? n)
        0
        (add m (× m (sub1 n))))))


(define tup+
  (λ (tup1 tup2)
    (cond ((null? tup1) tup2)
          ((null? tup2) tup1)
          (else
           (cons (add (car tup1) (car tup2))
                 (tup+ (cdr tup1) (cdr tup2)))))))

(define >
  (λ (m n)
    (cond ((zero? m) #f)
          ((zero? n) #t)
          (else (> (sub1 m) (sub1 n))))))

(define <
  (λ (m n)
    (cond ((zero? n) #f)
          ((zero? m) #t)
          (else (< (sub1 m) (sub1 n))))))

(define =
  (λ (m n)
    (cond ((> m n) #f)
          ((< m n) #f)
          (else #t))))

(define ↑
  (λ (m n)
    (if (zero? n)
        1
        (× m (↑ m (sub1 n))))))

(define ÷
  (λ (m n)
    (if (< m n)
        0
        (add1 (÷ (sub m n) n)))))

(define length
  (λ (lat)
    (if (null? lat)
        0
        (add1 (length (cdr lat))))))

(define pick
  (λ (n lat)
    (if (zero? (sub1 n))
        (car lat)
        (pick (sub1 n) (cdr lat)))))

(define rempick
  (λ (n lat)
    (if (zero? (sub1 n))
        (cdr lat)
        (cons (car lat)
              (rempick (sub1 n) (cdr lat))))))

(define no-nums
  (λ (lat)
    (cond
      ((null? lat) '())
      ((number? (car lat)) (no-nums (cdr lat)))
      (else (cons (car lat) (no-nums (cdr lat)))))))

(define all-nums
  (λ (lat)
    (cond
      ((null? lat) '())
      ((number? (car lat)) (cons (car lat) (all-nums (cdr lat))) )
      (else (all-nums (cdr lat))))))

(define eqan?
  (λ (a1 a2)
    (cond ((and (number? a1) (number? a2)) (= a1 a2))
          ((or (number? a1) (number? a2)) #f)
          (else (eq? a1 a2)))))

(define occur
  (λ (a lat)
    (cond ((null? lat) 0)
          ((eqan? a (car lat)) (add1 (occur a (cdr lat))))
          (else (occur a (cdr lat))))))

(define rember*
  (λ (a l)
    (if (null? l) '()
        (if (pair? (car l))
            (cons (rember* a (car l)) (rember* a (cdr l)))
            (if (eqan? a (car l))
                (rember* a (cdr l))
                (cons (car l) (rember* a (cdr l))))))))


(define insertR*
  (λ (new old l)
    (if (null? l) '()
        (if (pair? (car l))
            (cons (insertR* new old (car l)) (insertR* new old (cdr l)))
            (if (eqan? old (car l))
                (cons old (cons new (insertR* new old (cdr l))))
                (cons (car l) (insertR* new old (cdr l))))))))


(define occur*
  (λ (a l)
    (if (null? l)
        0
        (if (pair? (car l))
            (add (occur* a (car l)) (occur* a (cdr l)))
            (if (eqan? a (car l))
                (add1 (occur* a (cdr l)))
                (occur* a (cdr l)))))))

(define subst*
  (λ (new old l)
    (if (null? l)
        '()
        (if (pair? (car l))
            (cons (subst* new old (car l)) (subst* new old (cdr l)))
            (if (eqan? old (car l))
                (cons new (subst* new old (cdr l)))
                (cons (car l) (subst* new old (cdr l))))))))

(define insertL*
  (λ (new old l)
    (if (null? l)
        '()
        (if (pair? (car l))
            (cons (insertL* new old (car l)) (insertL* new old (cdr l)))
            (if (eqan? old (car l))
                (cons new (cons old (insertL* new old (cdr l))))
                (cons (car l) (insertL* new old (cdr l))))))))

(define member*
  (λ (a l)
    (and (not (null? l))
         (if (pair? (car l))
             (or (member* a (car l)) (member* a (cdr l)))
             (or (eqan? a (car l)) (member* a (cdr l)))))))

(define leftmost
  (λ (l)
    (if (null? l)
        '()
        (if (pair? (car l))
            (leftmost (car l))
            (car l)))))

(define eqlist?
  (λ (m n)
    (cond
      ((and (null? m) (null? n)) true)
      ((or (null? m) (null? n)) false)
      ((and (pair? m) (pair? n))
       (and (eqlist? (car m) (car n))
            (eqlist? (cdr m) (cdr n))))
      ((or (pair? m) (pair? n)) false)
      (else (eqan? m n)))
    ))

(define equal?
  (λ (m n)
    (cond
      ((and (pair? m) (pair? n)) (eqlist? m n))
      ((or (pair? m) (pair? n)) false)
      (else (eqan? m n)))))



(define numbered?
  (λ (aexp)
    (cond
      ((atom? aexp) (number? aexp))
      ((or (equal? (car (cdr aexp)) '+)
           (equal? (car (cdr aexp)) '-)
           (equal? (car (cdr aexp)) '*)
           (equal? (car (cdr aexp)) '/))
       (and (numbered? (car aexp))
            (numbered? (car (cdr (cdr aexp))))))
      (else false))))
       
(define assert
  (λ (a . b)
    (let ((wanted (if (null? b) #t  (car b))))
      (if (eq? a wanted)
          (display "")
          "fail"))))

(assert (atom? 'a))
(assert (atom? 1))
(assert (atom? "atom"))
(assert (atom? #t))
(assert (atom? '()) #f)
(assert (atom? (cons 1 2)) #f)
(assert (atom? (list 1 2 3)) #f)

(assert (lat? '(a b c)))
;(lat2? '(a b c))
(assert (lat? '(a '(b) c)) #f)
;(lat2? '(a '(b) c))
(assert (lat? '()))
;(lat2? '())
(assert (lat? 'a) #f)
;(lat2? 'a)

(assert (member? 'world '(hello world bye good night)))
(assert (member? 1 '(hello world bye good night)) #f)

(rember 'mint '(lamb chops and mint jelly))
(rember 'mint '(lamb chops and mint flavored mint jelly))
(rember 'toast '(bacon lettuce and tomato))
(rember 'cup '(coffee cup tea cup and hick cup))


;(assert (rember* 'sauce '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce)))
;        '(((tomato)) ((bean)) (and ((flying)))))
;(rember* 'sauce '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce)))

;(insertR* 'roast 'chuck '((how much (wood)) could ((a (wood) chuck)) (((chuck))) (if (a) ((wood chuck))) could chuck wood))

;(subst* 'orange 'banana '((banana) (split (((( banana ice))) (cream ( banana)) sherbet)) (banana) (bread) (banana brandy)))

;(insertL* 'pecker 'chuck '((how much (wood)) could ((a (wood) chuck )) ((( chuck ))) (if (a ) ((wood chuck))) could chuck wood))

;(member* 'chips '((potato) (chips ((with ) fish )(chips))))