From 474f620ecc069600b82c22c753c11fbe46494055 Mon Sep 17 00:00:00 2001 From: bnewbold Date: Fri, 16 Jan 2009 18:59:40 -0500 Subject: moved some files --- edwin-cheatsheet.txt | 84 --- little_schemer.scm | 1335 ------------------------------------------- other/edwin-cheatsheet.txt | 84 +++ other/little_schemer.scm | 1335 +++++++++++++++++++++++++++++++++++++++++++ other/sage-scheme-notes.txt | 9 + other/seasoned_schemer.scm | 640 +++++++++++++++++++++ other/sicm-fall08.html | 127 ++++ sage-scheme-notes.txt | 9 - seasoned_schemer.scm | 640 --------------------- sicm-fall08.html | 127 ---- to_athena.sh | 2 +- 11 files changed, 2196 insertions(+), 2196 deletions(-) delete mode 100644 edwin-cheatsheet.txt delete mode 100644 little_schemer.scm create mode 100644 other/edwin-cheatsheet.txt create mode 100644 other/little_schemer.scm create mode 100644 other/sage-scheme-notes.txt create mode 100644 other/seasoned_schemer.scm create mode 100644 other/sicm-fall08.html delete mode 100644 sage-scheme-notes.txt delete mode 100644 seasoned_schemer.scm delete mode 100644 sicm-fall08.html diff --git a/edwin-cheatsheet.txt b/edwin-cheatsheet.txt deleted file mode 100644 index 68ffd2c..0000000 --- a/edwin-cheatsheet.txt +++ /dev/null @@ -1,84 +0,0 @@ - --*-mode: Text; tab-width: 4; -*- - - EDWIN CHEAT SHEET - (keep under your pillow) - - 6.090, IAP 2005 - -Reading Edwin key combinations: - C-x Ctrl+x - M-x Alt+x - C-x, y Ctrl+x, release both, y - C-M-x Ctrl+Alt+x - -Stuff You *Need* to Know: - Starting Edwin Start Menu > MIT Scheme > Edwin - Quitting Edwin C-x, C-c - Opening a file C-x, C-f - Closing a file (aka buffer) C-x, k - Evaluate current expression C-x, C-e - (expression ending just before - insertion point) - Evaluate entire buffer - (works only on Scheme files!) M-o - -The Edwin Window and Scheme: - When you start it, the Edwin window looks like a plain text - editor. It has a large blank area for entering text, one black - line at the bottom with some information displayed (the modeline), - and a blank white line below that (the minibuffer). - - The text area - is where the file you're viewing shows up. You can edit the - file here, with the usual keys (up, down, page up, left... you - get the idea). - - The modeline - displays the name of the current buffer (file), your position - in it, and the kind of file Edwin thinks it is (text, scheme - code etc.). - - The minibuffer - is where you interact with Edwin's commands. For example, when - you press C-x, C-f to open a file, you enter the filename in - the minibuffer. - - Edwin is more than just an editor, though. It also features a - Scheme evaluator, to which it can send your code. So when you - press C-x, C-e at the end of an expression, it gets evaluated by - this evaluator (more on evaluators and evaluation in class). - - Try out the key combinations below to see what they do. Don't try - to memorize them. Your finger muscles will learn them as time goes - on :-) - -Inessential Edwin: - Editing - Marking/selecting text Go to one end of the block, press - C-space, go to the other end. You won't - see any visual indication of the - selection. - Cut C-w - Copy M-w - Paste C-y - Cut from point to end of like C-k - - Multiple Windows and Buffers - Switch buffer C-x, b - Switch window C-x, o - Split window vertically C-x, 2 - Split window horizontally C-x, 3 - Delete current split C-x, 0 - Create new frame (window) C-x, 5, 2 - Delete current frame C-x, 5, 0 - -Interactive Scheme: - When you are in the buffer called *scheme*, everything you type goes - directly to the evaluator, and the results are displayed below your - expressions. When you make an error, the evaluator gives you a set of - choices to help you debug your code. Usually, it is best to type (restart 1) - at the next prompt to abort the current evaluation, so you can go back and - examine your code to see what went wrong. For more advanced debugging tools, - talk to an LA. - diff --git a/little_schemer.scm b/little_schemer.scm deleted file mode 100644 index 8a31425..0000000 --- a/little_schemer.scm +++ /dev/null @@ -1,1335 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Play-along log to The Little Schemer by Friedman and Felleisen -; Jan 2008, bryan newbold - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Preface: define and test primative - -(define atom? - (lambda (x) - (and (not (pair? x)) (not (null? x))))) - -(atom? (quote ())) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 01: Toys - -(car '(c b a)) ; returns c -(cdr '(c b a)) ; returns '(b a) -;(car ()) ; gives an error, () is null (but is still a list) - -; [[ Law of Car ]] -; The primative car is defind only for non-empty lists. - -; [[ Law of Cdr ]] -; The primative cdr is defined only for non-empty lists. The cdr of any -; non-empty list is always another list. - -(cons 2 3) ; returns (2 . 3), though book says undefined. -(cons 'a ()) ; returns (a) - -; [[ Law of Cons ]] -; The primative cons takes two arguments. The second argument to cons must be -; a list. The result is a list. - -(null? ()) ; #t -(null? 3) ; #f -;(null? (() ())); error -;(null? ('() '())) ; error -(null? '(() ())) ; #f -(null? 'asdf) ; #f, book says undefined - -;(cdr (1)) ; error! -(cdr '(1)) ; reurns () - -; [[ Law of Null? ]] -; The primative null? is defined only for lists. - -; [[ Law of Eq? ]] -; The primative eq? takes two arguments. Each must be a non-numeric atom. - -; in practice some numbers can be eq? ? - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 02: Do It, Do It Again, and Again, and Again... - -(define lat? - (lambda (l) - (cond - ((null? l) #t) - ((atom? (car l)) (lat? (cdr l))) - (else #f)))) - -; lat = list of atoms -(lat? '(a b c d)) ; #t -(lat? '('(1 2 3) 4 5 6)) ; #f -(lat? ()) ; #t - -(define member? - (lambda (a lat) - (cond - ((null? lat) #f) - (else (or (eq? (car lat) a) - (member? a (cdr lat))))))) - -(member? 'beef '(meat and potatoes and beef)) ; #t -(member? 'tofu ()) ; #f - -; {{ The First Commandment }} -; When recurring on a list of atoms, lat, ask two questions about it: -; (null? lat) and else. -; When recurring on a number, n, ask two questions about it: (zero? n) and -; else. -; When recurring on a list of S-expressions, l, ask three questions about it: -; (null? l), (atom? (car l)), and else. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 03: Cons the Magnificent - -(define rember - (lambda (a lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) a) (cdr lat)) - (else (cons (car lat) - (rember a (cdr lat))))))) - -(rember 'and '(peanut butter and jelly)) ; (peanut butter jelly) - -; {{ The Second Commandment }} -; Use cons to build lists. - -; returns list of first elements off each list in a list of lists ;) -(define firsts - (lambda (l) - (cond - ((null? l) ()) - (else (cons (car (car l)) (firsts (cdr l))))))) - -(firsts '((a b c) (1 2 3) (j k l))) ; (a 1 j) - -; {{ The Third Commandment }} -; When building a list, describe the first typical element, and then -; cons it onto the natural recursion. - -(define insertR - (lambda (new old lat) - (cond - ((null? lat) (quote ())) - ((eq? old (car lat)) (cons (car lat) (cons new (cdr lat)))) - (else (cons (car lat) (insertR new old (cdr lat))))))) - -(insertR 'jalapeno 'and '(tacos tamales and salsa)) -; (tacos tamales and jalapeno salsa) - -(define insertL - (lambda (new old lat) - (cond - ((null? lat) (quote ())) - ((eq? old (car lat)) (cons new lat)) - (else (cons (car lat) (insertL new old (cdr lat))))))) - -(insertL 'now 'please '(do it please)) ; (do it now please) - -(define subst - (lambda (new old lat) - (cond - ((null? lat) (quote ())) - ((eq? old (car lat)) (cons new (cdr lat))) - (else (cons (car lat) (subst new old (cdr lat))))))) - -(subst 'both 'and '(meat and potatoes)) ; (meat both potatoes) - -(define subst2 - (lambda (new o1 o2 lat) - (cond - ((null? lat) (quote ())) - ((eq? o1 (car lat)) (cons new (cdr lat))) - ((eq? o2 (car lat)) (cons new (cdr lat))) - (else (cons (car lat) (subst2 new o1 o2 (cdr lat))))))) - -(subst2 'a 'q 'r '(a s d r q)) ; (a s d a q) -(subst2 'a 'q 'r '(a s q d r)) ; (a s a d r) - -(define multirember - (lambda (a lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) a) (multirember a (cdr lat))) - (else (cons (car lat) (multirember a (cdr lat))))))) - -(multirember 'd '(a d b d s g r c d d d w r)) ; (a b s g r c w r) - -; {{ The Fourth Commandment }} -; Always change at least one argument while recurring. It must be changed to -; be closer to termination. The changing argument must be tested in the -; termination condition: when using cdr, test temrination with null?. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 04: Numbers Games - -(atom? 0) ; #t -(atom? 3.123123132) ; #t -(atom? -12i) ; #t - -(define add1 - (lambda (n) - (+ n 1))) - -(add1 67) - -(define sub1 - (lambda (n) - (- n 1))) - -(sub1 0) ; -1 -(sub1 -12i) ; -1-12i -(sub1 +2i) ; -1+2i - -(zero? 2) ; #f - -; doesn't handle negatives! -(define o+ - (lambda (a b) - (cond - ((zero? b) a) - (else (o+ (add1 a) (sub1 b)))))) - -(o+ 12 3) - -(define o- - (lambda (a b) - (cond - ((zero? b) a) - (else (o- (sub1 a) (sub1 b)))))) - -(o- 12 3) ; 9 -(o- 10 25) ; -15 -;(o- 4 -1) ; infinite loop! - -(zero? ()) ; #f - -(define addtup - (lambda (tup) - (cond - ((null? tup) 0) - (else (o+ (car tup) (addtup (cdr tup))))))) - -(addtup '(1 1 1 1 1)) ; 5 -(addtup '()) ; 0 - -(define ox - (lambda (a b) - (cond - ((zero? b) 0) - (else (o+ a (ox a (sub1 b))))))) - -(ox 4 4) ; 16 -;(ox 12983761498 12983472) ; max recursion depth exceeded ;( -;(ox 39485 345) ; SLOW! - -; {{ The Fourth Commandment }} -; Always change at least one argument while recurring. 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?. - -; {{ The Fifth Commandment }} -; When building a value with +, always use 0 for the value of the terminating -; line, for adding 0 does not change the value of an addition. -; When building a value with x, always use 1 for the value of the terminating -; line, for multiplying by 1 does not change the value of a multiplication. -; When building a value with cons, always condsider () for the value of the -; terminating line. - -(define tup+ - (lambda (a b) - (cond - ((or (null? a) (null? b)) ()) - (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b))))))) -; the book uses 'and' instead of 'or' because it specifies the tups must -; be of equal length - -(tup+ '(1 2 3 4 5) '(5 4 3 2 1)) ; (6 6 6 6 6) - -; improved version -(define tup+ - (lambda (a b) - (cond - ((and (null? a) (null? b)) (quote ())) - ((null? a) b) - ((null? b) a) - (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b))))))) - -(tup+ '(1 2 3 4 5) '(5 4)) ; (6 6 3 4 5) - -(define o> - (lambda (a b) - (cond - ((zero? a) #f) - ((zero? b) #t) - (else (o> (sub1 a) (sub1 b)))))) - -(o> 5 6) ; #t -(o> 7 7) ; #f - -(define length - (lambda (lat) - (cond - ((null? lat) 0) - (else (add1 (length (cdr lat))))))) -(length '(a b c d)) ; 4 -(length (quote ())) ; 0 - -(define pick - (lambda (n lat) - (cond - ((zero? (sub1 n)) (car lat)) - (else (pick (sub1 n) (cdr lat)))))) - -(define rempick - (lambda (n lat) - (cond - ((null? lat) (quote ())) - ((zero? n) (cdr lat)) - (else (cons (car lat) (rempick (sub1 n) (cdr lat))))))) - -(rempick 3 `(this sentance has like a billion words)) - -(define no-nums - (lambda (lat) - (cond - ((null? lat) (quote ())) - ((number? (car lat)) (no-nums (cdr lat))) - (else (cons (car lat) (no-nums (cdr lat))))))) - -(no-nums '(this 1 sentance has 56 other numbers 23 built-in)) - -(define all-nums - (lambda (lat) - (cond - ((null? lat) (quote ())) - ((number? (car lat)) (cons (car lat) (all-nums (cdr lat)))) - (else (all-nums (cdr lat)))))) - -(all-nums '(this 1 sentance has 56 other numbers 23 built-in)) - -(define eqan? - (lambda (a b) - (cond - ((and (number? a) (number? b)) (= a b)) - ((or (number? a) (number? b)) #f) - (else (eq? a b))))) - -(eq? 1 1) ; #t -(eqan? 2 3) ; #f - -(define occur - (lambda (a lat) - (cond - ((null? lat) 0) - ((eq? a (car lat)) (add1 (occur a (cdr lat)))) - (else (occur a (cdr lat)))))) - -(occur 'n '(a n d that's all n folks!)) ; 2 -(occur 123 '(1 2 3 4)) ; 0 - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 05: Oh My Gawd: It's full of Stars - -(define rember* - (lambda (a l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (cond - ((eq? a (car l)) (cdr l)) - (else (cons (car l) (rember* a (cdr l)))))) - (else (cons (rember* a (car l)) (rember* a (cdr l))))))) - -(rember* 'sauce '(((tomato sauce)) - ((bean) sauce) - (and ((flying)) sauce))) - -(define insertR* - (lambda (new old l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (cond - ((eq? old (car l)) (cons (car l) (cons new (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)) - -(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)) - sherbet)) - (banana) - (bread) - (banana brandy))) - -(define subst* - (lambda (new old l) - (cond - ((null? l) (quote ())) - ((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))))))) - -(subst* 'orange 'banana '((banana) - (split ((((banana ice))) - (cream (banana)) - sherbet)) - (banana) - (bread) - (banana brandy))) - -(define insertL* - (lambda (new old l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (cond - ((eq? old (car l)) - (cons new (cons - (car l) - (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))) - (id (a) ((wood chuck))) - could chuck wood)) - -(define member* - (lambda (a l) - (cond - ((null? l) #f) - ((atom? (car l)) (cond - ((eq? a (car l)) #t) - (else (member* a (cdr l))))) - (else (or (member* a (car l)) (member* a (cdr l))))))) - -(member* 'chips '((potato (chips ((with) fish) (chips))))) ; #t -(member* 'beef '(meat ((and potatoes)) (with brocolli))) ; #f - -; list must not contain null list! -(define leftmost - (lambda (l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (car l)) - (else (leftmost (car l)))))) - -(leftmost '(((hot) (tuna (and))) cheese)) - -(define eqlist? - (lambda (a b) - (cond - ((and (null? a) (null? b)) #t) - ((or (null? a) (null? b)) #f) - ((and (atom? (car a)) (atom? (car b))) - (and (eqan? (car a) (car b)) - (and (eqlist? (cdr a) (cdr b))))) - ((or (atom? (car a)) (atom? (car b))) #f) - (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b))))))) - -(eqlist? - '(beef ((sausage)) (and (soda))) - '(beef ((sausage)) (and (soda)))) ; #t - -(eqlist? - '(beef ((sausag)) (and (soda))) - '(beef ((sausage)) (and))) ; #f - -(eqlist? '(ff (1 2) (a)) '(ff (1 2) (b))) ; #f - -(eqan? 'sausag 'sausage) ; #f - -; new definition allows removal of S-expressions -(define rember - (lambda (s l) - (cond - ((null? l) (quote ())) - ((equal? s (car l)) (cdr l)) - (else (cons (car l) (rember s (cdr l))))))) - -; these next two I just copied after the fact, didn't think I would -; need them at the time -(define equal? - (lambda (a b) - (cond - ((and (atom? a) (atom? b)) (eqan? a b)) - ((or (atom? a) (atom? b)) #f) - (else (eqlist? a b))))) - -(equal? '(this ((is more) complicated)) - '(this ((is more) complicated))) ; #t -(equal? '(this ((is more) complicated)) - '(this ((is) complicated))) ; #f -(equal? '4' '(4 5)) ; #f - -(define rember - (lambda (s l) - (cond - ((null? l) (quote ())) - ((equal? (car l) s) (cdr l)) - (else (cons (car l) (rember s (cdr l))))))) - -(rember 'q '(a b e d q)) -(rember '4 '(1 2 3 (4 5) 8)) -(rember '(4 5) '(1 2 3 (4 5) 6 7 8)) - -; {{ The Sixth Commandment }} -; Simplify only after the function is correct. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 06: Shadows - -(define numbered? - (lambda (aexp) - (cond - ((null? aexp) #f) - ((atom? aexp) (number? aexp)) - ((or (eq? (car (cdr aexp)) (quote +)) - (eq? (car (cdr aexp)) (quote -)) - (eq? (car (cdr aexp)) (quote ^))) - (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp)))))) - (else #f)))) - -(numbered? '(1 + 3)) ; #t -(numbered? '((4 ^ 3) - 4)) ; #t -(numbered? '(a + 2 + (r ^ 2))) ; #f -(numbered? '(1 _ 3 + 5 + Q)) ; #f -(numbered? '(1 + 4 ^ 8 + r)) ; #t???? should only have two expressions -(numbered? '((1 + 4) ^ (8 + r))) ; #f - -;book likes to make assumptions, namely that aexp is definately an algebraic -;expression -(define numbered? - (lambda (aexp) - (cond - ((atom? aexp) (number? aexp)) - (else (and (numbered? (car aexp)) - (numbered? (car (cdr (cdr aexp))))))))) - -(numbered? '1) -(numbered? '(1 + 1)) - - -(define value - (lambda (aexp) - (cond - ((atom? aexp) aexp) - ((eq? (car (cdr aexp)) (quote +)) (+ (value (car aexp)) - (value (car (cdr (cdr aexp)))))) - ((eq? (car (cdr aexp)) (quote -)) (- (value (car aexp)) - (value (car (cdr (cdr aexp)))))) - ((eq? (car (cdr aexp)) (quote ^)) - (expt (value (car aexp)) - (value (car (cdr (cdr aexp))))))))) - -(value '(1 + 1)) -(value '(3 ^ 3)) -(value '(5 - (2 ^ 2))) - -(define 1st-sub-exp - (lambda (aexp) - (car aexp))) - -(define 2nd-sub-exp - (lambda (aexp) - (car (cdr (cdr aexp))))) - -(define operator - (lambda (aexp) - (car (cdr aexp)))) - -; {{ The Seventh Commandment }} -; Recur on the subpart that are of the same nature: -; * on the sublists of a list. -; * on the subexpressions of an arthmetic expression. - -; {{ The Eighth Commandment }} -; Use help functions to abstract from representations. - -(define sero? - (lambda (n) - (null? n))) - -(sero? '()) ; #t -(sero? '(() ())) ; #f - -(define edd1 - (lambda (n) - (cons (quote ()) n))) - -(define zub1 - (lambda (n) - (cdr n))) - -;(define o+ -; (lambda (n m) -; (cond -; ((sero? m) n) -; (else (edd1 (o+ n (zub1 m))))))) - -;(o+ '(() ()) '(() () ())) ; (() () () () ()) - -;(lat? (() () () () ())) ; error! - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 07: Friends and Relations - -(define set? - (lambda (lat) - (cond - ((null? lat) #t) - ((member? (car lat) (cdr lat)) #f) - (else (set? (cdr lat)))))) - -(set? '(this is a sentance with no repeats)) ; #t -(set? '()) ; #t -(set? '(this is a sentance with repeats, so this is not a set)); #f - -(define makeset - (lambda (lat) - (cond - ((null? lat) (quote ())) - ((member? (car lat) (cdr lat)) (makeset (cdr lat))) - (else (cons (car lat) (makeset (cdr lat))))))) - -(makeset '(a b c b c c c d e f)) - -; is every element of the first in the second? -(define subset? - (lambda (a b) - (cond - ((null? a) #t) - ((member? (car a) b) (subset? (cdr a) b)) - (else #f)))) - -(subset? '() '(1 2 3)) ; #t -(subset? '(a b c) '(1 4 b 6 c 1 a)) ; #t -(subset? '(a b c) '(1 4 b 6 1 a)) ; #f - -(define eqset? - (lambda (a b) - (and (subset? a b) (subset? b a)))) - -(eqset? '(1 2 3 4) '(3 4 1 2)) ; #t -(eqset? '(1 2 3 4 5) '(3 4 1 2)) ; #f - -(define intersect? - (lambda (a b) - (cond - ((null? a) #f) - (else (or (member? (car a) b) (intersect? (cdr a) b)))))) - -(intersect? '(a b c) '(1 2 3)) ; #f -(intersect? '(a B c) '(1 2 3 B 5)) ; #t - -(define intersect - (lambda (a b) - (cond - ((null? a) (quote ())) - ((member? (car a) b) (cons (car a) (intersect (cdr a) b))) - (else (intersect (cdr a) b))))) - -(intersect '(a b c) '(1 2 3)) ; () -(intersect '(a b c) '(1 b c 4 5)) ; (b c) - -(define union - (lambda (a b) - (cond - ((null? a) b) - ((member? (car a) b) (union (cdr a) b)) - (else (union (cdr a) (cons (car a) b)))))) - -(union '(a b c) '(1 2 3)) -(union '(a b c) '(a b 3)) - -(define intersectall - (lambda (l-set) - (cond - ((null? (cdr l-set)) (car l-set)) - (else (intersect (car l-set) (intersectall (cdr l-set))))))) - -(intersectall '((a b c) (c a d e) (e f g h a b))) ; (a) - -(define a-pair? - (lambda (x) - (cond - ((null? x) #f) - ((atom? x) #f) - ((null? (cdr x)) #f) - ((null? (cdr (cdr x))) #t) - (else #f)))) - -(define first - (lambda (p) (car p))) - -(define second - (lambda (p) (car (cdr p)))) - -(define build - (lambda (a b) (cons a (cons b (quote ()))))) - -(define third - (lambda (p) (car (cdr (cdr p))))) - -; a rel is a relation: a list of pairs - -(firsts '((a b) (c d) (e f))) ; # (a c e), from an earlier chapter - -(define fun? - (lambda (rel) - (set? (firsts rel)))) - -(define revrel - (lambda (rel) - (cond - ((null? rel) (quote ())) - (else (cons (build (second (car rel)) (first (car rel))) - (revrel (cdr rel))))))) - -(revrel '((a b) (1 2) (here there))) - -(define revpair - (lambda (p) - (build (second p) (first p)))) - -(define revrel - (lambda (rel) - (cond - ((null? rel) (quote ())) - (else (cons (revpair (car rel)) (revrel (cdr rel))))))) - -(define fullfun? - (lambda (fun) - (set? (seconds fun)))) - -(define one-to-one? - (lambda (fun) - (fun? (revrel fun)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 08: Lambda the Ultimate - -(define rember-f - (lambda (test? a l) - (cond - ((null? l) (quote ())) - ((test? a (car l)) (rember-f test? a (cdr l))) - (else (cons (car l) (rember-f test? a (cdr l))))))) - -(rember-f equal? '(pop corn) '(lemonade (pop corn) and (cake))) - -; Currying: Moses Schonfinkel and Haskell Curry - -(define eq?-c - (lambda (a) - (lambda (x) - (eq? x a)))) - -((eq?-c 'salad) 'salad) ; #t -(define eq?-salad (eq?-c 'salad)) -(eq?-salad 'salad) ; #t - -(define rember-f - (lambda (test?) - (lambda (a l) - (cond - ((null? l) (quote ())) - ((test? a (car l)) ((rember-f test?) a (cdr l))) - (else (cons (car l) ((rember-f test?) a (cdr l)))))))) - -(define rember-eq? (rember-f eq?)) -(rember-eq? 'tuna '(tuna salad is good)) - -(define insertL-f - (lambda (test?) - (lambda (new old l) - (cond - ((null? l) (quote ())) - ((test? (car l) old) - (cons new (cons old (cdr l)))) - (else (cons (car l) - ((insertL-f test?) new old (cdr l)))))))) - -(define seqL - (lambda (new old l) - (cons new (cons old l)))) - -(define seqR - (lambda (new old l) - (cons old (cons new l)))) - -(define insert-g - (lambda (seq) - (lambda (new old l) - (cond - ((null? l) (quote ())) - ((eq? (car l) old) (seq new old (cdr l))) - (else (cons (car l) ((insert-g seq) new old (cdr l)))))))) - -(define insertL (insert-g seqL)) -(define insertR (insert-g seqR)) -(define insertL (insert-g - (lambda (new old l) - (cons new (cons old l))))) - -(insertL 'BUT 'then '(where but for the end then)) - -(define seqS - (lambda (new old l) (cons new l))) - -(define subst (insert-g seqS)) - -(subst 'both 'and '(meat and potatoes)) - -; {{ The Ninth Commandment }} -; Abstract common patterns with a new function. - -(define atom-to-function - (lambda (x) - (cond - ((eq? x (quote +)) +) - ((eq? x (quote x)) ox) - (else expt)))) - -(expt 4 4) ; 256 -(+ 4 4) ; 8 -(ox 4 4) -(o+ 4 4) - -(atom-to-function (operator '(+ 5 3))) ; plus function - -(define value - (lambda (nexp) - (cond - ((atom? nexp) nexp) - (else - ((atom-to-function (operator nexp)) - (value (1st-sub-exp nexp)) - (value (2nd-sub-exp nexp))))))) - -(value '(4 + 2)) - -(define multirember-f - (lambda (test?) - (lambda (a lat) - (cond - ((null? lat) (quote ())) - ((test? a (car lat)) ((multirember-f test?) a (cdr lat))) - (else (cons (car lat) ((multirember-f test?) a (cdr lat)))))))) - -((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)) - -(define eq?-tuna (eq?-c (quote tuna))) -(eq?-tuna (quote tuna)) ; #t - -(define multiremberT - (lambda (test? lat) - (cond - ((null? lat) (quote ())) - ((test? (car lat)) (multiremberT test? (cdr lat))) - (else (cons (car lat) (multiremberT test? (cdr lat))))))) - -(multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)) - -(define a-friend - (lambda (x y) - (null? y))) - -; col is a collector - -(define multirember&co - (lambda (a lat col) - (cond - ((null? lat) (col (quote ()) (quote ()))) - ((eq? (car lat) a) (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 new-friend - (lambda (newlat seen) - (a-friend newlat (cons (quote tuna) seen)))) - -; {{ The Tenth Commandment }} -; Build functions to collect more than one value at a time. - -(define multiinsertL - (lambda (new old lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) old) (cons new - (multiinsertL new old (cdr lat)))) - (else (cons (car lat) (multiinsertL new old (cdr lat))))))) - -(define multiinsertR - (lambda (new old lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) old) (cons new - (multiinsertR new old (cdr lat)))) - (else (cons (car lat) (multiinsertR new old (cdr lat))))))) - -(define multiinsertLR - (lambda (new oldL oldR lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) oldL) - (cons new (cons oldL - (multiinsertLR new oldL oldR (cdr lat))))) - ((eq? (car lat) 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 (quote ()) 0 0)) - ((eq? (car lat) oldL) - (multiinsertLR&co new oldL oldR (cdr lat) - (lambda (newlat L R) - (col (cons new - (cons oldL newlat)) (add1 L) R)))) - ((eq? (car lat) oldR) - (multiinsertLR&co new oldL oldR (cdr lat) - (lambda (newlat L R) - (col (cons oldR (cons new newlat)) L (add1 R))))) - (else (multiinsertLR&co new oldL oldR - (cdr lat) - (lambda (newlat L R) - (col (cons (car lat) newlat) - L R))))))) - -(multiinsertLR&co 'salty 'fish 'chips - '(chips and fish or fish and chips) - (lambda (lat L R) - R)) ; 2 - -(multiinsertLR&co 'salty 'fish 'chips - '(chips and fish or fish and chips) - (lambda (lat L R) - lat)) - -(define even? - (lambda (n) - (= (* (round (/ n 2)) 2) n))) - -(round 3/2) ; 2 -(= 1 1) ; #t -(/ 4 2) ; 2 -(* 4 2) ; 8 -(even? 3) ; #f - -(define evens-only* - (lambda (l) - (cond - ((null? l) (quote ())) - ((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))))))) - -(evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)) -; ((2 8) 10 (() 6) 2) - -(define col-odds - (lambda (l p s) l)) - -(define col-p - (lambda (l p s) p)) - -(define col-s - (lambda (l p s) s)) - -(define evens-only*&co - (lambda (l col) - (cond - ((null? l) (col (quote ()) 1 0)) - ((atom? (car l)) - (cond - ((even? (car l)) (evens-only*&co (cdr l) - (lambda (newl p s) - (col (cons (car l) newl) - (* p (car l)) - s)))) - (else (evens-only*&co (cdr l) - (lambda (newl p s) - (col newl - p - (+ s (car l)))))))) - (else - (evens-only*&co (car l) - (lambda (al ap as) - (evens-only*&co (cdr l) - (lambda (dl dp ds) - (col (cons al dl) - (* ap dp) - (+ as ds)))))))))) - -(evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) - (lambda (newl p s) - (cons s (cons p newl)))) ; (38 1920 (2 8) 10 (() 6) 2) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 09: ... and Again, and Again, and Again, ... - -(define looking - (lambda (a lat) - (keep-looking a (pick 1 lat) lat))) - -; sorn is a symbol or a number - -(define keep-looking - (lambda (a sorn lat) - (cond - ((number? sorn) (keep-looking a (pick sorn lat) lat)) - (else (eq? sorn a))))) - -(looking 'caviar '(6 2 4 caviar 5 7 3)) ; #t -(looking 'caviar '(6 2 grits caviar 5 7 3)) ; #f - -; total functions terminate for all finite inputs? -; partial functions terminate for only some inputs? - -(define shift - (lambda (pair) - (build (first (first pair)) - (build (second (first pair)) - (second pair))))) - -(shift '((a b) c)); (a (b c)) -;(shift '(a (b c))); error - -; pora = pair or atom -(define align - (lambda (pora) - (cond - ((atom? pora) pora) - ((a-pair? (first pora)) (align (shift pora))) - (else (build (first pora) (align (second pora))))))) - -(define length* - (lambda (pora) - (cond - ((atom? pora) l) - (else (length* (first pora)) (length* (second pora)))))) - -(define weight* - (lambda (pora) - (cond - ((atom? pora) 1) - (else (+ (* 2 (weight* (first pora))) - (weight* (second pora))))))) - -(weight* '((a b) c)) ; 7 -(weight* '(a (b c))) ; 5 - -(define shuffle - (lambda (pora) - (cond - ((atom? pora) pora) - ((a-pair? (first pora)) (shuffle (revpair pora))) - (else (build (first pora) (shuffle (second pora))))))) - -(shuffle '(a b)) ; (a b) -; (shuffle '((a b) (c d))) ; infinite recursion - -; Collatz function? -(define C - (lambda (n) - (cond - ((one? n) 1) - (else (cond - ((even? n) (C (/ n 2))) - (else (C (add1 (* 3 n))))))))) - -; (C 0) ; infinite recursion? -(C 1) ; 1 -(C 2) ; 1 -(C 8) ; 1 - -; Ackermann function -(define A - (lambda (n m) - (cond - ((zero? n) (add1 m)) - ((zero? m) (A (sub1 n) 1)) - (else (A (sub1 n) (A n (sub1 m))))))) - -(A 1 0) ; 2 -(A 2 2) ; 7 -(A 3 3) ; 61 -(A 3 4) ; 125 -; (A 4 3) ; ocean boiling? - -(define eternity - (lambda (x) (eternity x))) - -; got lost here a bit... - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 10: What is the Value of All of This? - -(define new-entry build) - -(define lookup-in-entry - (lambda (name entry entry-f) - (lookup-in-entry-help name - (first entry) - (second entry) - entry-f))) - -(define lookup-in-entry-help - (lambda (name names values entry-f) - (cond - ((null? names) (entry-f name)) - ((eq? (car names) name) (car values)) - (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f))))) - -(lookup-in-entry 'fish - '((teach a man to fish) - (1 2 3 4 5)) - (lambda (x) x)) - -(define extend-table cons) - -(define lookup-in-table - (lambda (name table table-f) - (cond - ((null? table) (table-f name)) - (else (lookup-in-entry name - (car table) - (lambda (n) - (lookup-in-table n (cdr table) table-f))))))) - -(lookup-in-table 'fish - (extend-table '((teach a man to fish) - (1 2 3 4 5)) - (quote ())) - (lambda (x) x)) - -(define atom-to-action - (lambda (e) - (cond - ((number? e) *const) - ((eq? e #t) *const) - ((eq? e #f) *const) - ((eq? e (quote cons)) *const) - ((eq? e (quote car)) *const) - ((eq? e (quote cdr)) *const) - ((eq? e (quote null?)) *const) - ((eq? e (quote eq?)) *const) - ((eq? e (quote atom?)) *const) - ((eq? e (quote zero?)) *const) - ((eq? e (quote add1)) *const) - ((eq? e (quote sub1)) *const) - ((eq? e (quote number?)) *const) - (else *identifier)))) - -(atom-to-action 'number?); *const - -(define list-to-action - (lambda (e) - (cond - ((atom? (car e)) (cond - ((eq? (car e) (quote quote)) *quote) - ((eq? (car e) (quote lambda)) *lambda) - ((eq? (car e) (quote cond)) *cond) - (else *application))) - (else *application)))) - -(list-to-action '(lambda (x) x)) ; *lambda -(list-to-action '(cond ((eq? 1 2) #f) (else #t))) ; *cond - -(define expression-to-action - (lambda (e) - (cond - ((atom? e) (atom-to-action e)) - (else (list-to-action e))))) - -(expression-to-action '#f) ; *const -(expression-to-action '(lambda (x) x)) ; *lambda - -(define value - (lambda (e) - (meaning e (quote ())))) - -(define meaning - (lambda (e table) - ((expression-to-action e) e table))) - -(define *const - (lambda (e table) - (cond - ((number? e) e) - ((eq? e #t) #t) - ((eq? e #f) #f) - (else (build (quote primitive) e))))) - -(*const 'asdf '()) ; (primitive asdf) - -(define *quote - (lambda (e table) - (text-of e))) - -(define text-of second) - -(*quote '(quote stuff) '()) ; stuff - -(define *identifier - (lambda (e table) - (lookup-in-table e table initial-table))) - -; this will pass an error if called -(define initial-table - (lambda (name) - (car (quote ())))) - -;(*identifier 'asdf '()) ; error -(*identifier 'a '( ((1 2 3 a b c) (first second third 1 2 3)))) ; 1 - -(define *lambda - (lambda (e table) - (build (quote non-primitive) (cons table (cdr e))))) - -(*lambda '(lambda (a b) (cond ((eq? a b) b) (else a))) '( ((1 2 3) (a b c)))) - -(meaning '(lambda (x) (cons x y)) '(((y z) ((8) 9)))) -; (non-primative ((((y z) ((8) 9)))) (x) (cons x y)) - -(define table-of first) -(define formals-of second) -(define body-of third) -(third '(a b c)) ; c - -(define evcon - (lambda (lines table) - (cond - ((else? (question-of (car lines))) - (meaning (answer-of (car lines)) table)) - ((meaning (question-of (car lines)) table) - (meaning (answer-of (car lines)) table)) - (else (evcon (cdr lines) table))))) - -(define else? - (lambda (x) - (cond - ((atom? x) (eq? x (quote else))) - (else #f)))) - -(define question-of first) -(define answer-of second) - -(define *cond - (lambda (e table) - (evcon (cond-lines-of e) table))) - -(define cond-lines-of cdr) - -(define evlis - (lambda (args table) - (cond - ((null? args) (quote ())) - (else (cons (meaning (car args) table) - (evlis (cdr args) table)))))) - -(evlis '(cons #f 4) '()) ; ((primitive cons) #f 4) - -(define function-of car) -(define arguments-of cdr) - -(define *application - (lambda (e table) - (apply - (meaning (function-of e) table) - (evlis (arguments-of e) table)))) - -(define primitive? - (lambda (l) - (eq? (first l) (quote primitive)))) - -(define non-primitive? - (lambda (l) - (eq? (first l) (quote non-primitive)))) - -(define apply - (lambda (fun vals) - (cond - ((primitive? fun) (apply-primitive (second fun) vals)) - ((non-primitive? fun) (apply-closure (second fun) vals))))) - -(define apply-primitive - (lambda (name vals) - (cond - ((eq? name (quote cons)) (cons (first vals) (second vals))) - ((eq? name (quote car)) (car (first vals))) - ((eq? name (quote cdr)) (cdr (first vals))) - ((eq? name (quote null?)) (null? (first vals))) - ((eq? name (quote eq?)) (eq? (first vals) (second vals))) - ((eq? name (quote atom?)) (:atom? (first vals))) - ((eq? name (quote zero?)) (zero? (first vals))) - ((eq? name (quote add1)) (add1 (first vals))) - ((eq? name (quote sub1)) (sub1 (first vals))) - ((eq? name (quote number?)) (number? (first vals)))))) - -(first '(a b)) -(apply-primitive 'null? '(())) ; #t -(*application '(null? 2) '()) ; #f -(*application '(cdr (quote (a b))) '()) ; (b) -(*application '(eq? 2 (add1 1)) '()) ; #t - -(define :atom? - (lambda (x) - (cond - ((atom? x) #t) - ((null? x) #f) - ((eq? (car x) (quote primitive)) #t) - ((eq? (car x) (quote non-primitive)) #t) - (else #f)))) - -(define apply-closure - (lambda (closure vals) - (meaning (body-of closure) - (extend-table (new-entry (formals-of closure) vals) - (table-of closure))))) - -(value '(zero? 0)) -(value '(eq? 1 1)) -(value '#f) ; #f -(value '(eq? 2 (add1 1))) ; #t - -(value '((lambda (a b) (a (add1 b))) (lambda (c) (add1 c)) 4)) ; 6 - -(value '((lambda (x) x) 1)) ; 1 - -;wheeee! \ No newline at end of file diff --git a/other/edwin-cheatsheet.txt b/other/edwin-cheatsheet.txt new file mode 100644 index 0000000..68ffd2c --- /dev/null +++ b/other/edwin-cheatsheet.txt @@ -0,0 +1,84 @@ + +-*-mode: Text; tab-width: 4; -*- + + EDWIN CHEAT SHEET + (keep under your pillow) + + 6.090, IAP 2005 + +Reading Edwin key combinations: + C-x Ctrl+x + M-x Alt+x + C-x, y Ctrl+x, release both, y + C-M-x Ctrl+Alt+x + +Stuff You *Need* to Know: + Starting Edwin Start Menu > MIT Scheme > Edwin + Quitting Edwin C-x, C-c + Opening a file C-x, C-f + Closing a file (aka buffer) C-x, k + Evaluate current expression C-x, C-e + (expression ending just before + insertion point) + Evaluate entire buffer + (works only on Scheme files!) M-o + +The Edwin Window and Scheme: + When you start it, the Edwin window looks like a plain text + editor. It has a large blank area for entering text, one black + line at the bottom with some information displayed (the modeline), + and a blank white line below that (the minibuffer). + + The text area + is where the file you're viewing shows up. You can edit the + file here, with the usual keys (up, down, page up, left... you + get the idea). + + The modeline + displays the name of the current buffer (file), your position + in it, and the kind of file Edwin thinks it is (text, scheme + code etc.). + + The minibuffer + is where you interact with Edwin's commands. For example, when + you press C-x, C-f to open a file, you enter the filename in + the minibuffer. + + Edwin is more than just an editor, though. It also features a + Scheme evaluator, to which it can send your code. So when you + press C-x, C-e at the end of an expression, it gets evaluated by + this evaluator (more on evaluators and evaluation in class). + + Try out the key combinations below to see what they do. Don't try + to memorize them. Your finger muscles will learn them as time goes + on :-) + +Inessential Edwin: + Editing + Marking/selecting text Go to one end of the block, press + C-space, go to the other end. You won't + see any visual indication of the + selection. + Cut C-w + Copy M-w + Paste C-y + Cut from point to end of like C-k + + Multiple Windows and Buffers + Switch buffer C-x, b + Switch window C-x, o + Split window vertically C-x, 2 + Split window horizontally C-x, 3 + Delete current split C-x, 0 + Create new frame (window) C-x, 5, 2 + Delete current frame C-x, 5, 0 + +Interactive Scheme: + When you are in the buffer called *scheme*, everything you type goes + directly to the evaluator, and the results are displayed below your + expressions. When you make an error, the evaluator gives you a set of + choices to help you debug your code. Usually, it is best to type (restart 1) + at the next prompt to abort the current evaluation, so you can go back and + examine your code to see what went wrong. For more advanced debugging tools, + talk to an LA. + diff --git a/other/little_schemer.scm b/other/little_schemer.scm new file mode 100644 index 0000000..8a31425 --- /dev/null +++ b/other/little_schemer.scm @@ -0,0 +1,1335 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Play-along log to The Little Schemer by Friedman and Felleisen +; Jan 2008, bryan newbold + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Preface: define and test primative + +(define atom? + (lambda (x) + (and (not (pair? x)) (not (null? x))))) + +(atom? (quote ())) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 01: Toys + +(car '(c b a)) ; returns c +(cdr '(c b a)) ; returns '(b a) +;(car ()) ; gives an error, () is null (but is still a list) + +; [[ Law of Car ]] +; The primative car is defind only for non-empty lists. + +; [[ Law of Cdr ]] +; The primative cdr is defined only for non-empty lists. The cdr of any +; non-empty list is always another list. + +(cons 2 3) ; returns (2 . 3), though book says undefined. +(cons 'a ()) ; returns (a) + +; [[ Law of Cons ]] +; The primative cons takes two arguments. The second argument to cons must be +; a list. The result is a list. + +(null? ()) ; #t +(null? 3) ; #f +;(null? (() ())); error +;(null? ('() '())) ; error +(null? '(() ())) ; #f +(null? 'asdf) ; #f, book says undefined + +;(cdr (1)) ; error! +(cdr '(1)) ; reurns () + +; [[ Law of Null? ]] +; The primative null? is defined only for lists. + +; [[ Law of Eq? ]] +; The primative eq? takes two arguments. Each must be a non-numeric atom. + +; in practice some numbers can be eq? ? + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 02: Do It, Do It Again, and Again, and Again... + +(define lat? + (lambda (l) + (cond + ((null? l) #t) + ((atom? (car l)) (lat? (cdr l))) + (else #f)))) + +; lat = list of atoms +(lat? '(a b c d)) ; #t +(lat? '('(1 2 3) 4 5 6)) ; #f +(lat? ()) ; #t + +(define member? + (lambda (a lat) + (cond + ((null? lat) #f) + (else (or (eq? (car lat) a) + (member? a (cdr lat))))))) + +(member? 'beef '(meat and potatoes and beef)) ; #t +(member? 'tofu ()) ; #f + +; {{ The First Commandment }} +; When recurring on a list of atoms, lat, ask two questions about it: +; (null? lat) and else. +; When recurring on a number, n, ask two questions about it: (zero? n) and +; else. +; When recurring on a list of S-expressions, l, ask three questions about it: +; (null? l), (atom? (car l)), and else. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 03: Cons the Magnificent + +(define rember + (lambda (a lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) a) (cdr lat)) + (else (cons (car lat) + (rember a (cdr lat))))))) + +(rember 'and '(peanut butter and jelly)) ; (peanut butter jelly) + +; {{ The Second Commandment }} +; Use cons to build lists. + +; returns list of first elements off each list in a list of lists ;) +(define firsts + (lambda (l) + (cond + ((null? l) ()) + (else (cons (car (car l)) (firsts (cdr l))))))) + +(firsts '((a b c) (1 2 3) (j k l))) ; (a 1 j) + +; {{ The Third Commandment }} +; When building a list, describe the first typical element, and then +; cons it onto the natural recursion. + +(define insertR + (lambda (new old lat) + (cond + ((null? lat) (quote ())) + ((eq? old (car lat)) (cons (car lat) (cons new (cdr lat)))) + (else (cons (car lat) (insertR new old (cdr lat))))))) + +(insertR 'jalapeno 'and '(tacos tamales and salsa)) +; (tacos tamales and jalapeno salsa) + +(define insertL + (lambda (new old lat) + (cond + ((null? lat) (quote ())) + ((eq? old (car lat)) (cons new lat)) + (else (cons (car lat) (insertL new old (cdr lat))))))) + +(insertL 'now 'please '(do it please)) ; (do it now please) + +(define subst + (lambda (new old lat) + (cond + ((null? lat) (quote ())) + ((eq? old (car lat)) (cons new (cdr lat))) + (else (cons (car lat) (subst new old (cdr lat))))))) + +(subst 'both 'and '(meat and potatoes)) ; (meat both potatoes) + +(define subst2 + (lambda (new o1 o2 lat) + (cond + ((null? lat) (quote ())) + ((eq? o1 (car lat)) (cons new (cdr lat))) + ((eq? o2 (car lat)) (cons new (cdr lat))) + (else (cons (car lat) (subst2 new o1 o2 (cdr lat))))))) + +(subst2 'a 'q 'r '(a s d r q)) ; (a s d a q) +(subst2 'a 'q 'r '(a s q d r)) ; (a s a d r) + +(define multirember + (lambda (a lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) a) (multirember a (cdr lat))) + (else (cons (car lat) (multirember a (cdr lat))))))) + +(multirember 'd '(a d b d s g r c d d d w r)) ; (a b s g r c w r) + +; {{ The Fourth Commandment }} +; Always change at least one argument while recurring. It must be changed to +; be closer to termination. The changing argument must be tested in the +; termination condition: when using cdr, test temrination with null?. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 04: Numbers Games + +(atom? 0) ; #t +(atom? 3.123123132) ; #t +(atom? -12i) ; #t + +(define add1 + (lambda (n) + (+ n 1))) + +(add1 67) + +(define sub1 + (lambda (n) + (- n 1))) + +(sub1 0) ; -1 +(sub1 -12i) ; -1-12i +(sub1 +2i) ; -1+2i + +(zero? 2) ; #f + +; doesn't handle negatives! +(define o+ + (lambda (a b) + (cond + ((zero? b) a) + (else (o+ (add1 a) (sub1 b)))))) + +(o+ 12 3) + +(define o- + (lambda (a b) + (cond + ((zero? b) a) + (else (o- (sub1 a) (sub1 b)))))) + +(o- 12 3) ; 9 +(o- 10 25) ; -15 +;(o- 4 -1) ; infinite loop! + +(zero? ()) ; #f + +(define addtup + (lambda (tup) + (cond + ((null? tup) 0) + (else (o+ (car tup) (addtup (cdr tup))))))) + +(addtup '(1 1 1 1 1)) ; 5 +(addtup '()) ; 0 + +(define ox + (lambda (a b) + (cond + ((zero? b) 0) + (else (o+ a (ox a (sub1 b))))))) + +(ox 4 4) ; 16 +;(ox 12983761498 12983472) ; max recursion depth exceeded ;( +;(ox 39485 345) ; SLOW! + +; {{ The Fourth Commandment }} +; Always change at least one argument while recurring. 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?. + +; {{ The Fifth Commandment }} +; When building a value with +, always use 0 for the value of the terminating +; line, for adding 0 does not change the value of an addition. +; When building a value with x, always use 1 for the value of the terminating +; line, for multiplying by 1 does not change the value of a multiplication. +; When building a value with cons, always condsider () for the value of the +; terminating line. + +(define tup+ + (lambda (a b) + (cond + ((or (null? a) (null? b)) ()) + (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b))))))) +; the book uses 'and' instead of 'or' because it specifies the tups must +; be of equal length + +(tup+ '(1 2 3 4 5) '(5 4 3 2 1)) ; (6 6 6 6 6) + +; improved version +(define tup+ + (lambda (a b) + (cond + ((and (null? a) (null? b)) (quote ())) + ((null? a) b) + ((null? b) a) + (else (cons (o+ (car a) (car b)) (tup+ (cdr a) (cdr b))))))) + +(tup+ '(1 2 3 4 5) '(5 4)) ; (6 6 3 4 5) + +(define o> + (lambda (a b) + (cond + ((zero? a) #f) + ((zero? b) #t) + (else (o> (sub1 a) (sub1 b)))))) + +(o> 5 6) ; #t +(o> 7 7) ; #f + +(define length + (lambda (lat) + (cond + ((null? lat) 0) + (else (add1 (length (cdr lat))))))) +(length '(a b c d)) ; 4 +(length (quote ())) ; 0 + +(define pick + (lambda (n lat) + (cond + ((zero? (sub1 n)) (car lat)) + (else (pick (sub1 n) (cdr lat)))))) + +(define rempick + (lambda (n lat) + (cond + ((null? lat) (quote ())) + ((zero? n) (cdr lat)) + (else (cons (car lat) (rempick (sub1 n) (cdr lat))))))) + +(rempick 3 `(this sentance has like a billion words)) + +(define no-nums + (lambda (lat) + (cond + ((null? lat) (quote ())) + ((number? (car lat)) (no-nums (cdr lat))) + (else (cons (car lat) (no-nums (cdr lat))))))) + +(no-nums '(this 1 sentance has 56 other numbers 23 built-in)) + +(define all-nums + (lambda (lat) + (cond + ((null? lat) (quote ())) + ((number? (car lat)) (cons (car lat) (all-nums (cdr lat)))) + (else (all-nums (cdr lat)))))) + +(all-nums '(this 1 sentance has 56 other numbers 23 built-in)) + +(define eqan? + (lambda (a b) + (cond + ((and (number? a) (number? b)) (= a b)) + ((or (number? a) (number? b)) #f) + (else (eq? a b))))) + +(eq? 1 1) ; #t +(eqan? 2 3) ; #f + +(define occur + (lambda (a lat) + (cond + ((null? lat) 0) + ((eq? a (car lat)) (add1 (occur a (cdr lat)))) + (else (occur a (cdr lat)))))) + +(occur 'n '(a n d that's all n folks!)) ; 2 +(occur 123 '(1 2 3 4)) ; 0 + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 05: Oh My Gawd: It's full of Stars + +(define rember* + (lambda (a l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (cond + ((eq? a (car l)) (cdr l)) + (else (cons (car l) (rember* a (cdr l)))))) + (else (cons (rember* a (car l)) (rember* a (cdr l))))))) + +(rember* 'sauce '(((tomato sauce)) + ((bean) sauce) + (and ((flying)) sauce))) + +(define insertR* + (lambda (new old l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (cond + ((eq? old (car l)) (cons (car l) (cons new (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)) + +(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)) + sherbet)) + (banana) + (bread) + (banana brandy))) + +(define subst* + (lambda (new old l) + (cond + ((null? l) (quote ())) + ((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))))))) + +(subst* 'orange 'banana '((banana) + (split ((((banana ice))) + (cream (banana)) + sherbet)) + (banana) + (bread) + (banana brandy))) + +(define insertL* + (lambda (new old l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (cond + ((eq? old (car l)) + (cons new (cons + (car l) + (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))) + (id (a) ((wood chuck))) + could chuck wood)) + +(define member* + (lambda (a l) + (cond + ((null? l) #f) + ((atom? (car l)) (cond + ((eq? a (car l)) #t) + (else (member* a (cdr l))))) + (else (or (member* a (car l)) (member* a (cdr l))))))) + +(member* 'chips '((potato (chips ((with) fish) (chips))))) ; #t +(member* 'beef '(meat ((and potatoes)) (with brocolli))) ; #f + +; list must not contain null list! +(define leftmost + (lambda (l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (car l)) + (else (leftmost (car l)))))) + +(leftmost '(((hot) (tuna (and))) cheese)) + +(define eqlist? + (lambda (a b) + (cond + ((and (null? a) (null? b)) #t) + ((or (null? a) (null? b)) #f) + ((and (atom? (car a)) (atom? (car b))) + (and (eqan? (car a) (car b)) + (and (eqlist? (cdr a) (cdr b))))) + ((or (atom? (car a)) (atom? (car b))) #f) + (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b))))))) + +(eqlist? + '(beef ((sausage)) (and (soda))) + '(beef ((sausage)) (and (soda)))) ; #t + +(eqlist? + '(beef ((sausag)) (and (soda))) + '(beef ((sausage)) (and))) ; #f + +(eqlist? '(ff (1 2) (a)) '(ff (1 2) (b))) ; #f + +(eqan? 'sausag 'sausage) ; #f + +; new definition allows removal of S-expressions +(define rember + (lambda (s l) + (cond + ((null? l) (quote ())) + ((equal? s (car l)) (cdr l)) + (else (cons (car l) (rember s (cdr l))))))) + +; these next two I just copied after the fact, didn't think I would +; need them at the time +(define equal? + (lambda (a b) + (cond + ((and (atom? a) (atom? b)) (eqan? a b)) + ((or (atom? a) (atom? b)) #f) + (else (eqlist? a b))))) + +(equal? '(this ((is more) complicated)) + '(this ((is more) complicated))) ; #t +(equal? '(this ((is more) complicated)) + '(this ((is) complicated))) ; #f +(equal? '4' '(4 5)) ; #f + +(define rember + (lambda (s l) + (cond + ((null? l) (quote ())) + ((equal? (car l) s) (cdr l)) + (else (cons (car l) (rember s (cdr l))))))) + +(rember 'q '(a b e d q)) +(rember '4 '(1 2 3 (4 5) 8)) +(rember '(4 5) '(1 2 3 (4 5) 6 7 8)) + +; {{ The Sixth Commandment }} +; Simplify only after the function is correct. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 06: Shadows + +(define numbered? + (lambda (aexp) + (cond + ((null? aexp) #f) + ((atom? aexp) (number? aexp)) + ((or (eq? (car (cdr aexp)) (quote +)) + (eq? (car (cdr aexp)) (quote -)) + (eq? (car (cdr aexp)) (quote ^))) + (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp)))))) + (else #f)))) + +(numbered? '(1 + 3)) ; #t +(numbered? '((4 ^ 3) - 4)) ; #t +(numbered? '(a + 2 + (r ^ 2))) ; #f +(numbered? '(1 _ 3 + 5 + Q)) ; #f +(numbered? '(1 + 4 ^ 8 + r)) ; #t???? should only have two expressions +(numbered? '((1 + 4) ^ (8 + r))) ; #f + +;book likes to make assumptions, namely that aexp is definately an algebraic +;expression +(define numbered? + (lambda (aexp) + (cond + ((atom? aexp) (number? aexp)) + (else (and (numbered? (car aexp)) + (numbered? (car (cdr (cdr aexp))))))))) + +(numbered? '1) +(numbered? '(1 + 1)) + + +(define value + (lambda (aexp) + (cond + ((atom? aexp) aexp) + ((eq? (car (cdr aexp)) (quote +)) (+ (value (car aexp)) + (value (car (cdr (cdr aexp)))))) + ((eq? (car (cdr aexp)) (quote -)) (- (value (car aexp)) + (value (car (cdr (cdr aexp)))))) + ((eq? (car (cdr aexp)) (quote ^)) + (expt (value (car aexp)) + (value (car (cdr (cdr aexp))))))))) + +(value '(1 + 1)) +(value '(3 ^ 3)) +(value '(5 - (2 ^ 2))) + +(define 1st-sub-exp + (lambda (aexp) + (car aexp))) + +(define 2nd-sub-exp + (lambda (aexp) + (car (cdr (cdr aexp))))) + +(define operator + (lambda (aexp) + (car (cdr aexp)))) + +; {{ The Seventh Commandment }} +; Recur on the subpart that are of the same nature: +; * on the sublists of a list. +; * on the subexpressions of an arthmetic expression. + +; {{ The Eighth Commandment }} +; Use help functions to abstract from representations. + +(define sero? + (lambda (n) + (null? n))) + +(sero? '()) ; #t +(sero? '(() ())) ; #f + +(define edd1 + (lambda (n) + (cons (quote ()) n))) + +(define zub1 + (lambda (n) + (cdr n))) + +;(define o+ +; (lambda (n m) +; (cond +; ((sero? m) n) +; (else (edd1 (o+ n (zub1 m))))))) + +;(o+ '(() ()) '(() () ())) ; (() () () () ()) + +;(lat? (() () () () ())) ; error! + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 07: Friends and Relations + +(define set? + (lambda (lat) + (cond + ((null? lat) #t) + ((member? (car lat) (cdr lat)) #f) + (else (set? (cdr lat)))))) + +(set? '(this is a sentance with no repeats)) ; #t +(set? '()) ; #t +(set? '(this is a sentance with repeats, so this is not a set)); #f + +(define makeset + (lambda (lat) + (cond + ((null? lat) (quote ())) + ((member? (car lat) (cdr lat)) (makeset (cdr lat))) + (else (cons (car lat) (makeset (cdr lat))))))) + +(makeset '(a b c b c c c d e f)) + +; is every element of the first in the second? +(define subset? + (lambda (a b) + (cond + ((null? a) #t) + ((member? (car a) b) (subset? (cdr a) b)) + (else #f)))) + +(subset? '() '(1 2 3)) ; #t +(subset? '(a b c) '(1 4 b 6 c 1 a)) ; #t +(subset? '(a b c) '(1 4 b 6 1 a)) ; #f + +(define eqset? + (lambda (a b) + (and (subset? a b) (subset? b a)))) + +(eqset? '(1 2 3 4) '(3 4 1 2)) ; #t +(eqset? '(1 2 3 4 5) '(3 4 1 2)) ; #f + +(define intersect? + (lambda (a b) + (cond + ((null? a) #f) + (else (or (member? (car a) b) (intersect? (cdr a) b)))))) + +(intersect? '(a b c) '(1 2 3)) ; #f +(intersect? '(a B c) '(1 2 3 B 5)) ; #t + +(define intersect + (lambda (a b) + (cond + ((null? a) (quote ())) + ((member? (car a) b) (cons (car a) (intersect (cdr a) b))) + (else (intersect (cdr a) b))))) + +(intersect '(a b c) '(1 2 3)) ; () +(intersect '(a b c) '(1 b c 4 5)) ; (b c) + +(define union + (lambda (a b) + (cond + ((null? a) b) + ((member? (car a) b) (union (cdr a) b)) + (else (union (cdr a) (cons (car a) b)))))) + +(union '(a b c) '(1 2 3)) +(union '(a b c) '(a b 3)) + +(define intersectall + (lambda (l-set) + (cond + ((null? (cdr l-set)) (car l-set)) + (else (intersect (car l-set) (intersectall (cdr l-set))))))) + +(intersectall '((a b c) (c a d e) (e f g h a b))) ; (a) + +(define a-pair? + (lambda (x) + (cond + ((null? x) #f) + ((atom? x) #f) + ((null? (cdr x)) #f) + ((null? (cdr (cdr x))) #t) + (else #f)))) + +(define first + (lambda (p) (car p))) + +(define second + (lambda (p) (car (cdr p)))) + +(define build + (lambda (a b) (cons a (cons b (quote ()))))) + +(define third + (lambda (p) (car (cdr (cdr p))))) + +; a rel is a relation: a list of pairs + +(firsts '((a b) (c d) (e f))) ; # (a c e), from an earlier chapter + +(define fun? + (lambda (rel) + (set? (firsts rel)))) + +(define revrel + (lambda (rel) + (cond + ((null? rel) (quote ())) + (else (cons (build (second (car rel)) (first (car rel))) + (revrel (cdr rel))))))) + +(revrel '((a b) (1 2) (here there))) + +(define revpair + (lambda (p) + (build (second p) (first p)))) + +(define revrel + (lambda (rel) + (cond + ((null? rel) (quote ())) + (else (cons (revpair (car rel)) (revrel (cdr rel))))))) + +(define fullfun? + (lambda (fun) + (set? (seconds fun)))) + +(define one-to-one? + (lambda (fun) + (fun? (revrel fun)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 08: Lambda the Ultimate + +(define rember-f + (lambda (test? a l) + (cond + ((null? l) (quote ())) + ((test? a (car l)) (rember-f test? a (cdr l))) + (else (cons (car l) (rember-f test? a (cdr l))))))) + +(rember-f equal? '(pop corn) '(lemonade (pop corn) and (cake))) + +; Currying: Moses Schonfinkel and Haskell Curry + +(define eq?-c + (lambda (a) + (lambda (x) + (eq? x a)))) + +((eq?-c 'salad) 'salad) ; #t +(define eq?-salad (eq?-c 'salad)) +(eq?-salad 'salad) ; #t + +(define rember-f + (lambda (test?) + (lambda (a l) + (cond + ((null? l) (quote ())) + ((test? a (car l)) ((rember-f test?) a (cdr l))) + (else (cons (car l) ((rember-f test?) a (cdr l)))))))) + +(define rember-eq? (rember-f eq?)) +(rember-eq? 'tuna '(tuna salad is good)) + +(define insertL-f + (lambda (test?) + (lambda (new old l) + (cond + ((null? l) (quote ())) + ((test? (car l) old) + (cons new (cons old (cdr l)))) + (else (cons (car l) + ((insertL-f test?) new old (cdr l)))))))) + +(define seqL + (lambda (new old l) + (cons new (cons old l)))) + +(define seqR + (lambda (new old l) + (cons old (cons new l)))) + +(define insert-g + (lambda (seq) + (lambda (new old l) + (cond + ((null? l) (quote ())) + ((eq? (car l) old) (seq new old (cdr l))) + (else (cons (car l) ((insert-g seq) new old (cdr l)))))))) + +(define insertL (insert-g seqL)) +(define insertR (insert-g seqR)) +(define insertL (insert-g + (lambda (new old l) + (cons new (cons old l))))) + +(insertL 'BUT 'then '(where but for the end then)) + +(define seqS + (lambda (new old l) (cons new l))) + +(define subst (insert-g seqS)) + +(subst 'both 'and '(meat and potatoes)) + +; {{ The Ninth Commandment }} +; Abstract common patterns with a new function. + +(define atom-to-function + (lambda (x) + (cond + ((eq? x (quote +)) +) + ((eq? x (quote x)) ox) + (else expt)))) + +(expt 4 4) ; 256 +(+ 4 4) ; 8 +(ox 4 4) +(o+ 4 4) + +(atom-to-function (operator '(+ 5 3))) ; plus function + +(define value + (lambda (nexp) + (cond + ((atom? nexp) nexp) + (else + ((atom-to-function (operator nexp)) + (value (1st-sub-exp nexp)) + (value (2nd-sub-exp nexp))))))) + +(value '(4 + 2)) + +(define multirember-f + (lambda (test?) + (lambda (a lat) + (cond + ((null? lat) (quote ())) + ((test? a (car lat)) ((multirember-f test?) a (cdr lat))) + (else (cons (car lat) ((multirember-f test?) a (cdr lat)))))))) + +((multirember-f eq?) 'tuna '(shrimp salad tuna salad and tuna)) + +(define eq?-tuna (eq?-c (quote tuna))) +(eq?-tuna (quote tuna)) ; #t + +(define multiremberT + (lambda (test? lat) + (cond + ((null? lat) (quote ())) + ((test? (car lat)) (multiremberT test? (cdr lat))) + (else (cons (car lat) (multiremberT test? (cdr lat))))))) + +(multiremberT eq?-tuna '(shrimp salad tuna salad and tuna)) + +(define a-friend + (lambda (x y) + (null? y))) + +; col is a collector + +(define multirember&co + (lambda (a lat col) + (cond + ((null? lat) (col (quote ()) (quote ()))) + ((eq? (car lat) a) (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 new-friend + (lambda (newlat seen) + (a-friend newlat (cons (quote tuna) seen)))) + +; {{ The Tenth Commandment }} +; Build functions to collect more than one value at a time. + +(define multiinsertL + (lambda (new old lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) old) (cons new + (multiinsertL new old (cdr lat)))) + (else (cons (car lat) (multiinsertL new old (cdr lat))))))) + +(define multiinsertR + (lambda (new old lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) old) (cons new + (multiinsertR new old (cdr lat)))) + (else (cons (car lat) (multiinsertR new old (cdr lat))))))) + +(define multiinsertLR + (lambda (new oldL oldR lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) oldL) + (cons new (cons oldL + (multiinsertLR new oldL oldR (cdr lat))))) + ((eq? (car lat) 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 (quote ()) 0 0)) + ((eq? (car lat) oldL) + (multiinsertLR&co new oldL oldR (cdr lat) + (lambda (newlat L R) + (col (cons new + (cons oldL newlat)) (add1 L) R)))) + ((eq? (car lat) oldR) + (multiinsertLR&co new oldL oldR (cdr lat) + (lambda (newlat L R) + (col (cons oldR (cons new newlat)) L (add1 R))))) + (else (multiinsertLR&co new oldL oldR + (cdr lat) + (lambda (newlat L R) + (col (cons (car lat) newlat) + L R))))))) + +(multiinsertLR&co 'salty 'fish 'chips + '(chips and fish or fish and chips) + (lambda (lat L R) + R)) ; 2 + +(multiinsertLR&co 'salty 'fish 'chips + '(chips and fish or fish and chips) + (lambda (lat L R) + lat)) + +(define even? + (lambda (n) + (= (* (round (/ n 2)) 2) n))) + +(round 3/2) ; 2 +(= 1 1) ; #t +(/ 4 2) ; 2 +(* 4 2) ; 8 +(even? 3) ; #f + +(define evens-only* + (lambda (l) + (cond + ((null? l) (quote ())) + ((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))))))) + +(evens-only* '((9 1 2 8) 3 10 ((9 9) 7 6) 2)) +; ((2 8) 10 (() 6) 2) + +(define col-odds + (lambda (l p s) l)) + +(define col-p + (lambda (l p s) p)) + +(define col-s + (lambda (l p s) s)) + +(define evens-only*&co + (lambda (l col) + (cond + ((null? l) (col (quote ()) 1 0)) + ((atom? (car l)) + (cond + ((even? (car l)) (evens-only*&co (cdr l) + (lambda (newl p s) + (col (cons (car l) newl) + (* p (car l)) + s)))) + (else (evens-only*&co (cdr l) + (lambda (newl p s) + (col newl + p + (+ s (car l)))))))) + (else + (evens-only*&co (car l) + (lambda (al ap as) + (evens-only*&co (cdr l) + (lambda (dl dp ds) + (col (cons al dl) + (* ap dp) + (+ as ds)))))))))) + +(evens-only*&co '((9 1 2 8) 3 10 ((9 9) 7 6) 2) + (lambda (newl p s) + (cons s (cons p newl)))) ; (38 1920 (2 8) 10 (() 6) 2) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 09: ... and Again, and Again, and Again, ... + +(define looking + (lambda (a lat) + (keep-looking a (pick 1 lat) lat))) + +; sorn is a symbol or a number + +(define keep-looking + (lambda (a sorn lat) + (cond + ((number? sorn) (keep-looking a (pick sorn lat) lat)) + (else (eq? sorn a))))) + +(looking 'caviar '(6 2 4 caviar 5 7 3)) ; #t +(looking 'caviar '(6 2 grits caviar 5 7 3)) ; #f + +; total functions terminate for all finite inputs? +; partial functions terminate for only some inputs? + +(define shift + (lambda (pair) + (build (first (first pair)) + (build (second (first pair)) + (second pair))))) + +(shift '((a b) c)); (a (b c)) +;(shift '(a (b c))); error + +; pora = pair or atom +(define align + (lambda (pora) + (cond + ((atom? pora) pora) + ((a-pair? (first pora)) (align (shift pora))) + (else (build (first pora) (align (second pora))))))) + +(define length* + (lambda (pora) + (cond + ((atom? pora) l) + (else (length* (first pora)) (length* (second pora)))))) + +(define weight* + (lambda (pora) + (cond + ((atom? pora) 1) + (else (+ (* 2 (weight* (first pora))) + (weight* (second pora))))))) + +(weight* '((a b) c)) ; 7 +(weight* '(a (b c))) ; 5 + +(define shuffle + (lambda (pora) + (cond + ((atom? pora) pora) + ((a-pair? (first pora)) (shuffle (revpair pora))) + (else (build (first pora) (shuffle (second pora))))))) + +(shuffle '(a b)) ; (a b) +; (shuffle '((a b) (c d))) ; infinite recursion + +; Collatz function? +(define C + (lambda (n) + (cond + ((one? n) 1) + (else (cond + ((even? n) (C (/ n 2))) + (else (C (add1 (* 3 n))))))))) + +; (C 0) ; infinite recursion? +(C 1) ; 1 +(C 2) ; 1 +(C 8) ; 1 + +; Ackermann function +(define A + (lambda (n m) + (cond + ((zero? n) (add1 m)) + ((zero? m) (A (sub1 n) 1)) + (else (A (sub1 n) (A n (sub1 m))))))) + +(A 1 0) ; 2 +(A 2 2) ; 7 +(A 3 3) ; 61 +(A 3 4) ; 125 +; (A 4 3) ; ocean boiling? + +(define eternity + (lambda (x) (eternity x))) + +; got lost here a bit... + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 10: What is the Value of All of This? + +(define new-entry build) + +(define lookup-in-entry + (lambda (name entry entry-f) + (lookup-in-entry-help name + (first entry) + (second entry) + entry-f))) + +(define lookup-in-entry-help + (lambda (name names values entry-f) + (cond + ((null? names) (entry-f name)) + ((eq? (car names) name) (car values)) + (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f))))) + +(lookup-in-entry 'fish + '((teach a man to fish) + (1 2 3 4 5)) + (lambda (x) x)) + +(define extend-table cons) + +(define lookup-in-table + (lambda (name table table-f) + (cond + ((null? table) (table-f name)) + (else (lookup-in-entry name + (car table) + (lambda (n) + (lookup-in-table n (cdr table) table-f))))))) + +(lookup-in-table 'fish + (extend-table '((teach a man to fish) + (1 2 3 4 5)) + (quote ())) + (lambda (x) x)) + +(define atom-to-action + (lambda (e) + (cond + ((number? e) *const) + ((eq? e #t) *const) + ((eq? e #f) *const) + ((eq? e (quote cons)) *const) + ((eq? e (quote car)) *const) + ((eq? e (quote cdr)) *const) + ((eq? e (quote null?)) *const) + ((eq? e (quote eq?)) *const) + ((eq? e (quote atom?)) *const) + ((eq? e (quote zero?)) *const) + ((eq? e (quote add1)) *const) + ((eq? e (quote sub1)) *const) + ((eq? e (quote number?)) *const) + (else *identifier)))) + +(atom-to-action 'number?); *const + +(define list-to-action + (lambda (e) + (cond + ((atom? (car e)) (cond + ((eq? (car e) (quote quote)) *quote) + ((eq? (car e) (quote lambda)) *lambda) + ((eq? (car e) (quote cond)) *cond) + (else *application))) + (else *application)))) + +(list-to-action '(lambda (x) x)) ; *lambda +(list-to-action '(cond ((eq? 1 2) #f) (else #t))) ; *cond + +(define expression-to-action + (lambda (e) + (cond + ((atom? e) (atom-to-action e)) + (else (list-to-action e))))) + +(expression-to-action '#f) ; *const +(expression-to-action '(lambda (x) x)) ; *lambda + +(define value + (lambda (e) + (meaning e (quote ())))) + +(define meaning + (lambda (e table) + ((expression-to-action e) e table))) + +(define *const + (lambda (e table) + (cond + ((number? e) e) + ((eq? e #t) #t) + ((eq? e #f) #f) + (else (build (quote primitive) e))))) + +(*const 'asdf '()) ; (primitive asdf) + +(define *quote + (lambda (e table) + (text-of e))) + +(define text-of second) + +(*quote '(quote stuff) '()) ; stuff + +(define *identifier + (lambda (e table) + (lookup-in-table e table initial-table))) + +; this will pass an error if called +(define initial-table + (lambda (name) + (car (quote ())))) + +;(*identifier 'asdf '()) ; error +(*identifier 'a '( ((1 2 3 a b c) (first second third 1 2 3)))) ; 1 + +(define *lambda + (lambda (e table) + (build (quote non-primitive) (cons table (cdr e))))) + +(*lambda '(lambda (a b) (cond ((eq? a b) b) (else a))) '( ((1 2 3) (a b c)))) + +(meaning '(lambda (x) (cons x y)) '(((y z) ((8) 9)))) +; (non-primative ((((y z) ((8) 9)))) (x) (cons x y)) + +(define table-of first) +(define formals-of second) +(define body-of third) +(third '(a b c)) ; c + +(define evcon + (lambda (lines table) + (cond + ((else? (question-of (car lines))) + (meaning (answer-of (car lines)) table)) + ((meaning (question-of (car lines)) table) + (meaning (answer-of (car lines)) table)) + (else (evcon (cdr lines) table))))) + +(define else? + (lambda (x) + (cond + ((atom? x) (eq? x (quote else))) + (else #f)))) + +(define question-of first) +(define answer-of second) + +(define *cond + (lambda (e table) + (evcon (cond-lines-of e) table))) + +(define cond-lines-of cdr) + +(define evlis + (lambda (args table) + (cond + ((null? args) (quote ())) + (else (cons (meaning (car args) table) + (evlis (cdr args) table)))))) + +(evlis '(cons #f 4) '()) ; ((primitive cons) #f 4) + +(define function-of car) +(define arguments-of cdr) + +(define *application + (lambda (e table) + (apply + (meaning (function-of e) table) + (evlis (arguments-of e) table)))) + +(define primitive? + (lambda (l) + (eq? (first l) (quote primitive)))) + +(define non-primitive? + (lambda (l) + (eq? (first l) (quote non-primitive)))) + +(define apply + (lambda (fun vals) + (cond + ((primitive? fun) (apply-primitive (second fun) vals)) + ((non-primitive? fun) (apply-closure (second fun) vals))))) + +(define apply-primitive + (lambda (name vals) + (cond + ((eq? name (quote cons)) (cons (first vals) (second vals))) + ((eq? name (quote car)) (car (first vals))) + ((eq? name (quote cdr)) (cdr (first vals))) + ((eq? name (quote null?)) (null? (first vals))) + ((eq? name (quote eq?)) (eq? (first vals) (second vals))) + ((eq? name (quote atom?)) (:atom? (first vals))) + ((eq? name (quote zero?)) (zero? (first vals))) + ((eq? name (quote add1)) (add1 (first vals))) + ((eq? name (quote sub1)) (sub1 (first vals))) + ((eq? name (quote number?)) (number? (first vals)))))) + +(first '(a b)) +(apply-primitive 'null? '(())) ; #t +(*application '(null? 2) '()) ; #f +(*application '(cdr (quote (a b))) '()) ; (b) +(*application '(eq? 2 (add1 1)) '()) ; #t + +(define :atom? + (lambda (x) + (cond + ((atom? x) #t) + ((null? x) #f) + ((eq? (car x) (quote primitive)) #t) + ((eq? (car x) (quote non-primitive)) #t) + (else #f)))) + +(define apply-closure + (lambda (closure vals) + (meaning (body-of closure) + (extend-table (new-entry (formals-of closure) vals) + (table-of closure))))) + +(value '(zero? 0)) +(value '(eq? 1 1)) +(value '#f) ; #f +(value '(eq? 2 (add1 1))) ; #t + +(value '((lambda (a b) (a (add1 b))) (lambda (c) (add1 c)) 4)) ; 6 + +(value '((lambda (x) x) 1)) ; 1 + +;wheeee! \ No newline at end of file diff --git a/other/sage-scheme-notes.txt b/other/sage-scheme-notes.txt new file mode 100644 index 0000000..0b88a90 --- /dev/null +++ b/other/sage-scheme-notes.txt @@ -0,0 +1,9 @@ + +in sage-###/devel/sage/sage/interfaces/, copy template.py to mitscheme.py +edit all.py and add appropriate objects, strings + +then compile everything: +./sage -b + + + diff --git a/other/seasoned_schemer.scm b/other/seasoned_schemer.scm new file mode 100644 index 0000000..50d882d --- /dev/null +++ b/other/seasoned_schemer.scm @@ -0,0 +1,640 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Play-along log to The Seasoned Schemer by Friedman and Felleisen +; Jan 2008, bryan newbold + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Preface: define and test primative + +(define atom? + (lambda (x) + (and (not (pair? x)) (not (null? x))))) + +(atom? (quote ())) + +(define add1 + (lambda (n) + (+ 1 n))) + +(add1 6) ; 7 + +(define sub1 + (lambda (n) + (- n 1))) + +(sub1 7) ; 6 + +; kind of guessing here +(define Y + (lambda (thing) + ((lambda (le) + ((lambda (f) (f f)) + (lambda (f) (le (lambda (x) ((f f) x)))))) + thing))) + +(define eqlist? + (lambda (a b) + (cond + ((and (null? a) (null? b)) #t) + ((or (null? a) (null? b)) #f) + ((and (atom? (car a)) (atom? (car b))) + (and (eqlist? (cdr a) (cdr b)))) + ((or (atom? (car a)) (atom? (car b))) #f) + (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b))))))) + +(eqlist? '(((this) is (a)) nontrivial (list)) + '(((this) is (a)) nontrivial (list))) ; #t + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 01: Welsome Back to the Show + +(define member? + (lambda (a lat) + (cond + ((null? lat) #f) + (else (or (eq? a (car lat)) + (member? a (cdr lat))))))) + +(member? 'a '(1 2 a b c)) ; #t + +(define two-in-a-row? + (lambda (lat) + (cond + ((null? lat) #f) + (else (is-first-b? (car lat) (cdr lat)))))) + +(define is-first-b? + (lambda (a lat) + (cond + ((null? lat) #f) + (else (or (eq? a (car lat)) (two-in-a-row? lat)))))) + +(is-first-b? 'a '(a b)) ; #t +(two-in-a-row? '(this sentance doesn't have that)) ; #f +(two-in-a-row? '(but this one does right right right)) ; #t + +(define two-in-a-row-b? + (lambda (a lat) + (cond + ((null? lat) #f) + (else (or (eq? a (car lat)) (two-in-a-row-b? (car lat) (cdr lat))))))) + +(define two-in-a-row? + (lambda (lat) + (cond + ((null? lat) #f) + (else (two-in-a-row-b? (car lat) (cdr lat)))))) + +(define sum-of-prefixes-b + (lambda (sonssf tup) + (cond + ((null? tup) (quote ())) + (else (cons (+ sonssf (car tup)) + (sum-of-prefixes-b (+ sonssf (car tup)) (cdr tup))))))) + +(define sum-of-prefixes + (lambda (tup) + (sum-of-prefixes-b 0 tup))) + +(sum-of-prefixes '(1 1 1 1)) ; (1 2 3 4) + +;;; {{ The Eleventh Commandment }} +;;; Use additional arguments when a function needs to know what other +;;; arguments to the function have been like so far. + +(define pick + (lambda (n lat) + (cond + ((one? n) (car lat)) + (else (pick (sub1 n) (cdr lat)))))) + +(pick 5 '(a b c d e f g h)) ; e + +(define scramble-b + (lambda (tup rev-pre) + (cond + ((null? tup) (quote ())) + (else + (cons (pick (car tup) (cons (car tup) rev-pre)) + (scramble-b (cdr tup) (cons (car tup) rev-pre))))))) + +(define scramble + (lambda (tup) + (scramble-b tup (quote ())))) + +(scramble '(1 1 1 3 4 2 1 1 9 2)) ; (1 1 1 1 1 4 1 1 1 9) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 12: Take Cover + +(define multirember + (lambda (a lat) + ((Y (lambda (mr) + (lambda (lat) + (cond + ((null? lat) (quote ())) + ((eq? a (car lat)) (mr (cdr lat))) + (else (cons (car lat) (mr (cdr lat)))))))) + lat))) + +(multirember 'pie '(apple pie other pie what kind of pi?)) + +(define multirember + (lambda (a lat) + ((letrec + ((mr (lambda (lat) + (cond + ((null? lat) (quote ())) + ((eq? a (car lat)) + (mr (cdr lat))) + (else (cons (car lat) + (mr (cdr lat)))))))) + mr) + lat))) + +(define multirember + (lambda (a lat) + (letrec + ((mr (lambda (lat) + (cond + ((null? lat) (quote ())) + ((eq? a (car lat)) + (mr (cdr lat))) + (else (cons (car lat) + (mr (cdr lat)))))))) + (mr lat)))) + +; {{ The Twelfth Commandment }} +; Use (letrec ..) to remove arguments that do not change for +; recursive applications. + +(define rember-f + (lambda (test?) + (lambda (a l) + (cond + ((null? l) (quote ())) + ((test? (car l) a) (cdr l)) + (else (cons (car l) + ((rember-f test?) a (cdr l)))))))) + +(define rember-eq? (rember-f eq?)) + +(define multirember-f + (lambda (test?) + (letrec ((m-f (lambda (a lat) + (cond + ((null? lat) (quote ())) + ((test? (car lat) a) (m-f a (cdr lat))) + (else (cons (car lat) + (m-f a (cdr lat)))))))) + m-f))) + +(define member? + (lambda (a lat) + (letrec + ((yes? (lambda (l) + (cond + ((null? l) #f) + ((eq? (car l) a) #t) + (else (yes? (cdr l))))))) + (yes? lat)))) + +(member? 'a '(1 2 3 a b)) ; #t +(member? 'a '(1 2 3 b)) ; #f + +(define union + (lambda (a b) + (cond + ((null? b) a) + ((member? (car b) a) (union a (cdr b))) + (else (union (cons (car b) a) (cdr b)))))) + +(union '(tomatoes and macaroni casserole) '(macaroni and cheese)) + +(define union + (lambda (a b) + (letrec + ((U (lambda (s) + (cond + ((null? s) b) + ((member? (car s) b) (U (cdr s))) + (else (cons (car s) (U (cdr s)))))))) + (U a)))) + +; if member? had the order of its parameters swapped union would no longer work + +(define union + (lambda (a b) + (letrec + ((U (lambda (s) + (cond + ((null? s) b) + ((member? (car s) b) (U (cdr s))) + (else (cons (car s) (U (cdr s))))))) + (member? (lambda (a lat) + (cond + ((null? lat) #f) + ((eq? a (car lat)) #t) + (else (member? a (cdr lat))))))) + (U a)))) + +; {{ The Thirteenth Commandment }} +; Use (letrec ...) to hide and protect functions. + +(define union + (lambda (a b) + (letrec + ((U (lambda (s) + (cond + ((null? s) b) + ((M? (car s) b) (U (cdr s))) + (else (cons (car s) (U (cdr s))))))) + (M? (lambda (x y) + (letrec + ((N? (lambda (lat) + (cond + ((null? lat) #f) + ((eq? x (car lat)) #t) + (else (member? x (cdr lat))))))) + (N? y))))) + (U a)))) + +(define two-in-a-row? + (letrec + ((W (lambda (a lat) + (cond + ((null? lat) #f) + (else (or (eq? (car lat) a) + (W (car lat) + (cdr lat)))))))) + (lambda (lat) + (cond + ((null? lat) #f) + (else (W (car lat) (cdr lat))))))) + +(two-in-a-row? '(are there two in a row here)) ; #f +(two-in-a-row? '(what about around around here)) ; #t +(define sum-of-prefixes + (lambda (tup) + (letrec + ((B (lambda (sum t) + (cond + ((null? t) (quote ())) + (else (cons (+ (car t) sum) (B (+ (car t) sum) (cdr t)))))))) + (B 0 tup)))) + +(sum-of-prefixes '(1 1 1 1 1 1)) ; (1 2 3 4 5 6) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 13: Hop, Skip, and Jump + +(define intersect + (lambda (a b) + (cond + ((null? a) (quote ())) + ((member? (car a) b) + (cons (car a) (intersect (cdr a) b))) + (else (intersect (cdr a) b))))) + +(intersect '(1 2 3 4 a s d f) '(1 a b c d)) ; (1 a d) + +(define intersect + (lambda (a b) + (letrec + ((I (lambda (set) + (cond + ((null? set) (quote ())) + ((member (car set) b) + (cons (car set) (I (cdr set)))) + (else (I (cdr set))))))) + (I a)))) + +(define intersectall + (lambda (lset) + (letrec + ((A (lambda (lset) + (cond + ((null? (cdr lset)) (car lset)) + (else (intersect (car lset) (A (cdr lset)))))))) + (cond + ((null? lset) (quote ())) + (else (A lset)))))) + +(intersectall '(() ())) +(intersectall '( (a b c) (a s d f) (nice day for a walk))) ; (a) + +; (letcc hop ...) is the same as +; (call-with-current-continuation (lambda (hop) ...)) + +(define intersectall + (lambda (lset) + (call-with-current-continuation + (lambda (hop) + (letrec + ((A (lambda (lset) + (cond + ((null? (car lset)) (hop (quote ()))) + ((null? (cdr lset)) (car lset)) + (else (intersect (car lset) (A (cdr lset)))))))) + (cond + ((null? lset) (quote ())) + (else (A lset)))))))) + + +;(define intersectall +; (lambda (lset) +; (letcc hop +; (letrec +; ((A (lambda (lset) +; (cond +; ((null? (car lset)) (hop (quote ()))) +; ((null? (cdr lset)) (car lset)) +; (else (intersect (car lset) (A (cdr lset)))))))) +; (cond +; ((null? lset) (quote ())) +; (else (A lset))))))) + +(intersectall '( (A B C) (A B D) (A B C))) ; (A B) + +; letcc ; not found + +(define intersectall + (lambda (lset) + (call-with-current-continuation + (lambda (hop) + (letrec + ((A (lambda (lset) + (cond + ((null? (car lset)) (hop (quote ()))) + ((null? (cdr lset)) (car lset)) + (else (intersect (car lset) (A (cdr lset))))))) + (I (lambda (a b) + (letrec + ((J (lambda (set) + (cond + ((null? set) (quote ())) + ((member? (car set) b) (J (cdr set))) + (else (cons (car set) (J (cdr set)))))))) + (cond + ((null? b) (hop (quote ()))) + (else (J a))))))) + (cond + ((null? lset) (quote ())) + (else (A lset)))))))) + +(define rember + (lambda (a lat) + (letrec + ((R (lambda (lat) + (cond + ((null? lat) (quote ())) + ((eq? (car lat) a) (cdr lat)) + (else (cons (car lat) (R (cdr lat)))))))) + (R lat)))) + +(rember 'k '(captain kangaroo k)) + +(define rember-up-to-last + (lambda (a lat) + (call-with-current-continuation + (lambda (skip) + (letrec + ((R (lambda (set) + (cond + ((null? set) (quote ())) + ((eq? (car set) a) (skip (R (cdr set)))) + (else (cons (car set) (R (cdr set)))))))) + (R lat)))))) + +(rember-up-to-last 'thing '(wait do we want this thing or that thing last)) +; (last) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 14: Let There be Names + +(define leftmost + (lambda (l) + (cond + ((atom? (car l)) (car l)) + (else (leftmost (car l)))))) + +(leftmost '((second level) first level)) ; second + +(define leftmost + (lambda (set) + (cond + ((null? set) (quote ())) + ((atom? (car set)) (car set)) + (else + (cond + ((atom? (leftmost (car set))) (leftmost (car set))) + (else (leftmost (cdr set)))))))) + +(leftmost '(((() a) ()))) ; a + +(define leftmost + (lambda (set) + (cond + ((null? set) (quote ())) + ((atom? (car set)) (car set)) + (else + (let ((thing (leftmost (car set)))) + (cond + ((atom? thing) thing) + (else (leftmost (cdr set))))))))) + +(define rember1* + (lambda (a l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (cond + ((eq? (car l) a) (cdr l)) + (else (cons (car l) (rember1* a (cdr l)))))) + (else + (let ((tried (rember1* a (car l)))) + (cond + ((eqlist? tried (car l)) + (cons (car l) (rember1* a (cdr l)))) + (else (cons tried (cdr l))))))))) + +(rember1* 'meat '((pasta meat) pasta (noodles meat sauce) meat tomatoes)) +; ((pasta) pasta (noodles meat sauce) meat tomatoes) + +(define depth* + (lambda (l) + (cond + ((null? l) 1) + ((atom? (car l)) (depth* (cdr l))) + (else + (let + ((down (add1 (depth* (car l)))) + (across (depth* (cdr l)))) + (cond + ((> down across) down) + (else across))))))) + +(> 1 2) ; #f +(depth* '(c (b (a b) a) a)) ; 3 + +; this version is redundant! +(define depth* + (lambda (l) + (cond + ((null? l) 1) + (else + (let + ((across (depth* (cdr l)))) + (cond + ((atom? (car l)) across) + (else + (let + ((down (add1 (depth* (car l))))) + (cond + ((> down across) down) + (else across)))))))))) + +(max 1 4) ; 4 + +; {{ The Fifteenth Commandment }} +; Use (let ...) to name the values of repeated expressions in a function +; definition if they may be evaluated twice for one and same use of the +; function. And use (let ...) to name the values of expressions (without +; set!) that are re-evaluated every time a function is used. + +(define depth* + (lambda (l) + (cond + ((null? l) 1) + ((atom? (car l)) (depth* (cdr l))) + (else (max + (add1 (depth* (car l))) + (depth* (cdr l))))))) + +(depth* '(a (b (c d) (e (f g) 4) 4) 4 2 1)) ; 4 + +(define leftmost + (lambda (l) + (call-with-current-continuation + (lambda (skip) + (lm l skip))))) + +(define lm + (lambda (l out) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (out (car l))) + (else (let () + (lm (car l) out) + (lm (cdr l) out)))))) + +(leftmost '((() a) (b c))) ; a + +; could also use a (begin (...) (...) ...) statement instead of +; (let () (...) (...) ...) + +(define leftmost + (lambda (l) + (call-with-current-continuation + (lambda (out) + (letrec ((L (lambda (l) + (cond + ((null? l) (quote ())) + ((atom? (car l)) (out (car l))) + (else (let () + (L (car l)) + (L (cdr l)))))))) + (L l)))))) + +; try is undefined + +;(define rember1* +; (lambda (a l) +; (try oh (rm a l oh) l))) + +(define rember1* + (lambda (a l) + (call-with-current-continuation + (lambda (success) + (begin + (call-with-current-continuation + (lambda (oh) + (success (rm a l oh)))) + l))))) + +(define rm + (lambda (a l oh) + (cond + ((null? l) (oh (quote no))) + ((atom? (car l)) (if (eq? (car l) a) + (cdr l) + (cons (car l) (rm a (cdr l) oh)))) + (else + (call-with-current-continuation + (lambda (success) + (begin + (call-with-current-continuation + (lambda (oh2) + (success (cons (rm a (car l) oh2) (cdr l))))) + (cons (car l) (rm a (cdr l) oh))))))))) + +(rember1* 'green '(jolly green giant)) ; (jolly giant) +(rember1* 'blue '(((is the) (sky)) (ever so (blue da)))) ; good + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Chapter 15: The Difference Between Men and Boys... + +(define x-thing (cons 'chicago (cons 'pizza '()))) + +(set! x-thing 'gone) ; returns (chicago pizza) +(set! x-thing 'skins) + +(set! x-thing 'rings) + +(define gourmand + (lambda (food) + (set! x-thing food) + (cons food + (cons x-thing (quote ()))))) + +(gourmand 'potato) + +(define omnivore + (let ((x-thing (quote soup))) + (lambda (food) + (set! x-thing food) + (cons food (cons x-thing '()))))) + +(omnivore 'bread) +x-thing ; potato + +; {{ The Sixteenth Commandment }} +; Use (set! ...) only with names define in (let ...)s + +; {{ The Seventeenth Commandment }} +; Use (set! x ...) for (let ((x ..)) ..)) only if there is at least one +; (lambda .. between it and the (let ..), or if the new value for x is a +; function that refers to x. + +(define nibbler + (lambda (food) + (let ((x-thing (quote donut))) + (set! x-thing food) + (cons food + (cons x-thing '()))))) + +(nibbler 'boat) +x-thing ; not boat + +(define foody (quote nothing)) + + +(define glutton + (lambda (x-thing) + (set! food x-thing) + (cons (quote more) + (cons x + (cons (quote more) (cons x (quote ()))))))) + +(glutton 'garlic) + + + diff --git a/other/sicm-fall08.html b/other/sicm-fall08.html new file mode 100644 index 0000000..db6c70e --- /dev/null +++ b/other/sicm-fall08.html @@ -0,0 +1,127 @@ + +SICM Material Fall 2008 + +

