Data-Directed Programming SICP - scheme

I have been trying to comprehend data-directed programming in SICP but couldn't so far. I have some questions about it. This is the original code from SICP:
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2 (cdr subtable))))
(if record (cdr record) false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table(cons (list key-1 (cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)(else (error "Unknown operation: TABLE" m))))
dispatch))
(define (assoc key records)
(cond ((null? records) false)
((equal? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
(define (make-from-real-imag-rectangular x y)
(attach-tag 'rectangular (cons x y)))
(define (make-from-mag-ang-polar r a)
(attach-tag 'polar (cons r a)))
(define (make-from-real-imag x y)
(make-from-real-imag-rectangular x y))
(define (make-from-mag-ang r a)
(make-from-mag-ang-polar r a))
(define attach-tag cons)
(define type-tag car)
(define contents cdr)
(define (install-rectangular-package)
;;internal procedures
(define (real-part z)(car z))
(define (imag-part z)(cdr z))
(define (make-from-real-imag)(cons x y))
(define (magnitude z)
(sqrt (+ (square (real-part z))
(square (imag-part z)))))
(define (angle z)
(atan (imag-part z)(real-part z)))
(define (make-from-mag-ang r a)
(cons (* r (cos a))(* r (sin a))))
;;interface to the rest of the system
(define (tag x)(attach-tag 'rectangular x))
(put 'real-part '(rectangular) real-part)
(put 'imag-part '(rectangular) imag-part)
(put 'magnitude '(rectangular) magnitude)
(put 'angle '(rectangular) angle)
(put 'make-from-real-imag 'rectangular
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'rectangular
(lambda (r a) (tag (make-from-mag-ang r a ))))
'done)
(define (install-polar-package)
;; internal procedures
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-mag-ang r a) (cons r a))
(define (real-part z) (* (magnitude z) (cos (angle z))))
(define (imag-part z) (* (magnitude z) (sin (angle z))))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y)))
(atan y x)))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag 'polar
(lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang 'polar
(lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(install-polar-package)
(install-rectangular-package)
Firstly, I couldn't get how to put an entry to the table using make-from-real-imag or make-from-mag-ang
(put 'make-from-real-imag 'rectangular
(lambda (x y) (tag (make-from-real-imag x y))))
Could you just show me how to call this procedure exactly to put an entry ?
When I call get without putting any entry like this:
(get 'real-part '(rectangular))
it returns (lambda (z) (car z)) why ? It should return as false if there is no entry in the table or is there a problem with my code ?
inside packages there are "interface to the rest of the system" parts in there how put procedure call selectors (real-part, imag-part, magnitude, angle) without any argument ?
(put 'real-part '(polar) real-part)

After I have seen Brian Harvey's cs61a lesson 16 which is about generic operators I have comprehended data directed programming a bit. Here is the youtube link of Brian Harvey's cs61a lesson 16 https://www.youtube.com/watch?v=zgbBNEuHs2w
When we call packages, procedures are put on to the table as lambda functions. That's why when we call (get 'real-part '(rectangular))it returns as (lambda (z) (car z))
So put procedures are called with packages for example(put 'real-part '(polar) real-part) and this procedure takes (define (real-part z) (* (magnitude z) (cos (angle z)))) as argument and put as an entry to the table
These procedures are continuation of above procedures in the book.
(define (map proc items)
(if (null? items)
nil
(cons (proc (car items))
(map proc (cdr items)))))
(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))))))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
To create a complex number for rectangular representation for example I call:
(define c-num1 (make-from-real-imag 5 3))
now we have a c-num1 object as (rectangular 5 . 3)
we can call any operation on this object with apply-generic
for example (apply-generic 'real-part c-num1) we get 5 or (apply-generic 'imag-part c-num1) we get 3 or we directly call (real-part c-num1) which is defined using apply-generic.

Related

How to implement put & get procedure in scheme?

I'm reading sicp book. I'm stuck with section 2.4.3, Data-Directed Programming and Additivity.
As mention in text, the implementation of put and get procedures are given in chapter 3(section 3.3.3) . But I didn't find these procedures, maybe the name of procedure will be different there.
So when I tried to run the code (example) given in book, repl thrown an error as given below:
1 ]=> (make-from-mag-ang 4 5)
;Unbound variable: get
;To continue, call RESTART with an option number:
; (RESTART 3) => Specify a value to use instead of get.
; (RESTART 2) => Define get to a given value.
; (RESTART 1) => Return to read-eval-print level 1.
Here is the code:
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum -- CONTENTS" datum)))
(define (rectangular? z)
(eq? (type-tag z) 'rectangular))
(define (polar? z)
(eq? (type-tag z) 'polar))
(define (install-rectangular-package)
;; internal procedure
(define (real-part z) (car z))
(define (imag-part z) (cdr z))
(define (magnitude z)
(sqrt (+ (square (real-part z)) (square (imag-part z)))))
(define (angle z)
(atan (imag-part z) (real-part z)))
(define (make-from-real-imag x y) (cons x y))
(define (make-from-mag-ang r a)
(cons (* r (cos a)) (* r (sin a))))
;; interface to the rest of the system
(define (tag x) (attach-tag 'rectangular x))
(put 'real-part '(rectangular) real-part)
(put 'imag-part '(rectangular) imag-part)
(put 'magnitude '(rectangular) magnitude)
(put 'angle '(rectangular) angle)
(put 'make-from-real-imag '(rectangular) (lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang '(rectangular) (lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(define (install-polar-package)
;; internal procedure
(define (real-part z) (* (magnitude z) (cos (angle z))))
(define (imag-part z) (* (magnitude z) (sin (angle z))))
(define (magnitude z) (car z))
(define (angle z) (cdr z))
(define (make-from-real-imag x y)
(cons (sqrt (+ (square x) (square y))) (atan y x)))
(define (make-from-mag-ang r a) (cons r a))
;; interface to the rest of the system
(define (tag x) (attach-tag 'polar x))
(put 'real-part '(polar) real-part)
(put 'imag-part '(polar) imag-part)
(put 'magnitude '(polar) magnitude)
(put 'angle '(polar) angle)
(put 'make-from-real-imag '(polar) (lambda (x y) (tag (make-from-real-imag x y))))
(put 'make-from-mag-ang '(polar) (lambda (r a) (tag (make-from-mag-ang r a))))
'done)
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply poc (map contents args))
(error "No method for these types -- APPLY-GENERIC" (list op type-tags))))))
(define (real-part z) (apply-generic 'real-part z))
(define (imag-part z) (apply-generic 'imag-part z))
(define (magnitude z) (apply-generic 'magnitude z))
(define (angle z) (apply-generic 'angle z))
(define (make-from-real-imag x y)
((get 'make-from-real-imag 'rectangular) x y))
(define (make-from-mag-ang r a)
((get 'make-from-mag-ang 'polar) r a))
can anyone tell the actual implementation of these procedure, so that I can move ahead in book? Any help would be appreciated. Thanks
See the section Representing Tables
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation - TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

Not sure if I understand anonymous procedures

(define (map2 liste1 liste2)
(define (gj x y)
(/ (+ x y) 2))
(if (or (null? liste1) (null? liste2))
'()
(cons (gj (car liste1) (car liste2)) (map2 (cdr liste1) (cdr liste2)))))
Is procedure gj an anonymous procedure since it's within another procedure?
gj is not anonymous since it has a name, which happens to be visible only within the scope of map2.
Examples of anonymous procedures would be:
> ((lambda (x) (* 2 x)) 10)
^^^^^^^^^^^^^^^^^^^^
20
or
> (map (lambda (x) (+ x 1)) '(10 20 30))
^^^^^^^^^^^^^^^^^^^^
'(11 21 31)
which have no name and cannot be referred to after the expression in which they are defined.
Note that
(define (gj x y)
(/ (+ x y) 2))
is the same as
(define gj
(lambda (x y)
(/ (+ x y) 2)))
so here the procedure is bound to identifier gj and therefore it's no longer anonymous.

scheme - remove odd atoms from a list

I feel like I'm close but I can't seem to get this right. Any ideas?
ex)
(removeOdd ‘(8 3 (3 7) 5)) => (8, ())
(removeOdd ‘(5 5 2)) => (2)
(define (removeOdd y)
(if (null? y) '()
(if (= (remainder (car y) 2) 0)
(cons (car y) (removeOdd (cdr y)))
(cons removeOdd (cdr y)))
))
This probably won't work for the case with a list being inside another list but I am more concerned about being able to return the list I make with 'cons'
edit - if i switch cons to list it doesn't exactly return the list either.
(define (remove-odd y)
(cond
((null? y) '())
((pair? (car y))
(cons (remove-odd (car y)) (remove-odd (cdr y))))
((= (remainder (car y) 2) 0)
(cons (car y) (remove-odd (cdr y))))
(else (remove-odd (cdr y)))))
(define (removeOdd y)
(if (null? y)
'()
(if (atom? (car y))
(if (= (remainder (car y) 2) 0)
(cons (car y) (removeOdd (cdr y)))
(removeOdd (cdr y))
)
(cons (removeOdd (car y)) (removeOdd (cdr y)))
))
I don't remember actually how to check whether something is atom, but this is what you need.

Where is the error in this Scheme program?

I am getting "Error: Invalid lambda: (lambda (insert-all))."
(define permutations
(lambda (L)
(let
((insert-all
(lambda (e Ls)
(let
((insert-one
(lambda (L)
(letrec
((helper
(lambda(L R)
(if (null? R)
(list (append L(list e)R))
(helper (append L (list (car R) ) ) (cdr R) )
))))
(helper '() L)))))
(apply append(map insert-one Ls)))))))
(cond ((null? L) '() )
((null?(cdr L)) (list L))
(else (insert-all (car L) (permutations ((cdr L))))))))
It is supposed to return all permutations of a given list.
The form that you have provided in not valid scheme. Specifically, your highest-level let form does not have a body. You might be thinking that the cond clause is the body but owing to your parenthesis it is not part of the let. Honestly, this is the fault of your formatting. Here is a 'properly' formatted Scheme form:
(define (permutations L)
(let ((insert-all
(lambda (e Ls)
(let ((insert-one
(lambda (L)
(let helper ((L '()) (R L))
(if (null? R)
(list (append L (list e) R))
(helper (append L (list (car R)))
(cdr R)))))))
(apply append (map insert-one Ls))))))
(cond ((null? L) '())
((null? (cdr L)) (list L))
(else (insert-all (car L)
(permutations (cdr L)))))))
At least it compiles and runs, although it doesn't produce the right answer (although I don't know what the proper input it):
> (permutations '(a b c))
((c b a))
> (permutations '((a b) (1 2)))
(((1 2) (a b)))
Here is an implementation that works:
(define (permutations L)
(define (insert-all e Ls)
(apply append
(map (lambda (e)
(map (lambda (x) (cons e x)) Ls))
e)))
(cond ((null? L) '())
((null? (cdr L)) (map list (car L)))
(else (insert-all (car L)
(permutations (cdr L))))))
> (permutations '((a b) (1 2) (x y)))
((a 1 x) (a 1 y) (a 2 x) (a 2 y) (b 1 x) (b 1 y) (b 2 x) (b 2 y))
The basic structure of your code was fine; just the implementation of your insert-one and helper were lacking.

how would you write the 'last' function using 'accumulate'?

I've been working on the sicp and am trying to write the 'last' function using accumulate
(define (accumulate f x xs)
(if (null? xs)
x
(f (car xs)
(accumulate f x (cdr xs)))))
(last '(1 2 3 4 5)) ;;=> (5)
I tried this but it does not work
(define (last seq)
(accumulate (lambda (x y) x)
'()
seq))
Try this:
(define (last lst)
(accumulate (lambda (x y)
(if (null? y)
(cons x y)
y))
'() lst))

Resources