Scheme

1
???? ????? ????? ????? ???? Scheme

• ????? 9

2
Triplets

• Constructor
• (make-node value down next)
• Selectors
• (value t)
• (down t)
• (next t)

3
skip
1
2
3
4
5
6
7
4
skip code

• (define (skip lst)
• (cond ((null? lst) lst)
• (( (random 2) 1)
• (make-node ________________
• ________________
• ________________ ))
• (else (skip ________________ ))))

(value lst) lst (skip (next lst)) (next lst)
5
skip1

• (define (skip1 lst) (make-node (value lst) lst
  (skip (next lst))))
• Average length (n1)/2
• Running Time ?(n)

6
recursive-skip1
7
recursive-skip1 code

• (define (recursive-skip1 lst)
• (cond ((null? (next lst)) __________ )
• (else ___________________________ )))

lst
(recursive-skip1 (skip1 lst))
8
search
Example search for 5
9
search code

• (define (search x sl)
• (if (null? sl) f
• (let ((v (value sl))
• ((d (down sl))
• ((n (next sl)))
• (cond (( x v) t)
• ((null? n) _________________________
  )
• (else ______________________________
  
• ______________________________
  
• ______________________________
  ))))))

(search x d) (if (lt (value n) x)
(search x n) (search x d) )
10
search analysis

• Average triplets
• about 2n
• more accurate 2n log2(n-1) O(1)
• Average running time
• ?(log2(n) )

11
Triplet by message passing

• (define (make-node v d n)
• (lambda (m)
• (cond ((eq? m value) v)
• ((eq? m down) d)
• ((eq? m next) n)
• (else (error unknown message m))))
• )

12
Adjusting the interface

• (define (value node) (node value))
• (define (down node) (node down))
• (define (next node) (node next))

13
Outline

• Data Directed Programming

14
Multiple Representations of Abstract Data
Example geometrical figures

• Package for handling geometrical figures
• Each figure has a unique data representation
• Support of Generic Operations on figures, such
  as
• Compute figure area
• Compute figure circumference
• Print figure parameters, etc.

15
Implementation 1 tagged data

• Main idea add a tag (symbol) to every figure
  instance
• Generic procedures dispatch on parameter type

(define (area fig) (cond ((eq? 'rectange
(type-tag fig)) (area-rect (contents
fig))) ((eq? 'circle (type-tag fig))
(area-circle (contents fig) .
.))
The system is not additive/modular

• The generic procedures must know about all types.
• If we want to add a new type we need to
• add it to each of the operations,
• be careful with name clashes.

16
Implementation 2 data directed programming

• Main idea work with a table.
• Keep a pointer to the right procedure to call in
  the table, keyed by the operation/type combination

17
Circle implementation
(define (install-circle-package)
Implementation (define PI 3.1415926) (define
(radius circle) (car circle)) (define
(circumference circle) ( 2 PI (radius
circle))) (define (area circle) (let ((r
(radius circle)) ( PI r r))) (define
(fig-display circle) (my-display Circle
radius, (radius circle))) (define (make-circle
radius) (attach-tag 'circle (list radius)))
Interface to the rest of the system (put
'circumference 'circle circumference) (put
'area 'circle area) (put 'fig-display 'circle
fig-display) (put 'make-fig 'circle
make-circle) 'done)
18
Generic procedures
(define (circumference fig) (apply-generic
'circumference fig))
(define (area fig) (apply-generic 'area fig))
(define (fig-display fig) (apply-generic
'fig-display fig))
(define (apply-generic op arg) (let ((tag
(type-tag arg))) (let ((proc (get op tag)))
(if proc (proc (contents arg))
(error "No operation for these
types -- APPLY-GENERIC" (list op
tag))))))
19
Summary Data Directed programming

• Data Directed programming is more modular
• To add a representation, we only need to write
• a package for the new representation without
  
• changing generic procedures. (Execute the
• install procedure once).
• Changes are local.
• No name clashes.
• install-polar-package
• install-rectangular-package
• ..
• Can be extended to support multi-parameter
  generic operations.

20
Generic Arithmetic System
Programs that use numbers
add sub mul div
Generic arithmetic package
add-rat sub-rat mul-rat div-rat
,-,,/
add-poly sub-poly mul-poly div-poly
Rational arithmetic
Ordinary arithmetic
Polynomial arithmetic
List structure and primitive machine arithmetic
21
Rational numbers

• Constructor
• (define (make-rat n d)
• (let ((g (gcd n d)))
• (cons (/ n g) (/ d g))))
• Selectors
• (define (numer x) (car x))
• (define (denom x) (cdr x))

22
Rational Operators

• (define (add-rat x y)
• (make-rat ( ( (numer x) (denom y))
• ( (numer y) (denom x)))
• ( (denom x) (denom y))))
• (define (mul-rat x y)
• (make-rat ( (numer x) (numer y))
• ( (denom x) (denom y))))

23
Rational Package

• (define (install-rational-package)
• internal procedures
• (define (numer x) (car x))
• (define (denom x) (cdr x))
• (define (make-rat n d)...)
• (define (add-rat x y)...)
• (define (mul-rat x y)...)
• ...
• interface to rest of the system
• (define (tag x) (attach-tag 'rational x))
• (put 'add '(rational rational) (lambda (x y)
  (tag (add-rat x y))))
• (put 'mul '(rational rational) (lambda (x y)
  (tag (mul-rat x y))))
• ...
• (put 'make 'rational (lambda (n d) (tag
  (make-rat n d))))
• 'done)
• (define (make-rational n d) ((get 'make
  'rational) n d))

24
Scheme Numbers Package

• ordinary numbers package
• (define (install-scheme-number-package)
• interface to rest of the system
• (define (tag x) (attach-tag scheme-number x))
• (put 'add '(scheme-number scheme-number)
  (lambda (x y) (tag ( x y))))
• (put 'mul '(scheme-number scheme-number)
  (lambda (x y) (tag ( x y))))
• ...
• (put 'make 'scheme-number (lambda (x) (tag x)))
• 'done)
• (define (make-scheme-number n) ((get 'make
  'scheme-number) n))

25
Polynomials
in x
in y
in x
polynomial coefficients
coefficients are polynomials in y
in x
complex coefficients
in x
rational coefficients
26
Representation

• Dense
• (1 2 0 3 2 5)
• Sparse
• ((100 1) (2 3) (0 5))
• Implementation
• (make-polynomial 'x '((100 1) (2 3) (0 5)))
• gt(polynomial x (100 1) (2 3) (0 5))

27
Data Abstraction

• Constructor
• (define (make-poly variable term-list)
• (cons variable term-list))
• Selectors
• (define (variable p) (car p))
• (define (term-list p) (cdr p))
• Predicates
• (define (variable? x) (symbol? x))
• (define (same-variable? v1 v2)
• (and (variable? v1) (variable? v2) (eq?
  v1 v2)))

28
Polynomial Addition

• (define (add-poly p1 p2)
• (if (same-variable? (variable p1)
• (variable p2))
• (make-poly (variable p1)
• (add-terms (term-list p1)
• (term-list p2)))
• (error "Polys not in same var, add-poly"
• (list p1 p2))))

29
Polynomial Multiplication

• (define (mul-poly p1 p2)
• (if (same-variable? (variable p1)
• (variable p2))
• (make-poly (variable p1)
• (mul-terms (term-list p1)
• (term-list p2)))
• (error "Polys not in same var, mul-poly"
• (list p1 p2))))

30
Term list Data Abstraction

• Constructors
• (define (adjoin-term term term-list)
• (if (zero? (coeff term)) term-list
• (cons term term-list)))
• (define (the-empty-termlist) '())
• Selectors
• (define (first-term term-list) (car
  term-list))
• (define (rest-terms term-list) (cdr
  term-list))
• Predicate
• (define (empty-termlist? term-list)
• (null? term-list))

31
Term Data Abstraction

• Constructor
• (define (make-term order coeff)
• (list order coeff))
• Selectors
• (define (order term) (car term))
• (define (coeff term) (cadr term))

32
Term-list Addition

• (define (add-terms L1 L2)
• (cond ((empty-termlist? L1) L2)
• ((empty-termlist? L2) L1)
• (else
• (let ((t1 (first-term L1)) (t2
  (first-term L2)))
• (cond ((gt (order t1) (order t2))
• (adjoin-term
• t1 (add-terms (rest-terms L1)
  L2)))
• ((lt (order t1) (order t2))
• (adjoin-term
• t2 (add-terms L1 (rest-terms
  L2))))
• (else
• (adjoin-term
• (make-term (order t1)
• (add (coeff t1)
  (coeff t2)))
• (add-terms (rest-terms L1)
• (rest-terms
  L2)))))))))

33
Term-list Multiplication

• (define (mul-terms L1 L2)
• (if (empty-termlist? L1)
• (the-empty-termlist)
• (add-terms
• (mul-term-by-all-terms
• (first-term L1)
• L2)
• (mul-terms (rest-terms L1) L2))))

34
Term-list Multiplication

• (define (mul-term-by-all-terms t1 L)
• (if (empty-termlist? L)
• (the-empty-termlist)
• (let ((t2 (first-term L)))
• (adjoin-term
• (make-term ( (order t1) (order t2))
• (mul (coeff t1)
• (coeff t2)))
• (mul-term-by-all-terms
• t1
• (rest-terms L))))))

35
Polynomial package

• (define (install-polynomial-package)
• internal procedures
• (define (make-poly variable term-list)
• (cons variable term-list))
• (define (variable p) (car p))
• (define (term-list p) (cdr p))
• (define (variable? x) ...)
• (define (same-variable? v1 v2) ...)
• (define (adjoin-term term term-list) ...)
• .......
• (define (coeff term) ...)
• (define (add-poly p1 p2) ...)
• ltprocedures used by add-polygt
• (define (mul-poly p1 p2) ...)
• ltprocedures used by mul-polygt

representation of poly
representation of terms and term lists
36
Polynomial package (cont.)

• interface to rest of the system
• (define (tag p) (attach-tag 'polynomial p))
• (put 'add '(polynomial polynomial)
• (lambda (p1 p2) (tag (add-poly p1 p2))))
• (put 'mul '(polynomial polynomial)
• (lambda (p1 p2) (tag (mul-poly p1 p2))))
• (put 'make 'polynomial
• (lambda (var terms)
• (tag (make-poly var terms))))
• 'done)
• (define (make-polynomial var terms)
• ((get 'make 'polynomial) var terms))

37
Applications

• Operators(define (add obj1 obj2)
  (apply-generic add obj1 obj2))(define (mul obj1
  obj2) (apply-generic mul obj1
  obj2))(define (zero obj)
  (apply-generic zero obj))
• Typesrational numbersscheme-numberspolynomials

38
How does it work?

• (add obj1 obj2)
• (apply-generic add obj1 obj2)
• proc (get add (type-of-obj1 type-of-obj2))
• Apply proc on contents of objects
• Returns a data type with an appropriate tag
• Same for mul and zero
• constructor procedures work different (why?)
• (make-rat num den)
• constructor (get make rat)
• Apply constructor on num and den
• Returns an abstract data type with a rat tag

39
Apply Generic - Class Version

• (define (apply-generic op arg)
• (let ((type (type-tag arg)))
• (let ((proc (get op type)))
• (if proc
• (proc (contents arg))
• (error
• "No method for these types --
  APPLY-GENERIC"
• (list op type))))))

40
Apply Generic - Books version

• (define (apply-generic op . args)
• (let ((type-tags (map type-tag args)))
• (let ((proc (get op type-tags)))
• (if proc
• (apply proc (map contents args))
• (error
• "No method for these types --
  APPLY-GENERIC"
• (list op type-tags))))))

41
Do we really need to construct numbers?

• Replace(define (type-tag datum) (car datum))
• With(define (type-tag datum) (cond ((pair?
  datum) (car datum)) ((number? datum)
  'scheme-number) (else
  (error "Bad tagged datum -- TYPE-TAG" datum))))
• Replace(define (contents datum) (cdr datum))
• With(define (contents datum) (cond ((pair?
  datum) (cdr datum)) ((number? datum)
  datum) (else (error "Bad
  tagged datum -- TYPE-TAG" datum))))

42
Constructing numbers (cont.)

• Replace (inside number package) (define (tag x)
  (attach-tag scheme-number x))
• With (define (tag x) x)
• AlternativeReplace (define (attach-tag
  type-tag contents) (cons type-tag
  contents))
• With (define (attach-tag type-tag contents)
  (if (eq? type-tag scheme-number)
  contents (cons type-tag
  contents)))