Functional Relativity, Symbolic Geometry, et al

+Bryan Newbold, bnewbold@mit.edu
+ +http://web.mit.edu/bnewbold/Public/sicm-fall08.html + +

Informal Background

+For the fall of 2008 I'm very interested in investigating gravitation and +other physical theories using functional programming techniques. I find that +formalizing physical systems into a computer model is the best way to solidify +my understanding of the system; using functional languages and techniques +makes the conceptual wall between mathematical abstraction and programming +implementation much lower; the result is a more reusable and general model +well suited for experimentation and exploration. +

+I am planning on getting my undergraduate physics degree in spring 2009, for +which I will need a thesis. I am hoping to develop skills and tools this fall +with which to accomplish Real Live Science over IAP and in the early spring. +

+The stimulus for this course of study was the class +Classical +Mechanics: A Computational Approach taught by G. Sussman and J. Wisdom +at MIT. I had trouble with the later sections +of the book/course and am hoping that now with an eta of math under my belt I +can chip away at it. + +

Potential Fall Projects

+ +Integration of mit-scheme and scmutils into Sage +(yes) +
The Sage math system is an open-source +alternative to Mathematica, Maple, etc. It provides an easy to learn html +notebook interface (as well as command line) and is bundled with a plethora +of high performance libraries (like PARI, GMP, MAXIMA, SINGULAR, see this +list).
+A number of other packages (including common lisp) already have interfaces +based around a fake TTY device; this should be easy with mit-scheme. Or a more +complete object-style interface could be implemented. There is documentation +for writing interfaces +here and here +
+There is a public demo server at sagenb.org, +but it's usually slow. Try this +server instead (user: +ableseaman, password: bottlerum, if you don't want to fill out the form). +Sage has been used in math classes at MIT already; Tim Abbot is working +on "debianizing" the whole system, after which it should be on Athena. +

