Monday, November 19, 2012

SICP exercises that I did during reading (chapters 1 and 2)

#lang racket

;;________________________________________________________________
;;                                                 Simple helpers

(define (double x) (* 2 x))
(define (square x) (* x x))

;;________________________________________________________________
;;                                                        ex. 1.3

(define (sum-of-squares x y) (+ (square x) (square y))) 

(define (smallest x y z)
  (cond
    ((and (< x y) (< x z)) x)
    ((and (< y x) (< y z)) y)
    (else z)))

;; (smallest 5 2 1) ;; 1

(define (sum-of-squared-largest-two x y z) 
  (cond ((= (smallest x y z) x) (sum-of-squares y z)) 
        ((= (smallest x y z) y) (sum-of-squares x z)) 
        ((= (smallest x y z) z) (sum-of-squares x y)))) 

;; (sum-of-squared-largest-two 1 3 4) ;; 25
;; (sum-of-squared-largest-two 4 1 3) ;; 25
;; (sum-of-squared-largest-two 3 4 1) ;; 25

;;________________________________________________________________
;;                                                        ex. 1.6

;; Because new-if is a function, both of its parameters are evaluated before the operation is performed.
;; Since one of the parameters is a call to sqrt-iter, the first operation of which is a call to new-if,
;; an endless loop is formed and the function never completes.

;;________________________________________________________________
;;                                                       ex. 1.12

(define pascal
  (lambda (j n)
    (cond ((= j 0) 1)
          ((= j n) 1)
          (else
           (+ (pascal (- j 1) (- n 1)
                      (pascal j (- n 1))))))))

;;________________________________________________________________
;;                                                       ex. 1.42

(define (compose f g)
  (lambda (x) (f (g x))))

;; ((compose add1 add1) 2) ;; 4

;;________________________________________________________________
;;                                                       ex. 1.43

;; Use types as design guide.
;; [A -> A, number] -> (A -> A) (hint: A -> A indicates procedure)
(define (repeated proc n)
  (if (= n 0)
      (lambda (x) x)  ;; return whatever is passed!
      (lambda (x)     ;; return function
        (proc
         ((repeated proc (- n 1)) x)))))

;; ((repeated square 2) 5) ;; 625

;;________________________________________________________________
;;                                                        ex. 2.5

