little_schemer.scm

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

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

(define member?
  (lambda ( a lat)
    (cond
     ((null? lat) #f)
     (else (or (eq? a (car lat)) 
	       (member? a (cdr lat)))))))


(define factorial
  (lambda (n)
    (cond
     ((eq? n 0) 1)
     (else (* n (factorial (- n 1)))))))

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

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

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

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

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

(define add1
  (lambda (n)
    (+ n 1)))

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

(define o+
  (lambda (a b)
    (cond
     ((zero? b) a)
     (else
      (add1 (o+ a
		(sub1 b)))))))
(define o-
  (lambda (a b)
    (cond
     ((zero? b) a)
     (else
      (sub1 (o- a 
		(sub1 b)))))))

(define addtup
  (lambda (tup)
    (cond
     ((null? tup) 0)
     (else
      (+ (car tup) (addtup 
		  (cdr tup)))))))

(define o*
  (lambda (a b)
    (cond
     ((zero? b) 0)
     (else
      (+ a 
	 (o* a
	     (sub1 b)))))))

(define tup+
  (lambda (tupa tupb)
    (cond
     ((null? tupa) tupb)
     ((null? tupb) tupa)
     (else              
      (cons (+ (car tupa) (car tupb))
	    (tup+ (cdr tupa) (cdr tupb)))))))

(define >
  (lambda (a b)
    (cond
     ((zero? a) #f)
     ((zero? b) #t)
     (else
      (> (sub1 a) (sub1 b))))))


(define <
  (lambda (a b)
    (cond
     ((zero? b) #f)
     ((zero? a) #t)
     (else
      (< (sub1 a) (sub1 b))))))

(define =
  (lambda (a b)
    (cond
     ((< a b) #f)
     ((> a b) #f)
     (else
      #t))))

(define expt
  (lambda (a b)
    (cond
    ((zero? b) 1)
    (else
     (* a (expt a (sub1 b)))))))

(define quotient
  (lambda (a b)
    (cond
     ((< a b) 0)
     (else
      (add1 (quotient (- a b) b))))))

(define length
  (lambda (lat)
    (cond
     ((null? lat) 0)
     (else
      (add1 (length (cdr lat)))))))

(define pick
  (lambda (n lat)
    (cond
     ((zero? (sub1 n)) (car lat))
     (else
      (pick (sub1 n) (cdr lat))))))

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

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

(define eqan?
  (lambda (a b)
    (cond
     ((and (number? a) (number? b)) (= a b))
     ((or (number? a) (number? b)) #f)
     (else
      (eq? a b)))))
    
(define occur
  (lambda (a lat)
    (cond
     ((null? lat) 0)
     ((eq? a (car lat)) (add1 (occur a (cdr lat))))
     (else
      (occur a (cdr lat))))))

(define one
  (lambda (n)
    (= n 1)))
 
(define rember*
  (lambda (a l)
    (cond
     ((null? l) '())
      ((atom? (car l))
       (cond
	((eq? a (car l)) (rember* a (cdr l)))
	(else
	 (cons (car l) (rember* a (cdr l))))))
      (else
       (cons (rember* a (car l))
	     (rember* a (cdr l)))))))

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

(define occur*
  (lambda (a l)
    (cond
     ((null? l) 0)
     ((atom? (car l))
      (cond
       ((eq? a (car l)) (add1 (occur* a (cdr l))))
       (else
	(occur* a (cdr l)))))
     (else
      (+ (occur* a (car l))
	 (occur* a (cdr l)))))))

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

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


(define leftmost
  (lambda (l)
    (cond
     ((null? l) '())
     ((atom? (car l)) (car l))
     (else
      (leftmost (car l))))))

(define eqlist?
  (lambda (a b)
    (cond
     ((or (null? a) (null? b))
      (and (null? a) (null? b)))
     ((or (atom? (car a)) (atom? (car b)))
      (cond
       ((and (atom? (car a)) (atom? (car b))) 
	(and (eqan? (car a) (car b))(eqlist? (cdr a) (cdr b))))
       (else
	#f)))
     (else
      (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b)))))))



(define equal?
  (lambda (a b)
    (cond
     ((and (atom? a) (atom? b))
      (eqan? a b))
     ((or (atom? a) (atom? b)) #f)
     (else
      (eqlist? a b)))))

(define eqlist?
  (lambda (a b)
    (cond
     ((or (null? a) (null? b))
      (and (null? a) (null? b)))
     (else
      (and (equal? (car a) (car b)) (eqlist? (cdr a) (cdr b)))))))

(define rember
  (lambda (s l)
    (cond
     ((null? l) '())
     ((equal? s (car l)) (cdr l))
     (else
      (cons (car l)
	    (rember s (cdr l)))))))


(define numbered?
  (lambda (l)
    (cond
    ((atom? l) (number? l))
    ((oper? (car (cdr l)))
     (and (numbered? (car l)) (numbered? (car (cdr (cdr l))))))
    (else
     #f))))

(define oper?
  (lambda (a)
     (or (eq? a '+) (eq? a '-) (eq? a '*) (eq? a '/))))


(define value
  (lambda (ex)
    (cond
     ((atom? ex) ex)
     ((eq? (car (cdr ex)) '+)
      (+ (value (car ex)) (value (car (cdr (cdr ex))))))
     ((eq? (car (cdr ex)) '-)
      (- (value (car ex)) (value (car (cdr (cdr ex))))))
     (else
      (* (value (car ex)) (value (car (cdr (cdr ex))))))

(define value
  (lambda (ex)
    (cond
     ((atom? ex) ex)
     ((eq? (car ex) '+)
      (+ (value (car (cdr ex)) (value (car (cdr (cdr ex)))))))
     ((eq? (car ex) '-)
      (- (value (car (cdr ex)) (value (car (cdr (cdr ex)))))))
     (else
      (* (value (car (cdr ex)) (value (car (cdr (cdr ex))))))))))

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

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

(define oper
  (lambda (ex)
    (car ex)))

(define value
  (lambda (ex)
    (cond
     ((atom? ex) ex)
     ((eq? (oper ex) '+)
      (+ (value (1st-sub-exp ex)) (value (2nd-sub-exp ex))))
     ((eq? (oper ex) '-)
      (- (value (1st-sub-exp ex)) (value (2nd-sub-exp ex))))
     (else
      (* (value (1st-sub-exp ex)) (value (2nd-sub-exp ex)))))))


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

(define oper
  (lambda (ex)
    (car (cdr ex))))

(define value
  (lambda (ex)
    (cond
     ((atom? ex) ex)
     ((eq? (oper ex) '+)
      (+ (value (1st-sub-exp ex)) (value (2nd-sub-exp ex))))
     ((eq? (oper ex) '-)
      (- (value (1st-sub-exp ex)) (value (2nd-sub-exp ex))))
     (else
      (* (value (1st-sub-exp ex)) (value (2nd-sub-exp ex)))))))

(define zero?
  (lambda (x)
    (null? x)))

(define add1
  (lambda (x)
    (cons '() x)))

(define sub1
  (lambda (x)
    (cdr x)))

(define o+
  (lambda (a b)
    (cond
     ((zero? b) a)
     (else
      (o+ (add1 a) (sub1 b))))))

(define o+
  (lambda (a b)
    (cond
     ((zero? b) a)
     (else
      (add1 (o+ a (sub1 b)))))))

(define member?
  (lambda (a lat)
    (cond
     ((null? lat) #f)
     (else
      (or (equal? a (car lat)) (member? a (cdr lat)))))))

(define set?
  (lambda (lat)
    (cond
     ((null? lat) #t)
     ((member? (car lat) (cdr lat)) #f)
     (else
      (set? (cdr lat))))))

(define makeset
  (lambda (lat)
    (cond
     ((null? lat) '())
     ((member? (car lat) (cdr lat)) (makeset (cdr lat)))
     (else
      (cons (car lat) (makeset (cdr lat)))))))

(define multirember
  (lambda (a lat)
    (cond
     ((null? lat) '())
     ((equal? a (car lat)) (multirember a (cdr lat)))
     (else
      (cons (car lat) (multirember a (cdr lat)))))))

(define makeset
  (lambda (lat)
    (cond
     ((null? lat) '())
     (else
      (cons (car lat)
	    (makeset (multirember
		      (car lat)
		      (cdr lat))))))))

(define subset?
  (lambda (set1 set2)
    (cond
     ((null? set1) #t)
     (else
      (and (member? (car set1) set2) 
	   (subset? (cdr set1) set2))))))

(define remove
  (lambda (a set)
    (cond
     ((null? set) '())
     ((equal? a (car set)) (cdr set))
     (else
      (cons (car set) (remove a (cdr set)))))))

(define eqset?
  (lambda (set1 set2)
    (cond
     ((or (null? set1) (null? set2))
      (and (null? set1) (null? set2)))
     (else
      (and
      (member? (car set1) set2)
      (eqset? (cdr set1) (remove (car set1) set2)))))))

(define eqset?
  (lambda (set1 set2)
    (and (subset? set1 set2)
	 (subset? set2 set1))))

(define intersect?
  (lambda (set1 set2)
    (cond
     ((null? set1) #f)
     (else
      (or (member? (car set1) set2)
	  (intersect? (cdr set1) set2))))))

(define intersect
  (lambda (set1 set2)
    (cond
     ((null? set1) '())
     ((member? (car set1) set2)
      (cons (car set1) (intersect (cdr set1) set2)))
     (else
      (intersect (cdr set1) set2)))))
   

(define union
  (lambda (set1 set2)
    (cond
     ((null? set1) set2)
     ((member? (car set1) set2)
      (union (cdr set1) set2))
     (else
      (cons (car set1) (union (cdr set1) set2))))))

(define difference
  (lambda (set1 set2)
    (cond
     ((null? set1) '())
     ((member? (car set1) set2)
      (difference (cdr set1) set2))
     (else
      (cons (car set1) (difference (cdr set1) set2))))))

(define intersectall
  (lambda (lat)
    (cond
     ((null? (cdr lat)) (car lat))
     (else
      (intersect (car lat)
		 (intersectall (cdr lat)))))))

(define a-pair?
  (lambda (lat)
    (cond
     ((or (atom? lat) (null? lat) (null? (cdr lat))) #f)
     (else
      (null? (cdr (cdr lat)))))))

(define first
  (lambda (lat)
    (car lat)))

(define second
  (lambda (lat)
    (car (cdr lat))))

(define third
  (lambda (lat)
    (car (cdr (cdr lat)))))

(define build
  (lambda (s1 s2)
    (cons s1 (cons s2 '()))))

(define fun?
  (lambda (rel)
    (set? (firsts rel))))

(define insertLast
  (lambda (l a)
    (cond
     ((null? l) (cons a '()))
     (else
      (cons (car l) (insertLast (cdr l) a))))))

(define rev
  (lambda (lat)
    (cond
     ((null? (cdr lat)) (cons (car lat) '()))
     (else
      (insertlast (rev (cdr lat)) (car lat))))))

(define revrel
  (lambda (l)
    (cond
     ((null? l) '())
     (else
      (cons (rev (car l)) 
	    (revrel (cdr l)))))))

(define revrel
  (lambda (l)
    (cond 
     ((null? l) '())
     (else
      (cons (build (second (car l))
		   (first (car l)))
	    (revrel (cdr l)))))))

(define revpair
  (lambda (pair)
    (build (second pair) 
		 (first pair))))

(define revrel
  (lambda (l)
    (cond 
     ((null? l) '())
     (else
      (cons (revpair (car l))
	    (revrel (cdr l)))))))

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

(define fullfun?
  (lambda (l)
    (set? (seconds l))))

(define one-to-one?
  (lambda (fun)
    (fun? (revrel fun))))

;; break

(define cookies
  (lambda ()
    (bake
     '(350 degrees)
     '(12 minutes)
     (mix
      '(walnuts 1 cup)
      '(chocalte-chips 16 ounces)
      (mix
       (mix
	'(flour 2 cups)
	'(oatmeal 2 cups)
	'(salt 5 teaspon)
	'(baking-powder 1 teaspon)
	'(baking-soda 1 teaspon))
       (mix
	'(egg 2 large)
	'(vanilla 1 teaspon)
	(cream
	 '(butter 1 cup)
	 '(sugar 1 cups))))))))


(define remberf
  (lambda (test? s l)
    (cond
     ((null? l) '())
     ((test? s (car l)) (cdr l))
     (else
      (cons (car l)
	    (remberf test? s (cdr l)))))))

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? a x))))

(define eq?-salad
  (lambda (x)
    ((eq?-c 'salad) x)))

(define (eq?-salad x)
  ((eq?-c 'salad) x))

(define eq?-salad (eq?-c 'salad))

(define rember-f 
  (lambda (test?)
      (lambda (a lat)
	(cond
	 ((null? lat) '())
	 ((test? a (car lat)) (cdr lat))
	 (else
	  (cons (car lat)
		((rember-f test?) a (cdr lat))))))))


(define insertL-f
  (lambda (test?)
    (lambda (old new lat)
      (cond
       ((null? lat) '())
       ((test? old (car lat)) (cons new lat))
       (else
	(cons (car lat)
	      ((insertL-f test?) old new (cdr lat))))))))

(define insertR-f
  (lambda (test?)
    (lambda (old new lat)
      (cond
       ((null? lat) '())
       ((test? old (car lat)) (cons old 
				    (cons new (cdr lat))))
       (else
	(cons (car lat)
	      ((insertR-f test?) old new (cdr lat))))))))

(define insertg
  (lambda (old new lat insert)
    (cond
     ((null? lat) '())
     ((eq? old (car lat)) (insert old new lat))
     (else
      (cons (car lat)
	    (insertg old new (cdr lat) insert))))))

(define insertR
  (lambda (old new lat)
    (cons old (cons new (cdr lat)))))

;; curryed

(define insertg
  (lambda (insert)
    (lambda (old new lat)
      (cond
       ((null? lat) '())
       ((eq? old (car lat)) (insert old new lat))
       (else
	(cons (car lat)
	      ((insertg insert) old new (cdr lat))))))))

(define insertR
  (insertg 
   (lambda (old new lat)
     (cons old (cons new (cdr lat))))))

(define insertL
  (insertg
   (lambda (old new lat)
     (cons new lat))))

(define subst
  (insertg
   (lambda (old new lat)
     (cons new (cdr lat)))))

(define rember
  (lambda (a l)
    ((insertg
     (lambda (old new lat)
       (cdr lat))) a #f l)))

(define atom-to-function 
  (lambda (x)
    (cond
     ((eq? '+ x) +)
     ((eq? '- x) -)
     (else *))))


(define value
  (lambda (ex)
    (cond
     ((atom? ex) ex)
     (else
      ((atom-to-function (oper ex)) (value (1st-sub-exp ex)) 
       (value (2nd-sub-exp ex)))))))



(define multirember-f
  (lambda (test?)
    (lambda (a lat)
      (cond
       ((null? lat) '())
       ((test? a (car lat)) ((multirember-f test?) a (cdr lat)))
       (else
	(cons (car lat) ((multirember-f test?) a (cdr lat))))))))

(define multirember-eq? (multirember-f eq?))

(define multirember-t
  (lambda (test? lat)
    (cond
     ((null? lat) '())
     ((test? (car lat)) (multirember-t test? (cdr lat)))
     (else
      (cons (car lat) (multirember-t test? (cdr lat)))))))

(define eq-a (eq?-c 'a))

;; screw yourself
(define multirember&co
  (lambda (a lat col)
    (cond
     ((null? lat)
      (col '() '()))
     ((eq? a (car lat))
      (multirember&co a
		      (cdr lat)
		      (lambda (newlat seen)
			(col newlat
			     (cons (car lat)
				   seen)))))
     (else
      (multirember&co a
		      (cdr lat)
		      (lambda (newlat seen)
			(col (cons (car lat)
				   newlat)
			     seen)))))))

(define a-friend
  (lambda (x y)
    (null? y)))

(define last-friend
  (lambda (x y)
    (length x)))

(define multiinsertLR
  (lambda (new oldL oldR lat)
    (cond
     ((null? lat) '())
     ((eq? oldL (car lat))
      (cons new
	    (cons oldL
		  (multiinsertLR new oldL oldR (cdr lat)))))
     ((eq? oldR (car lat))
      (cons oldR
	    (cons new
		  (multiinsertLR new oldL oldR (cdr lat)))))
     (else
      (cons (car lat)
	    (multiinsertLR new oldL oldR (cdr lat)))))))


(define multiinsertLR&co
  (lambda (new oldL oldR lat col)
    (cond
     ((null? lat) (col '() 0 0))
     ((eq? oldL (car lat))
      (multiinsertLR&co new oldL oldR (cdr lat)
			(lambda (newlat L R)
			  (col
			   (cons new
				 (cons oldL
				       newlat))
			   (+ L 1)
			   R))))
     ((eq? oldR (car lat))
      (multiinsertLR&co new oldL oldR (cdr lat)
			(lambda (newlat L R)
			  (col
			   (cons oldR
				 (cons new
				       newlat))
			   L
			   (+ R 1)))))
     (else
      (multiinsertLR&co new oldL oldR (cdr lat)
			(lambda (newlat L R)
			  (col
			   (cons (car lat) 
				 newlat)
			   L
			   R)))))))

(define even?
  (lambda (n)
    (= (modulo n 2) 0)))


(define evens-only*
  (lambda (l)
    (cond
     ((null? l) '())
     ((atom? (car l))
      (cond
       ((even? (car l)) (cons (car l)
				(evens-only* (cdr l))))
       (else
	(evens-only* (cdr l)))))
     (else
      (cons (evens-only* (car l))
	    (evens-only* (cdr l)))))))


(define evens-only*
  (lambda (l col)
    (cond
     ((null? l) (col '() 1 0))
     ((atom? (car l))
      (cond
       ((even? (car l))
	 (evens-only* (cdr l)
		      (lambda (newlat E O)
			(col
			 (cons (car l) newlat)
			 (* (car l) E)
			 O))))
	(else
	 (evens-only* (cdr l)
		      (lambda (newlat E O)
			(col
			 newlat
			 E
			 (+ (car l) O)))))))
     (else
      (evens-only* (car l)
		   (lambda (alat aE aO)
		     (evens-only* (cdr l)
				  (lambda (blat bE bO)
				    (col (cons alat blat)
					 (* aE bE)
					 (+ aO bO))))))))))

(define last-friend
  (lambda (newl product sum)
    (cons sum
	  (cons product newl))))
     

(define looking
  (lambda (a lat)
    (keep-looking a (pick 1 lat) lat)))

(define pick
  (lambda (n lat)
    (cond
     ((eq? 1 n) (car lat))
     (else
      (pick (- n 1) (cdr lat))))))

(define no-number? 
  (lambda (n)
    (cond
     ((number? n) #f)
     (else
      #t))))

(define keep-looking 
  (lambda (a i lat)
  (cond
   ((number? i) (keep-looking a (pick i lat) lat))
   (else
    (eq? a i)))))

;; no one can catch me (perhaps you may not exist)
(define god
  (lambda (find)
    (god find)))

(define shift 
  (lambda (lat)
    (cons (car (car lat))
	  (cons
	   (cons (car (cdr (car lat))) 
		 (cdr lat))
	   '()))))

(define shift
  (lambda (pair)
    (build (first (first pair))
	   (build
	    (second (first pair))
	    (second pair)))))

(define align
  (lambda (para)
    (cond
     ((atom? para) para)
     ((a-pair? (first para))
      (align (shift para)))
     (else
      (build (first para)
	     (align (second para)))))))

(define length*
  (lambda (para)
    (cond
     ((atom? para) 1)
     (else
      (+ (length* (first para))
	 (length* (second para)))))))

(define weight*
  (lambda (para)
    (cond
     ((atom? para) 1)
     (else
      (+ (* (weight* (first para)))
	 (weight* (second para)))))))
	 

(define shuffle
  (lambda (para)
   (cond
    ((atom? para) para)
    ((a-pair? (first para))
     (shuffle (revpair para)))
    (else
     (build (first para)
	    (shuffle (second para)))))))

(define add1
  (lambda (x)
    (+ x 1)))

(define C
  (lambda (n)
    (cond
     ((one n) 1)
     ((even? n) (C (quotient n 2)))
     (else
      (C (add1 (* 3 n)))))))

(define C
  (lambda (n result)
    (cond
     ((one n) (cons 1 result))
     ((even? n) (C (quotient n 2) (cons n result)))
     (else
      (C (add1 (* 3 n)) (cons n result))))))

	     
(define A
  (lambda (n m)
    (cond
     ((zero? n) (add1 m))
     ((zero? m) (A (sub1 n) 1))
     (else
      (A (sub1 n)
	 (A n (sub1 m)))))))