+ +Exploration of "higher order dynamics" +(possible) +
+I'd like to play with systems involving "higher order dynamics", aka {jerk, +yank, snap, crackle, pop}. These dynamics have become interesting to cosmologists? +
See arxiv one, two, other chaotic pdf. +

+ +General Relativity Simulations: compact bodies, inspirals, precession +(possible) +
Should talk with Lee Finn +@penn, pranesh@mit? Go to +mki journal club. +

+ +Modified Newtonian Dynamics +(possible) +
MOND +was originally proposed to explain the galactic rotation curve +problem; it has been extended as a relativistic field theory as +TeVeS +(Tensor-vector-scalar gravity, described in 2004). +
+I think it would be interesting to implement and play with MOND or other +alternative gravitational theories in a symbolic computation framework. +Assumptions could be checked quickly and easily (eg, behaves like X in the +short distance limit, behaves like Y in the high stress-energy limit). +The process of formalization could also be a good test; if the theory can't +be coded, is it a valid theory? Would also demonstrate that programming tools +are general and can be used to explore non-physical theories. +
See also Henon-Heiles. +

+ +Action Minimization Problems +(possible) +
+Minimization of action over path integrals is a classic hammer in the physics +toolbox (everything looks like an oscillating nail). It might be fun to +play with some old classics like optics or Ohm-ic resistance. +

