Chapter 5 - *Oh My Gawd*: It’s Full of Stars#
1996 Friedman, Daniel P. & Matthias Felleisen. The Little Schemer. 4e. MIT Press.
; removes each occurrence of the given atom from a list
(define rember*
(lambda (a l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) a) (rember* a (cdr l)) )
( else (cons (car l) (rember* a (cdr l))) )) )
( else (cons (rember* a (car l)) (rember* a (cdr l))) ))))
; inserts the given atom to the right of each occurrence of a specified atom in a list
(define insertR*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (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))) ))))
; gets the number of times the given atom occurs in a list
(define occur*
(lambda (a l)
(cond
( (null? l) 0 )
( (atom? (car l)) (cond
( (eq? (car l) a) (add1 (occur* a (cdr l))) )
( else (occur* a (cdr l)) )) )
( else (o+ (occur* a (car l)) (occur* a (cdr l))) ))))
; substitutes the given atom for each occurrence of a specified atom in a list
(define subst*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (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))) ))))
; inserts the given atom to the left of each occurrence of a specified atom in a list
(define insertL*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (cons new (cons old (insertL* new old (cdr l)))) )
( else (cons (car l) (insertL* new old (cdr l))) )) )
( else (cons (insertL* new old (car l)) (insertL* new old (cdr l))) ))))
; determines whether the given atom is a member of the list
(define member*
(lambda (a l)
(cond
( (null? l) #f )
( (atom? (car l)) (or (eq? (car l) a) (member* a (cdr l))) )
( else (or (member* a (car l)) (member* a (cdr l))) ))))
; determines the leftmost atom in a list
(define leftmost
(lambda (l)
(cond
( (atom? (car l)) (car l) )
( else (leftmost (car l)) ))))
; determines whether two lists are equivalent
(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)))
(and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) )
( (or (atom? (car l1)) (atom? (car l2))) #f )
( else (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) ))))
; determines whether two S-expressions are equivalent
(define equal
(lambda (s1 s2)
(cond
( (and? (atom? s1) (atom? s2)) (eqan? s1 s2) )
( (or? (atom? s1) (atom? s2)) #f )
( else (eqlist? s1 s2) ))))
(define eqlist?
(lambda (l1 l2)
(cond
( (and (null? l1) (null? l2)) #t )
( (or (null? l1) (null? l2)) #f )
( else (and (equal? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2))) ))))
; removes the first occurrence of the specified S-expression from a list of S-expressions
(define rember
(lambda (s l)
(cond
( (null? l) '() )
( (equal? (car l) s) (cdr l) )
( else (cons (car l) (rember s (cdr l))) )) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Chapter 5 - *Oh My Gawd*: It's Full of Stars
; rember-star
; remove all occurrences of the given atom from a list
; inputs: atom, list
; output: list
(define rember*
(lambda (a l)
(cond
( (null? l) '() ) ; Is the list empty? If so, then return the empty list.
( (atom? (car l)) (cond ; else - Is the S-expression an atom? Is so, then test for equality.
( (eq? (car l) a) (rember* a (cdr l)) ) ; Equal? If so, then remove the occurrence of the atom and recur on cdr.
( else (cons (car l) (rember* a (cdr l))) )) ) ; else - cons the occurrence of the atom and recur on cdr.
( else (cons (rember* a (car l)) (rember* a (cdr l))) )))) ; else - cons the recurrence on car to the recurrence on cdr
; ^^^^ constructor of lists
; ^^^^^^^^^^^^^^^^^^^ natural recursion, on car l
; ^^^^^^^^^^^^^^^^^^^ natural recursion, on cdr l
(rember* 'cup '((coffee) cup ((tea) cup) (and (hick)) cup)) ; ((coffee) ((tea)) (and (hick)))
(rember* 'sauce '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce))) ; (((tomato)) ((bean)) (and ((flying))))
(lat? '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce))) ; #f
(atom? (car '(((tomato sauce)) ((bean) sauce) (and ((flying)) sauce)))) ; #f
; insertR*
; insert an atom to the right of each occurrence of the given atom in a list
; inputs: new [atom], old [atom], l [list]
; output: list
(define insertR*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (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))) ))))
(insertR* 'roast 'chuck '((how much (wood)) could ((a (wood) chuck)) (((chuck))) (if (a) ((wood chuck))) could chuck wood))
; ((how much (wood)) could ((a (wood) chuck roast)) (((chuck roast))) (if (a) ((wood chuck roast))) could chuck roast wood)
; The First Commandment (final)
; When recurring on a list of atoms, lat, ask two questions about it: (null? lat) and else.
; When recurring on a list of S-expressions, l, ask three questions about it: (null? l), (atom? (car l)), and else
;
; All *-functions ask three questions and recur with the car as well as with the cdr, whenever the car is a list.
; This is because all *-functions work on lists that are either empty, an atom consed onto a list, or a list consed onto a list.
;
; The Fourth Commandment (final)
; Always change at least one argument while recurring.
; When recurring on a list of atoms, lat, use (cdr lat).
; When recurring on a number, n, use (sub1 n).
; And when recurring on a list of S-expressions, l, use (car l) and (cdr l) if neither (null? l) nor (atom? (car l)) are true.
; It must be changed to be closer to termination.
; The changing argument must be tested in the termination condition:
; when using cdr, test termination with null? and
; when using sub1, test termination with zero?
; occur*
; get the number of occurrences of the given atom in the list
; inputs: a [atom], l [list]
; output: number
(define occur*
(lambda (a l)
(cond
( (null? l) 0 )
( (atom? (car l)) (cond
( (eq? (car l) a) (add1 (occur* a (cdr l))) )
( else (occur* a (cdr l)) )) )
( else (o+ (occur* a (car l)) (occur* a (cdr l))) ))))
(occur* 'banana '((banana) (split ((((banana ice))) (cream (banana)) sherbert)) (banana) (bread) (banana brandy))) ; 5
; subst*
; inputs: new [atom], old [atom], l [list]
; output: list
(define subst*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (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))) ))))
(subst* 'orange 'banana '((banana) (split ((((banana ice))) (cream (banana)) sherbert)) (banana) (bread) (banana brandy)))
; ((orange) (split ((((orange ice))) (cream (orange)) sherbert)) (orange) (bread) (orange brandy))
; insertL*
; insert an atom to the left of each occurrence of the given atom in a list
; inputs: new [atom], old [atom], l [list]
; output: list
(define insertL*
(lambda (new old l)
(cond
( (null? l) '() )
( (atom? (car l)) (cond
( (eq? (car l) old) (cons new (cons old (insertL* new old (cdr l)))) )
( else (cons (car l) (insertL* new old (cdr l))) )) )
( else (cons (insertL* new old (car l)) (insertL* new old (cdr l))) ))))
(insertL* 'pecker 'chuck '((how much (wood)) could ((a (wood) chuck)) (((chuck))) (if (a) ((wood chuck))) could chuck wood))
; ((how much (wood)) could ((a (wood) pecker chuck)) (((pecker chuck))) (if (a) ((wood pecker chuck))) could pecker chuck wood)
; member*
; inputs: a [atom], l [list]
; output: bool
(define member*
(lambda (a l)
(cond
( (null? l) #f )
( (atom? (car l)) (or (eq? (car l) a) (member* a (cdr l))) )
( else (or (member* a (car l)) (member* a (cdr l))) ))))
(member* 'chips '((potato) (chips ((with) fish) (chips)))) ; #t
; ^^^^^
; leftmost
; get the leftmost atom in a non-empty list of S-expressions that does not contain the empty list
(define leftmost
(lambda (l)
(cond
( (atom? (car l)) (car l) )
( else (leftmost (car l)) ))))
(leftmost '((potato) (chips ((with) fish) (chips)))) ; potato
(leftmost '(((hot) (tuna (and))) cheese)) ; hot
;(leftmost '(((() four)) 17 (seventeen))) ; no answer
;(leftmost '()) ; no answer
(and (atom? (car '(mozzarella pizza))) (eq? (car '(mozzarella pizza)) 'pizza)) ; #f
(and (atom? (car '((mozzarella mushroom) pizza))) (eq? (car '((mozzarella mushroom) pizza)) 'pizza)) ; #f
(and (atom? (car '(pizza (tastes good)))) (eq? (car '(pizza (tastes good))) 'pizza)) ; #t
; (or ...) asks questions one at a time until it finds on that is true.
; Then (or ...) stops, making its value true.
; If it cannot find a true argument, the value of (or ...) is false.
;
; (and ...) asks questions one at a time until it finds on whose value is false.
; Then (and ...) stops, making its value false.
; If none of the expressions are false, (and ...) is true.
;
; It's possible that one of the arguments of (and ...) and (or ...) is not considered
; because (and ...) stops if the first argument has the value #f
; and (or ...) stops if the first argument has the value #t
; (cond ...) also has the property of not considering all of its arguments.
; Because of this property, however, neither (and ...) nor (or ...) can be defined as functions in terms of (cond ...),
; though both (and ...) and (or ...) can be expressed as abbreviations of (cond ...)-expressions:
; (and α β) = (cond (α β) (else #f))
; (or α β) = (cond (α #t) (else β))
; eqlist
; determine whether two lists are equal
;
; each argument may be either empty, an atom consed onto a list, or a list consed onto a list
; 1) empty, empty
; 2) empty, atom consed onto a list
; 3) empty, list consed onto a list
; 4) atom consed onto a list, empty
; 5) atom consed onto a list, atom consed onto a list
; 6) atom consed onto a list, list consed onto a list
; 7) list consed onto a list, empty
; 8) list consed onto a list, atom consed onto a list
; 9) list consed onto a list, list consed onto a list
;
; (define eqlist?
; (lambda (l1 l2)
; (cond
; ( (and (null? l1) (null? l2)) #t ) ; (1) The are both empty.
; ( (and (null? l1) (atom? (car l2))) #f ) ; (2)
; ( (null? l1) #f ) ; (3)
; ( (and (atom? (car l1)) (null? l2)) #f ) ; (4)
; ( (and (atom? (car l1)) (atom? (car l2))) ; (5) They are both atoms.
; (and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) ) ; If they are the same atom, then recur on cdr.
; ( (atom? (car l1)) #f ) ; (6)
; ( (null? l2) #f ) ; (7)
; ( (atom? (car l2)) #f ) ; (8)
; ( else (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) )))) ; (9) They are both lists. Recur on both car and cdr.
;
(define eqlist?
(lambda (l1 l2)
(cond
( (and (null? l1) (null? l2)) #t ) ; (1) The are both empty.
( (or (null? l1) (null? l2)) #f )
( (and (atom? (car l1)) (atom? (car l2))) ; (5) They are both atoms.
(and (eqan? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) ) ; If they are the same atom, then recur on cdr.
( (or (atom? (car l1)) (atom? (car l2))) #f )
( else (and (eqlist? (car l1) (car l2)) (eqlist? (cdr l1) (cdr l2))) )))) ; (9) They are both lists. Recur on both car and cdr.
(eqlist? '(strawberry ice cream) '(strawberry ice cream)) ; #t
(eqlist? '(strawberry ice cream) '(strawberry cream ice)) ; #f
(eqlist? '(banana ((split))) '((banana) (split))) ; #f
(eqlist? '(beef ((sausage)) (and (soda))) '(beef ((salami)) (and (soda)))) ; #f
(eqlist? '(beef ((sausage)) (and (soda))) '(beef ((sausage)) (and (soda)))) ; #t
; S-EXPRESSION
; an atom or a possibly empty list of S-expressions
; equal
; determines whether two S-expressions are equivalent
; inputs: s1 [S-expression], s2 [S-expression]
; output: bool
;
; (1) atom, atom
; (2) atom, list
; (3) list, atom
; (4) list, list
;
; (define equal
; (lambda (s1 s2)
; (cond
; ( (and? (atom? s1) (atom? s2)) (eqan? s1 s2) )
; ( (atom? s1) #f )
; ( (atom? s2) #f )
; ( else (eqlist? s1 s2) ))))
;
(define equal
(lambda (s1 s2)
(cond
( (and? (atom? s1) (atom? s2)) (eqan? s1 s2) )
( (or? (atom? s1) (atom? s2)) #f )
( else (eqlist? s1 s2) ))))
(define eqlist?
(lambda (l1 l2)
(cond
( (and (null? l1) (null? l2)) #t )
( (or (null? l1) (null? l2)) #f )
( else (and (equal? (car l1) (car l2))
(eqlist? (cdr l1) (cdr l2))) ))))
; The Sixth Commandment
; Simplify only after the function is correct.
; old rember
; removes the first matching atom from a lat
; inputs: a [atom], lat [lat]
; output: lat
;
; (define rember
; (lambda (a lat)
; (cond
; ( (null? lat) '() )
; ( (eq? (car lat) a) (cdr lat) )
; ( else (cons (car lat) (rember a (cdr lat))) ))))
;
; rember
; removes the first matching S-expression from a list of S-expressions
; inputs: s [S-expression], l [list]
; output: l [list]
;
; (define rember
; (lambda (s l)
; (cond
; ( (null? l) '() )
; ( (atom? (carl l)) (cond
; ( (equal? (car l) s) (cdr l) )
; ( else (cons (car l) (rember s (cdr l))) )) )
; ( else (cond
; ( (equal? (car l) s) (cdr l) )
; ( else (cons (car l) (rember s (cdr l))) )) ))))
;
; (define rember
; (lambda (s l)
; (cond
; ( (null? l) '() )
; ( else (cond
; ( (equal? (car l) s) (cdr l) )
; ( else (cons (car l) (rember s (cdr l))) )) ))))
;
(define rember
(lambda (s l)
(cond
( (null? l) '() )
( (equal? (car l) s) (cdr l) )
( else (cons (car l) (rember s (cdr l))) )) ))