Commit d6c51cb3 authored by bbguimaraes's avatar bbguimaraes
Browse files

sicp: section 2.2

parent 2823a41f
(display (cons (cons 1 2)
(cons 3 4)))
(newline)
(display (cons (cons 1
(cons 2 3))
4))
(newline)
(display (cons 1
(cons 2
(cons 3
(cons 4 'nil)))))
(newline)
(define one-through-four (list 1 2 3 4))
(display one-through-four)
(newline)
(display (car one-through-four))
(newline)
(display (cdr one-through-four))
(newline)
(display (car (cdr one-through-four)))
(newline)
(display (cadr one-through-four))
(newline)
(display (cons 10 one-through-four))
(newline)
(display (cons 5 one-through-four))
(newline)
(define (list-ref items n)
(if (= n 0)
(car items)
(list-ref (cdr items) (- n 1))))
(define squares (list 1 4 9 16 25))
(display (list-ref squares 3))
(newline)
(define (length items)
(if (null? items)
0
(+ 1 (length (cdr items)))))
(define odds (list 1 3 5 7))
(display (length odds))
(newline)
(define (length items)
(define (iter a count)
(if (null? a)
count
(iter (cdr a) (+ count 1))))
(iter items 0))
(display (length odds))
(newline)
(define (append list1 list2)
(if (null? list1)
list2
(cons (car list1) (append (cdr list1) list2))))
(display (append squares odds))
(newline)
(display (append odds squares))
(define (scale-list items factor)
(if (null? items)
items
(cons (* (car items) factor)
(scale-list (cdr items) factor))))
(newline)
(newline)
(display (scale-list (list 1 2 3 4 5) 10))
(newline)
(define (map proc items)
(if (null? items)
items
(cons (proc (car items))
(map proc (cdr items)))))
(display (map abs (list -10 2.5 -11.6 17)))
(newline)
(display (map (lambda (x) (* x x))
(list 1 2 3 4)))
(newline)
(define (scale-list items factor)
(map (lambda (x) (* x factor))
items))
(display (scale-list (list 1 2 3 4 5) 10))
(newline)
(display (cons (list 1 2) (list 3 4)))
(newline)
(define (count-leaves x)
(cond ((null? x) 0)
((not (pair? x)) 1)
(else (+ (count-leaves (car x))
(count-leaves (cdr x))))))
(define x (cons (list 1 2) (list 3 4)))
(display (length x))
(newline)
(display (count-leaves x))
(newline)
(display (list x x))
(newline)
(display (length (list x x)))
(newline)
(display (count-leaves (list x x)))
(newline)
(define (scale-tree tree factor)
(cond ((null? tree) tree)
((not (pair? tree)) (* tree factor))
(else (cons (scale-tree (car tree) factor)
(scale-tree (cdr tree) factor)))))
(display (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
10))
(newline)
(define (scale-tree tree factor)
(map (lambda (sub-tree)
(if (pair? sub-tree)
(scale-tree sub-tree factor)
(* sub-tree factor)))
tree))
(display (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
10))
(newline)
(define (sum-odd-squares tree)
(cond ((null? tree) 0)
((not (pair? tree))
(if (odd? tree) (square tree) 0))
(else (+ (sum-odd-squares (car tree))
(sum-odd-squares (cdr tree))))))
(display (sum-odd-squares (list 1 (list 2 (list 3 4) 5) (list 6 7))))
(define (fib n)
(cond ((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1))
(fib (- n 2))))))
(define nil (cdr (list 0)))
(define (even-fibs n)
(define (next k)
(if (> k n)
nil
(let ((f (fib k)))
(if (even? f)
(cons f (next (+ k 1)))
(next (+ k 1))))))
(next 0))
(newline)
(display (even-fibs 10))
(newline)
(display (map square (list 1 2 3 4 5)))
(define (filter predicate sequence)
(cond ((null? sequence) nil)
((predicate (car sequence))
(cons (car sequence)
(filter predicate (cdr sequence))))
(else (filter predicate (cdr sequence)))))
(newline)
(display (filter odd? (list 1 2 3 4 5)))
(define (accumulate op initial sequence)
(if (null? sequence)
initial
(op (car sequence)
(accumulate op initial (cdr sequence)))))
(newline)
(display (accumulate + 0 (list 1 2 3 4 5)))
(newline)
(display (accumulate * 1 (list 1 2 3 4 5)))
(newline)
(display (accumulate cons nil (list 1 2 3 4 5)))
(define (enumerate-interval low high)
(if (> low high)
nil
(cons low (enumerate-interval (+ low 1) high))))
(newline)
(display (enumerate-interval 2 7))
(define (enumerate-tree tree)
(cond ((null? tree) nil)
((not (pair? tree)) (list tree))
(else (append (enumerate-tree (car tree))
(enumerate-tree (cdr tree))))))
(newline)
(display (enumerate-tree (list 1 (list 2 (list 3 4) 5))))
(define (sum-odd-squares tree)
(accumulate +
0
(map square
(filter odd?
(enumerate-tree tree)))))
(newline)
(display (sum-odd-squares (list 1 (list 2 (list 3 4) 5) (list 6 7))))
(define (even-fibs n)
(accumulate cons
nil
(filter even?
(map fib
(enumerate-interval 0 n)))))
(newline)
(display (even-fibs 10))
(define (list-fib-squares n)
(accumulate cons
nil
(map square
(map fib
(enumerate-interval 0 n)))))
(newline)
(display (list-fib-squares 10))
(define (product-of-squares-of-odd-elements sequence)
(accumulate *
1
(map square
(filter odd? sequence))))
(newline)
(display (product-of-squares-of-odd-elements (list 1 2 3 4 5)))
(define (f n)
(accumulate append
nil
(map (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n))))
(newline)
(newline)
(display (f 6))
(define (flatmap proc seq)
(accumulate append nil (map proc seq)))
(define (f n)
(flatmap (lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))
(newline)
(display (f 6))
(define (smallest-divisor n)
(define (find-divisor n test-divisor)
(define (divides? a b)
(= (remainder b a) 0))
(cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1)))))
(find-divisor n 2))
(define (prime? n)
(= n (smallest-divisor n)))
(define (prime-sum? pair)
(prime? (+ (car pair) (cadr pair))))
(define (make-pair-sum pair)
(list (car pair) (cadr pair) (+ (car pair) (cadr pair))))
(define (prime-sum-pairs n)
(map make-pair-sum
(filter prime-sum?
(flatmap
(lambda (i)
(map (lambda (j) (list i j))
(enumerate-interval 1 (- i 1))))
(enumerate-interval 1 n)))))
(newline)
(display (prime-sum-pairs 6))
(define (remove item sequence)
(filter (lambda (x) (not (= x item)))
sequence))
(define (permutations s)
(if (null? s)
(list s)
(flatmap (lambda (x)
(map (lambda (p) (cons x p))
(permutations (remove x s))))
s)))
(newline)
(display (permutations (list 1 2 3)))
(newline)
;(define wave2 (beside wave (flip-vert wave)))
;(define wave4 (below wave2 wave2))
(define (flipped-pairs painter)
(let ((painter2 (beside painter (flip-vert painter))))
(below painter2 painter2)))
;(define wave4 flipped-pairs wave)
(define (right-split painter n)
(if (= n 0)
painter
(let ((smaller (right-split painter (- n 1))))
(beside painter (below smaller smaller)))))
(define (corner-split painter n)
(if (= n 0)
painter
(let ((up (up-split painter (- n 1)))
(right (right-split painter (- n 1))))
(let ((top-left (beside up up))
(bottom-right (below right right))
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))
(define (square-limit painter n)
(let ((quarter (corner-split painter n)))
(let ((half (beside (flip-horiz quarter) quarter)))
(below (flip-vert half) half))))
(define (square-of-four tl tr bl br)
(lambda (painter)
(let ((top (beside (tl painter) (tr painter)))
(bottom (beside (bl painter) (br painter))))
(below bottom top))))
(define (flipped-pairs painter)
(let ((combine4 (square-of-four identity flip-vert
identity flip-vert)))
(combine4 painter)))
(define (square-limit painter n)
(let ((combine4 (square-of-four flip-horiz identity
rotate180 flip-vert)))
(combine4 (corner-split painter n))))
(define (frame-coord-map frame)
(lambda (v)
(add-vect
(origin-frame frame)
(add-vect (scale-vect (xcor-vect v)
(edge1-frame frame))
(scale-vect (ycor-vect v)
(edge2-frame frame))))))
(define (segments->painter segment-list)
(lambda (frame)
(for-each
(lambda (segment)
(draw-line
((frame-coord-map frame) (star-segment segment))
((frame-coord-map frame) (end-segment segment))))
segment-list)))
(define (transform-painter painter origin corner1 corner2)
(lambda (frame)
(let ((m (frame-coord-map frame)))
(let ((new-origin (m origin)))
(painter
(make-frame new-origin
(sub-vect (m corner1) new-origin)
(sub-vect (m corner2) new-origin)))))))
(define (flip-vert painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(define (shrink-to-upper-right painter)
(transform-painter painter
(make-vect 0.5 0.5)
(make-vect 1.0 0.5)
(make-vect 0.5 1.0)))
(define (rotate90 painter)
(transform-painter painter
(make-vect 1.0 0.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(define (square-inwards painter)
(transform-painter painter
(make-vect 0.0 0.0)
(make-vect 0.65 0.35)
(make-vect 0.35 0.65)))
(define (beside painter1 painter2)
(let ((split-point (make-vect 0.5 0.0)))
(let ((paint-left
(transform-painter painter1
(make-vect 0.0 0.0)
split-point
(make-vect 0.0 1.0)))
(paint-right
(transform-painter painter2
split-point
(make-vect 1.0 0.0)
(make-vect 0.5 1.0))))
(lambda (frame)
(paint-left frame)
(paint-right frame)))))
(define (last-pair l)
(if (null? (cdr l))
l
(last-pair (cdr l))))
(display (last-pair (list 23 72 149 34)))
(newline)
(define (reverse l)
(define (iter l result)
(if (null? l)
result
(iter (cdr l) (cons (car l) result))))
(iter l '()))
(display (reverse (list 1 4 9 16 25)))
(newline)
(display (reverse '()))
(newline)
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 100 50 20 10 5 2 1 0.5))
(define (cc amount coin-values)
(define no-more? null?)
(define except-first-denomination cdr)
(define first-denomination car)
(cond ((= amount 0) 1)
((or (< amount 0) (no-more? coin-values)) 0)
(else
(+ (cc amount
(except-first-denomination coin-values))
(cc (- amount
(first-denomination coin-values))
coin-values)))))
(display (cc 100 us-coins))
(newline)
(define (same-parity . l)
(define (iter p l)
(cond ((null? l) l)
((= (remainder (car l) 2) p)
(cons (car l) (iter p (cdr l))))
(else (iter p (cdr l)))))
(iter (remainder (car l) 2) l))
(display (same-parity 1 2 3 4 5 6 7))
(newline)
(display (same-parity 2 3 4 5 6 7))
(newline)
(define (square-list items)
(if (null? items)
items
(cons (* (car items) (car items))
(square-list (cdr items)))))
(display (square-list (list 1 2 3 4)))
(newline)
(define (square-list items)
(map (lambda (x) (* x x)) items))
(display (square-list (list 1 2 3 4)))
(newline)
(define (square-list items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons (square (car things))
answer))))
(iter items '()))
(display (square-list (list 1 2 3 4)))
(newline)
(define (square-list items)
(define (iter things answer)
(if (null? things)
answer
(iter (cdr things)
(cons answer
(square (car things))))))
(iter items '()))
(display (square-list (list 1 2 3 4)))
(newline)
(define (for-each f l)
(cond ((not (null? l))
(f (car l))
(for-each f (cdr l)))))
(for-each (lambda (x) (display x) (newline))
(list 57 312 88))
(display (list 1 (list 2 (list 3 4))))
(newline)
(define l (list 1 3 (list 5 7) 9))
(display l)
(newline)
(display (car (cdaddr l)))
(newline)
(define l (list (list 7)))
(display l)
(newline)
(display (caar l))
(newline)
(define l (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
(display l)
(newline)
(display (cadadr (cadadr (cadadr l))))
(newline)
(define x (list 1 2 3))
(define y (list 4 5 6))
(display (append x y))
(newline)
(display (cons x y))
(newline)
(display (list x y))
(newline)
(define (deep-reverse l)
(define (iter l result)
(cond ((null? l) result)
((not (pair? (car l)))
(iter (cdr l)
(cons (car l) result)))
(else
(iter (cdr l)
(cons (deep-reverse (car l)) result)))))
(iter l '()))
(define x (list (list 1 2) (list 3 4)))
(display x)
(newline)
(display (reverse x))
(newline)
(display (deep-reverse x))
(newline)
(define x (list (list 1 2) (list 3 4)))
(display x)
(newline)
(define (fringe l)
(cond ((null? l) l)
((not (pair? (car l)))
(cons (car l) (fringe (cdr l))))
(else (append (fringe (car l)) (fringe (cdr l))))))
(display (fringe x))
(newline)
(display (fringe (list x x)))
(newline)
(define (make-mobile left right)
(list left right))
(define (make-branch length structure)
(list length structure))
(define (left-branch m) (car m))
(define (right-branch m) (cadr m))
(define (branch-length b) (car b))
(define (branch-structure b) (cadr b))
(define (structure-weight s) (if (pair? s) (total-weight s) s))
(define (total-weight m)
(if (null? m)
0
(+ (structure-weight (branch-structure (left-branch m)))