+ +Basic Quantum Mechanics +(unlikely) +
Methods with Wilkson-Sommerfeld quantization? I don't know enough +QM to go beyond simple, introductory quantum systems, but might be interesting. +

+ +Quantum Computation +(unlikely) +
There is already extensive work done here; see +http://tph.tuwien.ac.at/~oemer/qcl.html

+ + +

Resources

+The SICM text book is free online; +so is the SICP book. +
+There is an unofficial SICM mailing list.
+
+Papers to read? (download) + + + + diff --git a/sage-scheme-notes.txt b/sage-scheme-notes.txt deleted file mode 100644 index 0b88a90..0000000 --- a/sage-scheme-notes.txt +++ /dev/null @@ -1,9 +0,0 @@ - -in sage-###/devel/sage/sage/interfaces/, copy template.py to mitscheme.py -edit all.py and add appropriate objects, strings - -then compile everything: -./sage -b - - - diff --git a/seasoned_schemer.scm b/seasoned_schemer.scm deleted file mode 100644 index 50d882d..0000000 --- a/seasoned_schemer.scm +++ /dev/null @@ -1,640 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Play-along log to The Seasoned Schemer by Friedman and Felleisen -; Jan 2008, bryan newbold - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Preface: define and test primative - -(define atom? - (lambda (x) - (and (not (pair? x)) (not (null? x))))) - -(atom? (quote ())) - -(define add1 - (lambda (n) - (+ 1 n))) - -(add1 6) ; 7 - -(define sub1 - (lambda (n) - (- n 1))) - -(sub1 7) ; 6 - -; kind of guessing here -(define Y - (lambda (thing) - ((lambda (le) - ((lambda (f) (f f)) - (lambda (f) (le (lambda (x) ((f f) x)))))) - thing))) - -(define eqlist? - (lambda (a b) - (cond - ((and (null? a) (null? b)) #t) - ((or (null? a) (null? b)) #f) - ((and (atom? (car a)) (atom? (car b))) - (and (eqlist? (cdr a) (cdr b)))) - ((or (atom? (car a)) (atom? (car b))) #f) - (else (and (eqlist? (car a) (car b)) (eqlist? (cdr a) (cdr b))))))) - -(eqlist? '(((this) is (a)) nontrivial (list)) - '(((this) is (a)) nontrivial (list))) ; #t - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 01: Welsome Back to the Show - -(define member? - (lambda (a lat) - (cond - ((null? lat) #f) - (else (or (eq? a (car lat)) - (member? a (cdr lat))))))) - -(member? 'a '(1 2 a b c)) ; #t - -(define two-in-a-row? - (lambda (lat) - (cond - ((null? lat) #f) - (else (is-first-b? (car lat) (cdr lat)))))) - -(define is-first-b? - (lambda (a lat) - (cond - ((null? lat) #f) - (else (or (eq? a (car lat)) (two-in-a-row? lat)))))) - -(is-first-b? 'a '(a b)) ; #t -(two-in-a-row? '(this sentance doesn't have that)) ; #f -(two-in-a-row? '(but this one does right right right)) ; #t - -(define two-in-a-row-b? - (lambda (a lat) - (cond - ((null? lat) #f) - (else (or (eq? a (car lat)) (two-in-a-row-b? (car lat) (cdr lat))))))) - -(define two-in-a-row? - (lambda (lat) - (cond - ((null? lat) #f) - (else (two-in-a-row-b? (car lat) (cdr lat)))))) - -(define sum-of-prefixes-b - (lambda (sonssf tup) - (cond - ((null? tup) (quote ())) - (else (cons (+ sonssf (car tup)) - (sum-of-prefixes-b (+ sonssf (car tup)) (cdr tup))))))) - -(define sum-of-prefixes - (lambda (tup) - (sum-of-prefixes-b 0 tup))) - -(sum-of-prefixes '(1 1 1 1)) ; (1 2 3 4) - -;;; {{ The Eleventh Commandment }} -;;; Use additional arguments when a function needs to know what other -;;; arguments to the function have been like so far. - -(define pick - (lambda (n lat) - (cond - ((one? n) (car lat)) - (else (pick (sub1 n) (cdr lat)))))) - -(pick 5 '(a b c d e f g h)) ; e - -(define scramble-b - (lambda (tup rev-pre) - (cond - ((null? tup) (quote ())) - (else - (cons (pick (car tup) (cons (car tup) rev-pre)) - (scramble-b (cdr tup) (cons (car tup) rev-pre))))))) - -(define scramble - (lambda (tup) - (scramble-b tup (quote ())))) - -(scramble '(1 1 1 3 4 2 1 1 9 2)) ; (1 1 1 1 1 4 1 1 1 9) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 12: Take Cover - -(define multirember - (lambda (a lat) - ((Y (lambda (mr) - (lambda (lat) - (cond - ((null? lat) (quote ())) - ((eq? a (car lat)) (mr (cdr lat))) - (else (cons (car lat) (mr (cdr lat)))))))) - lat))) - -(multirember 'pie '(apple pie other pie what kind of pi?)) - -(define multirember - (lambda (a lat) - ((letrec - ((mr (lambda (lat) - (cond - ((null? lat) (quote ())) - ((eq? a (car lat)) - (mr (cdr lat))) - (else (cons (car lat) - (mr (cdr lat)))))))) - mr) - lat))) - -(define multirember - (lambda (a lat) - (letrec - ((mr (lambda (lat) - (cond - ((null? lat) (quote ())) - ((eq? a (car lat)) - (mr (cdr lat))) - (else (cons (car lat) - (mr (cdr lat)))))))) - (mr lat)))) - -; {{ The Twelfth Commandment }} -; Use (letrec ..) to remove arguments that do not change for -; recursive applications. - -(define rember-f - (lambda (test?) - (lambda (a l) - (cond - ((null? l) (quote ())) - ((test? (car l) a) (cdr l)) - (else (cons (car l) - ((rember-f test?) a (cdr l)))))))) - -(define rember-eq? (rember-f eq?)) - -(define multirember-f - (lambda (test?) - (letrec ((m-f (lambda (a lat) - (cond - ((null? lat) (quote ())) - ((test? (car lat) a) (m-f a (cdr lat))) - (else (cons (car lat) - (m-f a (cdr lat)))))))) - m-f))) - -(define member? - (lambda (a lat) - (letrec - ((yes? (lambda (l) - (cond - ((null? l) #f) - ((eq? (car l) a) #t) - (else (yes? (cdr l))))))) - (yes? lat)))) - -(member? 'a '(1 2 3 a b)) ; #t -(member? 'a '(1 2 3 b)) ; #f - -(define union - (lambda (a b) - (cond - ((null? b) a) - ((member? (car b) a) (union a (cdr b))) - (else (union (cons (car b) a) (cdr b)))))) - -(union '(tomatoes and macaroni casserole) '(macaroni and cheese)) - -(define union - (lambda (a b) - (letrec - ((U (lambda (s) - (cond - ((null? s) b) - ((member? (car s) b) (U (cdr s))) - (else (cons (car s) (U (cdr s)))))))) - (U a)))) - -; if member? had the order of its parameters swapped union would no longer work - -(define union - (lambda (a b) - (letrec - ((U (lambda (s) - (cond - ((null? s) b) - ((member? (car s) b) (U (cdr s))) - (else (cons (car s) (U (cdr s))))))) - (member? (lambda (a lat) - (cond - ((null? lat) #f) - ((eq? a (car lat)) #t) - (else (member? a (cdr lat))))))) - (U a)))) - -; {{ The Thirteenth Commandment }} -; Use (letrec ...) to hide and protect functions. - -(define union - (lambda (a b) - (letrec - ((U (lambda (s) - (cond - ((null? s) b) - ((M? (car s) b) (U (cdr s))) - (else (cons (car s) (U (cdr s))))))) - (M? (lambda (x y) - (letrec - ((N? (lambda (lat) - (cond - ((null? lat) #f) - ((eq? x (car lat)) #t) - (else (member? x (cdr lat))))))) - (N? y))))) - (U a)))) - -(define two-in-a-row? - (letrec - ((W (lambda (a lat) - (cond - ((null? lat) #f) - (else (or (eq? (car lat) a) - (W (car lat) - (cdr lat)))))))) - (lambda (lat) - (cond - ((null? lat) #f) - (else (W (car lat) (cdr lat))))))) - -(two-in-a-row? '(are there two in a row here)) ; #f -(two-in-a-row? '(what about around around here)) ; #t -(define sum-of-prefixes - (lambda (tup) - (letrec - ((B (lambda (sum t) - (cond - ((null? t) (quote ())) - (else (cons (+ (car t) sum) (B (+ (car t) sum) (cdr t)))))))) - (B 0 tup)))) - -(sum-of-prefixes '(1 1 1 1 1 1)) ; (1 2 3 4 5 6) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 13: Hop, Skip, and Jump - -(define intersect - (lambda (a b) - (cond - ((null? a) (quote ())) - ((member? (car a) b) - (cons (car a) (intersect (cdr a) b))) - (else (intersect (cdr a) b))))) - -(intersect '(1 2 3 4 a s d f) '(1 a b c d)) ; (1 a d) - -(define intersect - (lambda (a b) - (letrec - ((I (lambda (set) - (cond - ((null? set) (quote ())) - ((member (car set) b) - (cons (car set) (I (cdr set)))) - (else (I (cdr set))))))) - (I a)))) - -(define intersectall - (lambda (lset) - (letrec - ((A (lambda (lset) - (cond - ((null? (cdr lset)) (car lset)) - (else (intersect (car lset) (A (cdr lset)))))))) - (cond - ((null? lset) (quote ())) - (else (A lset)))))) - -(intersectall '(() ())) -(intersectall '( (a b c) (a s d f) (nice day for a walk))) ; (a) - -; (letcc hop ...) is the same as -; (call-with-current-continuation (lambda (hop) ...)) - -(define intersectall - (lambda (lset) - (call-with-current-continuation - (lambda (hop) - (letrec - ((A (lambda (lset) - (cond - ((null? (car lset)) (hop (quote ()))) - ((null? (cdr lset)) (car lset)) - (else (intersect (car lset) (A (cdr lset)))))))) - (cond - ((null? lset) (quote ())) - (else (A lset)))))))) - - -;(define intersectall -; (lambda (lset) -; (letcc hop -; (letrec -; ((A (lambda (lset) -; (cond -; ((null? (car lset)) (hop (quote ()))) -; ((null? (cdr lset)) (car lset)) -; (else (intersect (car lset) (A (cdr lset)))))))) -; (cond -; ((null? lset) (quote ())) -; (else (A lset))))))) - -(intersectall '( (A B C) (A B D) (A B C))) ; (A B) - -; letcc ; not found - -(define intersectall - (lambda (lset) - (call-with-current-continuation - (lambda (hop) - (letrec - ((A (lambda (lset) - (cond - ((null? (car lset)) (hop (quote ()))) - ((null? (cdr lset)) (car lset)) - (else (intersect (car lset) (A (cdr lset))))))) - (I (lambda (a b) - (letrec - ((J (lambda (set) - (cond - ((null? set) (quote ())) - ((member? (car set) b) (J (cdr set))) - (else (cons (car set) (J (cdr set)))))))) - (cond - ((null? b) (hop (quote ()))) - (else (J a))))))) - (cond - ((null? lset) (quote ())) - (else (A lset)))))))) - -(define rember - (lambda (a lat) - (letrec - ((R (lambda (lat) - (cond - ((null? lat) (quote ())) - ((eq? (car lat) a) (cdr lat)) - (else (cons (car lat) (R (cdr lat)))))))) - (R lat)))) - -(rember 'k '(captain kangaroo k)) - -(define rember-up-to-last - (lambda (a lat) - (call-with-current-continuation - (lambda (skip) - (letrec - ((R (lambda (set) - (cond - ((null? set) (quote ())) - ((eq? (car set) a) (skip (R (cdr set)))) - (else (cons (car set) (R (cdr set)))))))) - (R lat)))))) - -(rember-up-to-last 'thing '(wait do we want this thing or that thing last)) -; (last) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 14: Let There be Names - -(define leftmost - (lambda (l) - (cond - ((atom? (car l)) (car l)) - (else (leftmost (car l)))))) - -(leftmost '((second level) first level)) ; second - -(define leftmost - (lambda (set) - (cond - ((null? set) (quote ())) - ((atom? (car set)) (car set)) - (else - (cond - ((atom? (leftmost (car set))) (leftmost (car set))) - (else (leftmost (cdr set)))))))) - -(leftmost '(((() a) ()))) ; a - -(define leftmost - (lambda (set) - (cond - ((null? set) (quote ())) - ((atom? (car set)) (car set)) - (else - (let ((thing (leftmost (car set)))) - (cond - ((atom? thing) thing) - (else (leftmost (cdr set))))))))) - -(define rember1* - (lambda (a l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (cond - ((eq? (car l) a) (cdr l)) - (else (cons (car l) (rember1* a (cdr l)))))) - (else - (let ((tried (rember1* a (car l)))) - (cond - ((eqlist? tried (car l)) - (cons (car l) (rember1* a (cdr l)))) - (else (cons tried (cdr l))))))))) - -(rember1* 'meat '((pasta meat) pasta (noodles meat sauce) meat tomatoes)) -; ((pasta) pasta (noodles meat sauce) meat tomatoes) - -(define depth* - (lambda (l) - (cond - ((null? l) 1) - ((atom? (car l)) (depth* (cdr l))) - (else - (let - ((down (add1 (depth* (car l)))) - (across (depth* (cdr l)))) - (cond - ((> down across) down) - (else across))))))) - -(> 1 2) ; #f -(depth* '(c (b (a b) a) a)) ; 3 - -; this version is redundant! -(define depth* - (lambda (l) - (cond - ((null? l) 1) - (else - (let - ((across (depth* (cdr l)))) - (cond - ((atom? (car l)) across) - (else - (let - ((down (add1 (depth* (car l))))) - (cond - ((> down across) down) - (else across)))))))))) - -(max 1 4) ; 4 - -; {{ The Fifteenth Commandment }} -; Use (let ...) to name the values of repeated expressions in a function -; definition if they may be evaluated twice for one and same use of the -; function. And use (let ...) to name the values of expressions (without -; set!) that are re-evaluated every time a function is used. - -(define depth* - (lambda (l) - (cond - ((null? l) 1) - ((atom? (car l)) (depth* (cdr l))) - (else (max - (add1 (depth* (car l))) - (depth* (cdr l))))))) - -(depth* '(a (b (c d) (e (f g) 4) 4) 4 2 1)) ; 4 - -(define leftmost - (lambda (l) - (call-with-current-continuation - (lambda (skip) - (lm l skip))))) - -(define lm - (lambda (l out) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (out (car l))) - (else (let () - (lm (car l) out) - (lm (cdr l) out)))))) - -(leftmost '((() a) (b c))) ; a - -; could also use a (begin (...) (...) ...) statement instead of -; (let () (...) (...) ...) - -(define leftmost - (lambda (l) - (call-with-current-continuation - (lambda (out) - (letrec ((L (lambda (l) - (cond - ((null? l) (quote ())) - ((atom? (car l)) (out (car l))) - (else (let () - (L (car l)) - (L (cdr l)))))))) - (L l)))))) - -; try is undefined - -;(define rember1* -; (lambda (a l) -; (try oh (rm a l oh) l))) - -(define rember1* - (lambda (a l) - (call-with-current-continuation - (lambda (success) - (begin - (call-with-current-continuation - (lambda (oh) - (success (rm a l oh)))) - l))))) - -(define rm - (lambda (a l oh) - (cond - ((null? l) (oh (quote no))) - ((atom? (car l)) (if (eq? (car l) a) - (cdr l) - (cons (car l) (rm a (cdr l) oh)))) - (else - (call-with-current-continuation - (lambda (success) - (begin - (call-with-current-continuation - (lambda (oh2) - (success (cons (rm a (car l) oh2) (cdr l))))) - (cons (car l) (rm a (cdr l) oh))))))))) - -(rember1* 'green '(jolly green giant)) ; (jolly giant) -(rember1* 'blue '(((is the) (sky)) (ever so (blue da)))) ; good - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Chapter 15: The Difference Between Men and Boys... - -(define x-thing (cons 'chicago (cons 'pizza '()))) - -(set! x-thing 'gone) ; returns (chicago pizza) -(set! x-thing 'skins) - -(set! x-thing 'rings) - -(define gourmand - (lambda (food) - (set! x-thing food) - (cons food - (cons x-thing (quote ()))))) - -(gourmand 'potato) - -(define omnivore - (let ((x-thing (quote soup))) - (lambda (food) - (set! x-thing food) - (cons food (cons x-thing '()))))) - -(omnivore 'bread) -x-thing ; potato - -; {{ The Sixteenth Commandment }} -; Use (set! ...) only with names define in (let ...)s - -; {{ The Seventeenth Commandment }} -; Use (set! x ...) for (let ((x ..)) ..)) only if there is at least one -; (lambda .. between it and the (let ..), or if the new value for x is a -; function that refers to x. - -(define nibbler - (lambda (food) - (let ((x-thing (quote donut))) - (set! x-thing food) - (cons food - (cons x-thing '()))))) - -(nibbler 'boat) -x-thing ; not boat - -(define foody (quote nothing)) - - -(define glutton - (lambda (x-thing) - (set! food x-thing) - (cons (quote more) - (cons x - (cons (quote more) (cons x (quote ()))))))) - -(glutton 'garlic) - - - diff --git a/sicm-fall08.html b/sicm-fall08.html deleted file mode 100644 index db6c70e..0000000 --- a/sicm-fall08.html +++ /dev/null @@ -1,127 +0,0 @@ - -SICM Material Fall 2008 - -

