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!))
Related
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.
The code below is the answer given by the professor for a question in my intro to scheme course but it comes out with an error. Cannot see why.
#!r5rs
(define (make-complex a b) (cons a b))
(define (real x) (car x))
(define (imag x) (cdr x))
(define (complex-sqrt x)
(define (sgn v)
(cond ((< v 0) -1)
((= v 0) 0)
(else 1)))
(let ((root (sqrt (+ (* (real x) (real x))
(* (imag x) (imag x))))))
(make-complex (sqrt (/ (+ (real x) root) 2))
(* (sgn (imag x))
(sqrt (/ (- root (real x)) 2))))))
(complex-sqrt 7)
;; ERROR mcar: contract violation
;; expected: mpair?
;; given: 7
I took a screenshot of the error with trace illustartion while running it in DrRacket.
Here's your code transcribed. Please consider posting the actual code rather than a screenshot in future.
(define (make-complex a b) (cons a b))
(define (real x) (car x))
(define (imag x) (cdr x))
(define (complex-sqrt x)
(define (sgn v)
(cond ((< v 0) -1)
((= v 0) 0)
(else 1)))
(let ((root (sqrt (+ (* (real x) (real x))
(* (imag x) (imag x))))))
(make-complex (sqrt (/ (+ (real x) root) 2))
(* (sgn (imag x))
(sqrt (/ (- root (real x)) 2))))))
Was the (complex-sqrt 7) part provided by your professor too? We're trying to get the square root of a complex number, so we should pass in a complex number:
(complex-sqrt (make-complex 5 2))
'(2.27872385417085 . 0.43884211690225433)
Which according to https://www.wolframalpha.com/input/?i=sqrt(2i%2B5) is correct!
The implementation of complex-sqrt is an unsafe one. What that means is that it assumes you pass it a complex number, in this case something created with make-complex.
To fix this you need to check if the argument is complex:
;; Not 100%. Should use `struct` to not
;; mix with random pairs that happens to have numeric parts
(define (complex? x)
(and (pair? x)
(number? (car x))
(number? (cdr x))))
;; The original code is renamed to unsafe-complex-sqrt
(define (complex-sqrt x)
(if (complex? x)
(unsafe-complex-sqrt x)
(raise-argument-error 'complex-sqrt "complex?" x)))
Now you can test it:
(complex-sqrt (make-complex 7 0))
; ==> (2.6457513110645907 . 0)
(complex-sqrt 7)
; ERROR complex-sqrt: contract violation
; expected: complex?
; given: 7
Perfect. Now it says you have mot passed the required complex number to a function that requires a complex number to work.
So what happend in the original code?
In unsafe-complex-sqrt it uses car and cdr which are safe operations that signal contract violation if the argument x supplied isn't #t for (pair? x).
Racket uses mcons in its #!r5rs implementation and thus the errors refer to every pair/list function in R5RS prefixed with an m since the error doesn't pay attention to renaming.
(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.
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.
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))