(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

;; (add-1 zero)

;;________________________________________________________________
;;                                                       ex. 2.17

(define (last-pair lst)
  (define (last-inner lst last)
    (if (null? lst)
      last
      (last-inner (cdr lst) (car lst))))
  (last-inner lst '()))

;; (last-pair '(1 2 3 4 8))

;;________________________________________________________________
;;                                                       ex. 2.18

(define (reverse items) 
  (if (null? items) 
      '() 
      (append (reverse (cdr items)) 
              (list (car items))))) 

;; (reverse '(1 2 3 4))

 
;;________________________________________________________________
;;                                                       ex. 2.23
  
(define (for-each proc items) 
  (cond ((not (null? items)) 
         (proc (car items)) 
         (for-each proc (cdr items))))) 

;; (for-each (lambda (x) (newline) (display x)) (list 1 2 3 4))

;;________________________________________________________________
;;                                                       ex. 2.27

(define (deep-reverse lst) 
  (cond ((null? lst) '()) 
        ((pair? (car lst)) 
         (append          ; it is a pair
          (deep-reverse (cdr lst)) (list (deep-reverse (car lst))))) 
        (else 
         (append          ; not a pair (the same as 'reverse' procedure)
          (deep-reverse (cdr lst)) (list (car lst)))))) 

;; (deep-reverse '((1 2) (3 4) 5 6 7))

;;________________________________________________________________
;;                                                       ex. 2.30

(define (square-tree tree)
  (cond
    ((null? tree) '())
    ((not (pair? tree)) (* tree tree))
    (else
     (cons (square-tree (car tree)) (square-tree (cdr tree))))))

;; (square-tree '(1 (2 (3 4) 5) (6 7)))

(define (square-tree2 tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree2 sub-tree) ;; common way to recure using map
             (* sub-tree sub-tree)))
   tree))

;; (square-tree2 '(1 (2 (3 4) 5) (6 7)))

;;________________________________________________________________
;;                                                       ex. 2.31

(define (tree-map proc tree)
    (cond
      ((null? tree) '())
      ((not (pair? tree)) (proc tree))
      (else
       (cons (tree-map proc (car tree))
             (tree-map proc (cdr tree))))))

(define (square-tree3 tree)
  (tree-map square tree))

;; (square-tree3 '(1 (2 (3 4) 5) (6 7)))

;;________________________________________________________________
;;                                                       ex. 2.32

#| Let's try to find out recursion.
Here are the 8 sets making up the power set (all possible subsets) of {1, 2, 3}. 

{ }, {1}, {2}, {3}, {1, 2}, {1, 3}, {2, 3}, {1, 2, 3}

They're topologically sorted from small to large, but this presentation doesn't illustrate
the inductive structure of power sets. This one does:

{ }, {2}, {3}, {2, 3}
{1}, {1, 2}, {1, 3}, {1, 2, 3}

Note the first of the two rows is the power set of {2, 3}. The second row is the power set
of {2, 3} all over again, except that a 1 has been included in each one. There's the
recursive structure for you: the power set of {1, 2, 3} is really two copies of {2, 3}'s
power set chained together, except that the second copy prepends a 1 onto the front of
each entry. Induction right?
|#

;; The power set of {} is {{}}. That's because the empty
;; set is a subset of itself.
;;
;; The power set of a non-empty set A with first element a is
;; equal to the concatenation of two sets:
;;     - the first set is the power set of A - {a}. This
;;       recursively gives us all those subsets of A that
;;       exclude a.
;;
;;     - the second set is once again the power set of A - {a},
;;       except that {a} has been prepended aka consed to the
;;       front of every subset.
;;
(define (subsets s)
  (if (null? s)
      (list '())   ;; we use 'append' so must be a list
      (let ((rest (subsets (cdr s))))
        (append rest 
                (map (lambda (x) (cons (car s) x)) rest)))))

;; (subsets '(1 2 3)) ;; '(() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

;;________________________________________________________________
;;                                                       ex. 2.33

(define (enumerate-interval low high)
  (if (> low high)
      '()
      (cons low (enumerate-interval (+ low 1) high))))

;; known also as 'fold-right'
(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence)))))

;; (accumulate + 0 '(1 2 3))
;; Hint: Accept 'initial' parameter as 'car part'
;;       Accept 'sequence' parameter as 'cdr part'

(define (a-map p sequence)
  (accumulate (lambda (x y) (cons (p x) y)) '() sequence))

;; (a-map double '(1 2 3))

(define (a-append seq1 seq2)
  (accumulate cons seq2 seq1))

;; (a-append '(1 2 3) '(4 5))

(define (a-lenght sequence)
  (accumulate (lambda (x y) (+ 1 y)) 0 sequence))
  
;; (a-lenght '(4 2 5))
;; (a-lenght '(4 2 5 9 11))

;;________________________________________________________________
;;                                                       ex. 2.35

(define (count-leaves x)
  (cond ((null? x) 0)
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

;; (count-leaves '((1 2) 3 4))

(define (a-count-leaves t)
  (accumulate + 0 (map (lambda (x) 
                         (if (not (pair? x))
                             1
                             (a-count-leaves x)))
                       t)))

;; (a-count-leaves '((1 2) 3 4))

;;________________________________________________________________
;;                                                Nested Mappings

;; like two nested cycles
(define (all-pairs n)
  (accumulate append
              '()
              (map (lambda (i)
                     (map (lambda (j) (list i j))
                          (enumerate-interval 1 (- i 1))))
                   (enumerate-interval 1 n))))

;; (all-pairs 3) ;; ((2 1) (3 1) (3 2))

#|
How to think during development
-----------------------------------

If there are four elements in the original list, there are four elements in the final list
generated by any call to map. We can concatenate the four lists by applying append just
prior to exit. That means we have a partial implementation, and it looks like this:

                                            
(define (permutations items)
  (if (null? items) '(())
      (apply append
             (map function-to-be-determined items))))

This mapping function isn't exactly trivial. It needs to transform an isolated element into
a list of permutations, where every permutation in that list begins with said element. We
can write it as a lambda function, which recognizes that its incoming argument is the
element that needs to be at the front of all the permutations it generates. In order to
generate those permutations, it must remove the element from the list, recursively
generate all of its permutations, and then map over that list so it can cons the
distinguished element on to the front of each of its permutations. Let's write a
standalone lambda that assumes that items is in scope.

(lambda (element)
  (map another-function-to-be-determined (permutations (remove element items))))

(Racket provide function remove)
This inner mapping function is easier... it just needs to cons the incoming element to the
front of each permutation produced by the recursive permutations call. Assuming that
element is in scope, another-function-to-be-determined can be replaced by:

(lambda (permutation)
  (cons element permutation))

Now we put all of this together, to get one mean looking function. (There are dotted
lines surrounding the two lambda functions we wrote, so you have an easier time seeing
how far each one stretches.)
|#

(define (permutations items)
  (if (null? items) '(())       ;; do not forget when use 'append'
      (apply append
             (map (lambda (element)
                    (map (lambda (permutation)
                           (cons element permutation))
                         (permutations (remove element items))))
                  items))))

;; (permutations '(1 2 3)) ;; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

;;________________________________________________________________
;;                                               Picture language

#|
* Data abstraction
  - Separate use of data structure from details of data structure
* Procedural abstraction
  - Capture common patterns of behavior and treat as black box for
    generating new patterns
* Means of combination that satisfy the closure property
  - Create complex combinations, then treat as primitives to support
    new combinations
* Use modularity of components to create new language for particular problem domain

What is a picture?
* Could just create a general procedure to draw collections of line segments
* But want to have flexibility of using any frame to draw in frame so we make a picture be a procedure!
* Captures the procedural abstraction of drawing data within a frame

(define (make-picture seglist)
  (lambda (rect)
    (for-each
     (lambda (segment)
       (let ((b (start-segment segment))
             (e (end-segment segment)))
         (draw-line rect
                    (xcor b)
                    (ycor b)
                    (xcor e)
                    (ycor e))))
     seglist)))

Critical idea about languages and programs design:
This is the approach of stratified design, the notion that a complex system should be structured
as a sequence of levels that are described using a sequence of languages. Each level is constructed
by combining parts that are regarded as primitive at that level, and the parts constructed
at each level are used as primitives at the next level. The language used at each level
of a stratified design has primitives, means of combination, and means of abstraction appropriate
to that level of detail. Stratified design pervades the engineering of complex systems.
|#

;;________________________________________________________________
;;                                                       ex. 2.59

(define (element-of-set? x set)
  (cond ((null? set) false)
        ((equal? x (car set)) true)
        (else (element-of-set? x (cdr set)))))

(define (union-set set1 set2)
  (cond
    ((null? set1) set2) ;; no need to check set2 for null - basic recursion is on set1
    ((element-of-set? (car set1) set2) (union-set (cdr set1) set2))
    (else
     (cons (car set1) (union-set (cdr set1) set2)))))
                       
                       
(define set1 '(1 2 3 4))
(define set2 '(4 5 6))

;; (union-set set1 set2)

;;________________________________________________________________
;;                                                       ex. 2.76

; a. Generic operations with explicit dispatch
; New operations - Requires defining new procedures that explicitly dispatch
; a different procedure for each type.
; New types - Requires adding a new clause in all the existing generic procedures.
;
; b. Data-directed style
; New operations - For each type already present, a new procedure that performs
; the new operation for data belonging to that type should
; be defined and added to the table using put.
; (Adding a new row to the table).
; New types - Operations should be defined for the new type and should be
; added to the table using put. (Adding a new column to the table).
;
; c. Message passing style
; New operations - Each data object already defined should be modified to include
; a clause that dispatches on the new operation.
; New types - Requires adding a new data object that returns a procedure and takes
; into account all the existing operations.
;
; For a system in which new operations are added often, data-directed style is more appropriate.
; For a system that adds new types often, message passing style is more appropriate.

1 comment:

Anonymous said...

All exercises are solved here:

https://github.com/skanev/playground/tree/master/scheme/sicp

cpp (3) cv (1) daily (4) emacs (2) freebsd (4) java (3) javascript (1) JSON (1) linux (2) Lisp (6) misc (8) programming (16) Python (1) SICP (1) source control (4) sql (1) думи (8)