Functional Relativity, Symbolic Geometry, et al

-Bryan Newbold, bnewbold@mit.edu
- -http://web.mit.edu/bnewbold/Public/sicm-fall08.html - -

Informal Background

-For the fall of 2008 I'm very interested in investigating gravitation and -other physical theories using functional programming techniques. I find that -formalizing physical systems into a computer model is the best way to solidify -my understanding of the system; using functional languages and techniques -makes the conceptual wall between mathematical abstraction and programming -implementation much lower; the result is a more reusable and general model -well suited for experimentation and exploration. -

-I am planning on getting my undergraduate physics degree in spring 2009, for -which I will need a thesis. I am hoping to develop skills and tools this fall -with which to accomplish Real Live Science over IAP and in the early spring. -

-The stimulus for this course of study was the class -Classical -Mechanics: A Computational Approach taught by G. Sussman and J. Wisdom -at MIT. I had trouble with the later sections -of the book/course and am hoping that now with an eta of math under my belt I -can chip away at it. - -

Potential Fall Projects

- -Integration of mit-scheme and scmutils into Sage -(yes) -
The Sage math system is an open-source -alternative to Mathematica, Maple, etc. It provides an easy to learn html -notebook interface (as well as command line) and is bundled with a plethora -of high performance libraries (like PARI, GMP, MAXIMA, SINGULAR, see this -list).
-A number of other packages (including common lisp) already have interfaces -based around a fake TTY device; this should be easy with mit-scheme. Or a more -complete object-style interface could be implemented. There is documentation -for writing interfaces -here and here -
-There is a public demo server at sagenb.org, -but it's usually slow. Try this -server instead (user: -ableseaman, password: bottlerum, if you don't want to fill out the form). -Sage has been used in math classes at MIT already; Tim Abbot is working -on "debianizing" the whole system, after which it should be on Athena. -

