Lot of exercises from "The Little Schemer"

all.scm

#lang scheme
(define atom? (let ((f1 pair?) (f2 not)) (lambda (x) (f2 (f1 x)))))

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

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

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

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

(define numbered?
  (lambda (aexp)
    (cond
      ((atom? aexp) (number? aexp))
      ((eq? (car (cdr aexp)) '+ ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) '- ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) 'x ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) '^ ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      (else #f )
      )))

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

; prefix notation
(define value1
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp)
      ((eq? (car aexp) '+ ) (+ (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      ((eq? (car aexp) '- ) (- (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      ((eq? (car aexp) 'x ) (* (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      (else (expt (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      )))

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

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

(define operator 
  (lambda (aexp)
    (car aexp)))

(define value2
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp )
      ((eq? (operator aexp) '+ ) (+ (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      ((eq? (operator aexp) '- ) (- (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      ((eq? (operator aexp) 'x ) (* (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      (else (expt (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      )))


; use () instead of numbers
(define sero?
  (lambda (n)
    (null? n)))

(define edd1
  (lambda (n)
    (cons '() n)))

(define zub1
  (lambda (n)
    (cdr n)))

(define plusp 
  (lambda (x y)
    (cond
      ((sero? y) x)
      (else (plusp (edd1 x) (zub1 y)))
      )))

; Chapter 7

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

;makeset with multirember
(define makeset-mr
  (lambda (lat)
    (cond
      ((null? lat) '())
      (else (cons (car lat) (makeset (multirember (car lat) (cdr lat)))))
    )))


(define subset
  (lambda (s1 s2)
    (cond
      ((null? s1) #t)
      (else (and (member? (car s1) s2) (subset (cdr s1) s2)))
      )))

(define eqset
  (lambda (s1 s2) (and (subset s1 s2) (subset s2 s1))))

(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 intersect-all
  (lambda (l-set)
    (cond 
      ((null? (cdr l-set)) (car l-set))
      (else (intersect (car l-set)(intersect-all (cdr l-set))))
      )))


(define a-pair?
  (lambda (p)
    (cond
      ((null? p) #f)
      ((null? (cdr p)) #f)
      ((null? (cdr (cdr p))) #t)
      (else #f)
       )))

(define first
  (lambda p
    (car p)))

(define second
  (lambda p
    (car (cdr p))))


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

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

(define seqR
  (lambda (new old lst)
    (cons old (cons new lst))
    ))

(define seqL
  (lambda (new old lst)
    (cons new (cons old lst))
    ))

(define insert-g
  (lambda (build)
    (lambda (test?)
      (lambda (new old l)
        (cond 
          ((null? l) '())
          ((test? (car l) old) (build new old (cdr l)))
          (else (cons (car l) (((insert-g build) test?) new old (cdr l))))
          )))))

(define insert-L (insert-g seqL))
(define insert-L-eq (insert-L eq?))


(define insert-L1 (insert-g (lambda (new old lst) ( cons new (cons old lst)))))

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

(define subst1 (insert-g ( lambda (new old lst) (cons new (cdr lst)) )))


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

(define value3
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp )
      (else ((atom-to-function (operator aexp))  (value3 (1st-sub-exp aexp)) (value3 (2nd-sub-exp aexp))))
      )))

(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 eq-tuna? (eq?-c 'tuna))

(define multiremberT
  (lambda (test-k?)
    (lambda (lat)
      (cond
        ((null? lat) '())
        ((test-k? (car lat)) ((multiremberT test-k?) (cdr lat)))
        ( else (cons (car lat) ((multiremberT test-k?) (cdr lat))))
       ))))