I'd like my program to put a default value in an argument when the user doesn't type it.
My code so far:
(define nodo%
(class object%
(init INFO)
(init HIJOS)
(init VISITADO?)
(define info INFO)
(define hijos HIJOS)
(define visitado? VISITADO?)
(super-new)))
The arguemen't I'd like to make default is VISITADO?. (Spanish for visited)
init allows for such default arguments:
#lang racket
(define nodo%
(class object%
(init INFO)
(init HIJOS)
(init [VISITADO? #f])
(define info INFO)
(define hijos HIJOS)
(define visitado? VISITADO?)
(define/public (get-visitado?)
visitado?)
(super-new)))
(define n1 (new nodo% [INFO 'a] [HIJOS 'b]))
(send n1 get-visitado?) ; #f
(define n2 (new nodo% [INFO 'a] [HIJOS 'b] [VISITADO? #t]))
(send n2 get-visitado?) ; #t
By the way, you can also use init-field for what you are doing with it:
#lang racket
(define nodo%
(class object%
(init-field info
hijos
[visitado? #f])
(super-new)))
(define n1 (new nodo% [info 'a] [hijos 'b]))
(get-field visitado? n1) ; #f
(define n2 (new nodo% [info 'a] [hijos 'b] [visitado? #t]))
(get-field visitado? n2) ; #t
See the documentation.
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.
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
In practice 3.51 of the SICP, it defines a procedure "show", and use stream-map to create a stream:
(add-to-load-path ".")
(load "stream.scm")
(define (show x)
(display-line x)
x)
(define x0 (stream-enumerate-interval 0 3))
(display-stream x0) ;succ, no error
(stream-map show x0) ;all element printed, but interpreter report error at last
The other staff about streams in stream.scm:
#!/usr/bin/guile
!#
(define (stream-null? s)
(null? s))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (car s))
(stream-map proc (stream-cdr s)))))
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin
(proc (stream-car s))
(stream-for-each proc (stream-cdr s)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (display-line x)
(display x))
(define (stream-car stream) (car stream))
(define (stream-cdr stream) (force (cdr stream)))
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream
low
(stream-enumerate-interval (+ low 1) high))))
(define (stream-filter pred stream)
(cond
((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred (stream-cdr stream))))
(else
(stream-filter pred (stream-cdr stream)))))
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
(define the-empty-stream '())
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream low
(stream-enumerate-interval (+ low 1) high))))
The error is like this:
0123Backtrace:
8 (apply-smob/1 #<catch-closure 557e16ae8c20>)
In ice-9/boot-9.scm:
705:2 7 (call-with-prompt ("prompt") #<procedure 557e16aef6a0 …> …)
In ice-9/eval.scm:
619:8 6 (_ #(#(#<directory (guile-user) 557e16b9e140>)))
In ice-9/boot-9.scm:
2312:4 5 (save-module-excursion #<procedure 557e16b24330 at ice-…>)
3822:12 4 (_)
In stream.scm:
25:8 3 (stream-map #<procedure show (x)> (0 . #<promise (1 . …>))
25:8 2 (stream-map #<procedure show (x)> (1 . #<promise (2 . …>))
25:8 1 (stream-map #<procedure show (x)> (2 . #<promise (3 . …>))
In unknown file:
0 (_ 3 ())
I've no idea why display-stream succeed, but stream-map "show" is fail.
The code is the same as the sample in SICP. The scheme interpreter is 'guile'.
Any ideas? THX
The error disappeared when I moved
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
to the top of the file.
Apparently, in Guile it must be defined above its first use point in the file.
You didn't see the error with stream-enumerate-interval because it is defined twice - the last time below the definition of cons-stream.
Tested in https://ideone.com which uses "guile 2.0.13".
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!))
I have got these functions
(define force!
(lambda (thunk)
(thunk)))
(define stream-head
(lambda (s n)
(if (zero? n)
'()
(cons (car s)
(stream-head (force! (cdr s))
(1- n))))))
(define make-stream
(lambda (seed next)
(letrec ([produce (lambda (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define make-traced-stream
(lambda (seed next)
(letrec ([produce (trace-lambda produce (current)
(cons current
(lambda ()
(produce (next current)))))])
(produce seed))))
(define stream-of-even-natural-numbers
(make-traced-stream 0
(lambda (n)
(+ n 2))))
(define stream-of-odd-natural-numbers
(make-traced-stream 1
(lambda (n)
(+ n 2))))
And I need to make a function that merges the last two, so that if I run
(stream-head (merge-streams stream-of-even-natural-numbers stream-of-odd-natural-numbers) 10)
I must get the output (0 1 2 3 4 5 6 7 8 9).. how is this done?
The best idea I had, which is wrong, have been:
(define merge-streams
(lambda (x y)
(cons (car x)
(merge-streams y (cdr x)))))
Here is a suggestion:
(define (merge-streams s1 s2)
(cond
[(empty-stream? s1) s2)] ; nothing to merge from s1
[(empty-stream? s2) s1)] ; nothing to merge from s2
[else (let ([h1 (stream-car s1)]
[h2 (stream-car s2)])
(cons h1
(lambda ()
(cons h2
(stream-merge (stream-rest s1)
(stream-rest s2))))))]))
It uses some helper functions that must be defined first.