- -Exploration of "higher order dynamics" -(possible) -
-I'd like to play with systems involving "higher order dynamics", aka {jerk, -yank, snap, crackle, pop}. These dynamics have become interesting to cosmologists? -
See arxiv one, two, other chaotic pdf. -

- -General Relativity Simulations: compact bodies, inspirals, precession -(possible) -
Should talk with Lee Finn -@penn, pranesh@mit? Go to -mki journal club. -

- -Modified Newtonian Dynamics -(possible) -
MOND -was originally proposed to explain the galactic rotation curve -problem; it has been extended as a relativistic field theory as -TeVeS -(Tensor-vector-scalar gravity, described in 2004). -
-I think it would be interesting to implement and play with MOND or other -alternative gravitational theories in a symbolic computation framework. -Assumptions could be checked quickly and easily (eg, behaves like X in the -short distance limit, behaves like Y in the high stress-energy limit). -The process of formalization could also be a good test; if the theory can't -be coded, is it a valid theory? Would also demonstrate that programming tools -are general and can be used to explore non-physical theories. -
See also Henon-Heiles. -

- -Action Minimization Problems -(possible) -
-Minimization of action over path integrals is a classic hammer in the physics -toolbox (everything looks like an oscillating nail). It might be fun to -play with some old classics like optics or Ohm-ic resistance. -

- -Basic Quantum Mechanics -(unlikely) -
Methods with Wilkson-Sommerfeld quantization? I don't know enough -QM to go beyond simple, introductory quantum systems, but might be interesting. -

- -Quantum Computation -(unlikely) -
There is already extensive work done here; see -http://tph.tuwien.ac.at/~oemer/qcl.html

- - -

Resources

-The SICM text book is free online; -so is the SICP book. -
-There is an unofficial SICM mailing list.
-
-Papers to read? (download) - - - - diff --git a/to_athena.sh b/to_athena.sh index d3bf910..81c7d98 100755 --- a/to_athena.sh +++ b/to_athena.sh @@ -1,3 +1,3 @@ #!/bin/sh -scp -r journal bnewbold@linux.mit.edu:thesis/ +scp -r main.html journal README bnewbold@linux.mit.edu:thesis/ -- cgit v1.2.3