Commit 3d80c9ac authored by bbguimaraes's avatar bbguimaraes
Browse files

sicp: section 2.3

parent c01c4149
(define a 1)
(define b 2)
(display (list a b))
(newline)
(display (list 'a 'b))
(newline)
(display (list 'a b))
(newline)
(display (car '(a b c)))
(newline)
(display (cdr '(a b c)))
(define (memq item x)
(cond ((null? x) false)
((eq? item (car x)) x)
(else (memq item (cdr x)))))
(newline)
(display (memq 'apple '(pear banana prune)))
(newline)
(display (memq 'apple '(x (apple sauce) y apple pear)))
(newline)
(define (variable? e) (symbol? e))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? e) (and (pair? e) (eq? (car e) '+)))
(define (addend e) (cadr e))
(define (augend e) (caddr e))
(define (make-sum a1 a2) (list '+ a1 a2))
(define (product? e) (and (pair? e) (eq? (car e) '*)))
(define (multiplier e) (cadr e))
(define (multiplicand e) (caddr e))
(define (make-product m1 m2) (list '* m1 m2))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
(else (error "unknown expression type -- DERIV" exp))))
(display (deriv '(+ x 3) 'x))
(newline)
(display (deriv '(* x y) 'x))
(newline)
(display (deriv '(* (* x y) (+ x 3)) 'x))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a1 0) a1)
((and (number? a1) (number? a1)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(newline)
(newline)
(display (deriv '(+ x 3) 'x))
(newline)
(display (deriv '(* x y) 'x))
(newline)
(display (deriv '(* (* x y) (+ x 3)) 'x))
(newline)
(define (element-of-set? x set)
(cond ((null? set) false)
((equal? x (car set)) true)
(else (element-of-set? x (cdr set)))))
(define s (list 1 2 3 4 5))
(display (element-of-set? 5 s))
(newline)
(display (element-of-set? 31415 s))
(newline)
(define (element-of-set? x set)
(and (not (null? set))
(or (equal? x (car set))
(element-of-set? x (cdr set)))))
(display (element-of-set? 5 s))
(newline)
(display (element-of-set? 31415 s))
(newline)
(define (adjoin-set x set)
(if (element-of-set? x set)
set
(cons x set)))
(display (adjoin-set 5 s))
(newline)
(display (adjoin-set 31415 s))
(newline)
(define (intersection-set set1 set2)
(cond ((or (null? set1) (null? set2)) '())
((element-of-set? (car set1) set2)
(cons (car set1)
(intersection-set (cdr set1) set2)))
(else (intersection-set (cdr set1) set2))))
(display (intersection-set s (list 1 3 5 31415)))
(newline)
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree0) (caddr tree))
(define (make-tree entry left right)
(list entry left right))
(define (element-of-set? x set)
(cond ((null? set) false)
((= x (entry set)) true)
((< x (entry set))
(element-of-set? x (left-branch set)))
((> x (entry set))
(element-of-set? x (right-branch set)))))
(define (adjoin-set x set)
(cond ((null? set) (make-tree x '() '()))
((= x (entry set)) set)
((< x (entry set))
(make-tree (entry set)
(adjoin-set x (left-branch set))))
((> x (entry set))
(make-tree (entry set)
(left-branch set)
(adjoin-set x (right-branch set))))))
(define (lookup given-key set-of-records)
(cond ((null? set-of-records) false)
((equal? given-key (key (car set-of-records)))
(car set-of-records))
(else (lookup given-key (cdr set-of-records)))))
(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))
(define (make-code-tree left right)
(list left
right
(append (symbols left) (symbols right))
(+ (weight left) (weight right))))
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))
(caddr tree)))
(define (weight tree)
(if (leaf? tree)
(weight-leaf tree)
(cadddr tree)))
(define (decode bits tree)
(define (decode-1 bits current-branch)
(if (null? bits)
'()
(let ((next-branch
(choose-branch (car bits) current-branch)))
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode-1 (cdr bits) tree))
(decode-1 (cdr bits) next-branch)))))
(decode-1 bits tree))
(define (choose-branch bit branch)
(cond ((= bit 0) (left-branch branch))
((= bit 1) (right-branch branch))
(else (error "bad bit -- CHOOSE-BRANCH" bit))))
(define (adjoin-set x set)
(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set)
(adjoin-set x (cdr set))))))
(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjoin-set (make-leaf (car pair)
(cadr pair))
(make-leaf-set (cdr pairs))))))
(display (list 'a 'b 'c))
(newline)
(display (list (list 'george)))
(newline)
(display (cdr '((x1 x2) (y1 y2))))
(newline)
(display (cadr '((x1 x2) (y1 y2))))
(newline)
(display (pair? (car '(a short list))))
(newline)
(display (memq 'red '((red shoes) (blue socks))))
(newline)
(display (memq 'red '(red shoes blue socks)))
(newline)
(display (equal? '(this is a list) '(this is a list)))
(newline)
(display (equal? '(this is a list) '(this (is a) list)))
(newline)
(define (equal? x y)
(if (and (pair? x) (pair? y))
(and (equal? (car x) (car y))
(equal? (cdr x) (cdr y)))
(eq? x y)))
(display (equal? '(this is a list) '(this is a list)))
(newline)
(display (equal? '(this is a list) '(this (is a) list)))
(newline)
(display (car ''abracadabra))
(newline)
(display (car (quote 'abracadabra)))
(newline)
(display (car (quote (quote abracadabra))))
(newline)
(display ''abracadabra)
(newline)
(define (variable? e) (symbol? e))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? e) (and (pair? e) (eq? (car e) '+)))
(define (addend e) (cadr e))
(define (augend e) (caddr e))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a1)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (product? e) (and (pair? e) (eq? (car e) '*)))
(define (multiplier e) (cadr e))
(define (multiplicand e) (caddr e))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
(define (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation b e)
(cond ((=number? e 0) 1)
((and (number? b) (number? e)) (expt b e))
(else (list '** b e))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(make-product
(exponent exp)
(make-exponentiation
(base exp)
(make-sum (exponent exp) '-1)))
(deriv (base exp) var)))
(else (error "unknown expression type -- DERIV" exp))))
(display (deriv '(+ x 3) 'x))
(newline)
(display (deriv '(* x y) 'x))
(newline)
(display (deriv '(* (* x y) (+ x 3)) 'x))
(newline)
(display (deriv '(** (+ x 2) 3) 'x))
(newline)
(define (variable? e) (symbol? e))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? e) (and (pair? e) (eq? (car e) '+)))
(define (addend e) (cadr e))
(define (augend e)
(let ((terms (cddr e)))
(if (null? (cdr terms)) (car terms)
(fold-right make-sum '0 terms))))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a1)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (product? e) (and (pair? e) (eq? (car e) '*)))
(define (multiplier e) (cadr e))
(define (multiplicand e)
(let ((terms (cddr e)))
(if (null? (cdr terms)) (car terms)
(fold-right make-product '1 terms))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
(define (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation b e)
(cond ((=number? e 0) 1)
((and (number? b) (number? e)) (expt b e))
(else (list '** b e))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(make-product
(exponent exp)
(make-exponentiation
(base exp)
(make-sum (exponent exp) '-1)))
(deriv (base exp) var)))
(else (error "unknown expression type -- DERIV" exp))))
(define exp '(+ x y (+ x 3) (* 4 5)))
(display (addend exp))
(newline)
(display (augend exp))
(newline)
(define exp '(* x y (+ x 3) (* 4 5)))
(display (multiplier exp))
(newline)
(display (multiplicand exp))
(newline)
(display "(deriv '(+ x 3) 'x)\n")
(display (deriv '(+ x 3) 'x))
(newline)
(display "(deriv '(* x y) 'x)\n")
(display (deriv '(* x y) 'x))
(newline)
(display "(deriv '(* (* x y) (+ x 3)) 'x)\n")
(display (deriv '(* (* x y) (+ x 3)) 'x))
(newline)
(display "(deriv '(* x y (+ x 3)) 'x)\n")
(display (deriv '(* x y (+ x 3)) 'x))
(newline)
(display "(deriv '(** (+ x 2) 3) 'x)\n")
(display (deriv '(** (+ x 2) 3) 'x))
(newline)
(define (variable? e) (symbol? e))
(define (same-variable? v1 v2)
(and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (sum? e) (and (pair? e) (eq? (car e) '+)))
(define (addend e) (cadr e))
(define (augend e)
(let ((terms (cddr e)))
(if (null? (cdr terms)) (car terms)
(fold-right make-sum '0 terms))))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a1)) (+ a1 a2))
(else (list '+ a1 a2))))
(define (product? e) (and (pair? e) (eq? (car e) '*)))
(define (multiplier e) (cadr e))
(define (multiplicand e)
(let ((terms (cddr e)))
(if (null? (cdr terms)) (car terms)
(fold-right make-product '1 terms))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list '* m1 m2))))
(define (exponentiation? e) (and (pair? e) (eq? (car e) '**)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation b e)
(cond ((=number? e 0) 1)
((and (number? b) (number? e)) (expt b e))
(else (list '** b e))))
(define (=number? exp num)
(and (number? exp) (= exp num)))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(make-product
(exponent exp)
(make-exponentiation
(base exp)
(make-sum (exponent exp) '-1)))
(deriv (base exp) var)))
(else (error "unknown expression type -- DERIV" exp))))
(display (deriv '(+ x 3) 'x))
(newline)
(display (deriv '(* x y) 'x))
(newline)
(display (deriv '(* (* x y) (+ x 3)) 'x))
(newline)
(display (deriv '(* x y (+ x 3)) 'x))
(newline)
(display (deriv '(** (+ x 2) 3) 'x))
(define (sum? e) (and (pair? e) (eq? (cadr e) '+)))
(define (product? e) (and (pair? e) (eq? (cadr e) '*)))
(define (exponentiation? e) (and (pair? e) (eq? (cadr e) '**)))
(define (addend e) (car e))
(define (multiplier e) (car e))
(define (base e) (car e))
(define (make-sum a1 a2)
(cond ((=number? a1 0) a2)
((=number? a2 0) a1)
((and (number? a1) (number? a1)) (+ a1 a2))
(else (list a1 '+ a2))))
(define (make-product m1 m2)
(cond ((or (=number? m1 0) (=number? m2 0)) 0)
((=number? m1 1) m2)
((=number? m2 1) m1)
((and (number? m1) (number? m2)) (* m1 m2))
(else (list m1 '* m2))))
(define (make-exponentiation b e)
(cond ((=number? e 0) 1)
((and (number? b) (number? e)) (expt b e))
(else (list b '** e))))
(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp)
(if (same-variable? exp var) 1 0))
((sum? exp)
(make-sum (deriv (addend exp) var)
(deriv (augend exp) var)))
((product? exp)
(make-sum
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (deriv (multiplier exp) var)
(multiplicand exp))))
((exponentiation? exp)
(make-product
(make-product
(exponent exp)
(make-exponentiation
(base exp)
(make-sum (exponent exp) '-1)))
(deriv (base exp) var)))
(else (error "unknown expression type -- DERIV" exp))))
(newline)
(newline)
(display (deriv '(x + 3) 'x))
(newline)
(display (deriv '(x * y) 'x))
(newline)
(display (deriv '((x * y) * (x + 3)) 'x))
(newline)
(display (deriv '((x + 2) ** 3) 'x))
(newline)
(display (deriv '(x + (3 * (x + (y + 2)))) 'x))
(newline)
(define (element-of-set? x set)
(and (not (null? set))
(or (equal? x (car set))
(element-of-set? x (cdr set)))))
(define (union-set set1 set2)
(append (filter (lambda (x) (not (element-of-set? x set2))) set1)
set2))
(display (union-set (list 1 3 5 7) (list 2 3 4 6)))
(newline)
(define (element-of-set? x set)
(and (not (null? set))
(or (equal? x (car set))
(element-of-set? x (cdr set)))))
(define s (list 2 3 2 1 3 2 2))
(display (element-of-set? 2 s))
(newline)
(display (element-of-set? 31415 s))
(newline)
(define (adjoin-set x set) (cons x set))
(display (adjoin-set 2 s))
(newline)
(display (adjoin-set 31415 s))
(newline)
(define (intersection-set set1 set2)
(cond ((or (null? set1) (null? set2)) '())
((element-of-set? (car set1) set2)
(cons (car set1)
(intersection-set (cdr set1) set2)))
(else (intersection-set (cdr set1) set2))))
(display (intersection-set s (list 2 3 5 31415)))
(newline)
(define (union-set set1 set2)
(append set1 set2))
(display (union-set (list 1 3 5 7) (list 2 3 4 6)))
(newline)
(define (adjoin-set x set)
(if (or (null? set)
(< x (car set)))
(cons x