Scheme - using apply
(define myobj (create-obj (list (cons "a" (lambda () 1)) (cons "b" (lambda (x) (+ x 2))))))
(myobj "a" '()) ;; => 1
(myobj "b" '(1)) ;; => 3
(define myobj (override myobj (cons "b" (lambda () 11))))
(myobj "a" '()) ;; => 1
(myobj "b" '()) ;; => 11
I thought about something like:
((equal? (car property) "b")
(object "b" '(1)))
instead of sending '(1) as parameter, maybe to send a help-function that will override the method...
((equal? (car property) "b")
(object "b" (help-func)))
I got lost...
I'd go for something like this:
(define (create-obj mlist)
(lambda (method parms)
(case method
((override) (set! mlist (cons parms mlist)))
(else (let ((func (assoc method mlist)))
(if func
(apply (cdr func) parms)
"Error: no such method"))))))
(define myobj (create-obj (list (cons "a" (lambda () 1)) (cons "b" (lambda (x) (+ x 2))))))
(myobj "a" '()) ;; => 1
(myobj "b" '(1)) ;; => 3
(myobj 'override (cons "b" (lambda () 11)))
(myobj "a" '()) ;; => 1
(myobj "b" '()) ;; => 11
Alternatively, without set! but using a second binding:
(define (create-obj mlist)
(lambda (method (parms null))
(case method
((get) mlist)
(else (let ((func (assoc method mlist)))
(if func
(apply (cdr func) parms)
"Error: no such method"))))))
(define (override obj func)
(create-obj (cons func (obj 'get))))
(define myobj (create-obj (list (cons "a" (lambda () 1)) (cons "b" (lambda (x) (+ x 2))))))
(myobj "a" '()) ;; => 1
(myobj "b" '(1)) ;; => 3
(define myobj2 (override myobj (cons "b" (lambda () 11))))
(myobj2 "a" '()) ;; => 1
(myobj2 "b" '()) ;; => 11
EDIT It appears that you're using #lang r5rs:
#lang r5rs
(define (create-obj mlist)
(lambda (method parms)
(case method
((get) mlist)
(else (let ((func (assoc method mlist)))
(if func
(apply (cdr func) parms)
"Error: no such method"))))))
(define (override obj func)
(create-obj (cons func (obj 'get '()))))
(define myobj (create-obj (list (cons "a" (lambda () 1)) (cons "b" (lambda (x) (+ x 2))))))
(display (myobj "a" '())) (newline) ;; => 1
(display (myobj "b" '(1))) (newline) ;; => 3
(define myobj2 (override myobj (cons "b" (lambda () 11))))
(display (myobj2 "a" '())) (newline) ;; => 1
(display (myobj2 "b" '())) (newline) ;; => 11
(newline)
Related
There are lots of manual how to make an input in scheme, but I do not understand how to work with it.
Lets say we have simple txt file as an input
a.txt:
1 2 3
I am calling standard io procedure on it
(let ((p (open-input-file "a.txt")))
(let f ((x (read p))) ; reading from file
(if (eof-object? x) ; check for eof
(begin
(close-input-port p)
'()
)
(cons x (f (read p))))))
output:
'(1 2 3)
Which is something I am looking for, but if I want to make standard pair/list manipulations on it I do not get what I expect:
(let ((p (open-input-file "a.txt")))
(let f ((x (read p))) ; reading from file
(if (eof-object? x) ; check for eof
(begin
(close-input-port p)
'()
)
(cdr
(cons x (f (read p)))))))
output:
'()
How do I get a hold of rest of the list?
Notice that the list you want to manipulate is constructed by the (let ...) expression, ie:
(let ((p ...)) ...) ;; => '(1 2 3)
So, to get the "rest" of the list, you have to apply cdr to the entire let expression, ie:
(cdr (let ((p ...)) ...)) ;; => '(2 3)
There is a difference to applying cdr outside the let expression as opposed to within. When you apply it outside, the let expression first gets evaluated to a list, which cdr then manipulates to get its "rest" values. This is equivalent to writing:
(cdr '(1 2 3)) ;; => '(2 3)
But if you apply it the way you have within its body, then at every recursive call for f, which is where a single cons cell is appended recursively to the list-so-far, you end up chaining a cdr to it, so instead of constructing a chain of cons as follows:
(cons 1 (cons 2 (cons 3 '()))) ;; => '(1 2 3)
you instead construct a chain of the form:
(cdr (cons 1 (cdr (cons 2 (cdr (cons 3 '())))))) ;; => '()
To see how this happens, it is a good idea to either think mentally about, or write down, the execution flow of your program. This enables you to understand what your expressions would evaluate to.
For example, your first let expression can be rewritten to an equivalent function as follows:
(define p (open-input-file "a.txt"))
;; (let f (...) ...) is a named let,
;; and is equivalent to the function below.
(define (f x)
(if (eof-object? x)
'()
(cons x (f (read p)))))
(f (read p))
(close-input-port p)
and its execution flow would look somewhat as follows:
(f (read p))
=> (f 1)
=> (cons 1 (f (read p)))
=> (cons 1 (f 2))
=> (cons 1 (cons 2 (f (read p))))
=> (cons 1 (cons 2 (f 3)))
=> (cons 1 (cons 2 (cons 3 (f (read p)))))
=> (cons 1 (cons 2 (cons 3 (f eof))))
=> (cons 1 (cons 2 (cons 3 '()))) ;; => '(1 2 3)
but if you apply cdr to your recursive call as follows:
(define (f x)
(if (eof-object? x)
'()
(cdr (cons x (f (read p))))))
then the execution would change to the following:
(f (read p))
=> (f 1)
=> (cdr (cons 1 (f (read p))))
=> (cdr (cons 1 (f 2)))
=> (cdr (cons 1 (cdr (cons 2 (f (read p))))))
=> (cdr (cons 1 (cdr (cons 2 (f 3)))))
=> (cdr (cons 1 (cdr (cons 2 (cdr (cons 3 (f (read p))))))))
=> (cdr (cons 1 (cdr (cons 2 (cdr (cons 3 (f eof)))))))
=> (cdr (cons 1 (cdr (cons 2 (cdr (cons 3 '()))))))
=> (cdr (cons 1 (cdr (cons 2 '()))))
=> (cdr (cons 1 '()))
=> '()
Consider the following β-reductor:
(define (normalize v)
(set! count 0)
(set! reflected '())
(reify v))
(define (reify v)
(if (memq v reflected)
(v cancel)
(let ((x (gensym)))
(ABS x (reify (v (reflect x)))))))
(define (reflect e)
(let ((f (lambda (v)
(if (eq? v cancel)
e
(reflect (APP e (reify v)))))))
(set! reflected (cons f reflected))
f))
(define (APP e1 e2) `(,e1 ,e2))
(define (ABS x e) `(lambda (,x) ,e))
(define reflected '())
(define count 0)
(define cancel '(cancel))
(define (gensym)
(set! count (+ 1 count))
(string->symbol (string-append "x" (number->string count))))
I would like to analyze its β-reduction order. However, since I'm not too savvy with Scheme, I would like to see the intermediate terms (right now it only prints the end result) it calculates as pure lambda expressions. I know how to display a line, but I am unable to squeeze a (display term) (newline) in the right spot.
Below are two simple terms that can be used to verify a solution - Church one (λfx.f x) and succ (λnfx.f (n f x)) (I hope I wrote them correctly in Scheme):
(define One
(lambda (f) (lambda (x) (f x))))
(define succ
(lambda (n) (lambda (f) (lambda (x) (f ((n f) x))))))
(normalize (succ One))
Is it possible to display the intermediate terms calculated by this reductor?
No, This is a big-step NBE algorithm (meaning "all at once"). it works by reflecting your term language into the host languages to piggy back on the hosts execution engine.
I just started learning scheme. I'm trying to make a procedure to look for an item in a trinary tree. It returns true if it is found.
Here is what I got so far:
(define nullnode '())
(define leaf (lambda (x) (eqv? '() x) nullnode (list x nullnode nullnode nullnode)))
(define tritree (list 9 (leaf 1) (leaf 2) (leaf 3)))
; (display tritree) => (9 (1 () () ()) (2 () () ()) (3 () () ()))
(define lookup
(lambda (tr x)
(or (eqv? x (car tr))
(and (list? (cdr tr)) (lookup (cadr tr) x)))))
I want to get out of (leaf 1) and go through (leaf 2). How can I do that?
Is there a better way to define my lookup?
This is a straightforward implementation of how to search in a tree, it's just that this time we have three possible subtrees:
(define lookup
(lambda (tr x)
(cond ((null? tr) #f)
((equal? (first tr) x) #t) ; don't use eqv?, equal? is more general
(else
(or (lookup (second tr) x)
(lookup (third tr) x)
(lookup (fourth tr) x))))))
Alternatively, without using cond (and a bit closer to what you had in mind):
(define lookup
(lambda (tr x)
(and (not (null? tr))
(or (equal? (first tr) x)
(lookup (second tr) x)
(lookup (third tr) x)
(lookup (fourth tr) x)))))
And do notice that your implementation of leaf is incorrect, for the above to work you'll have to fix it first:
(define leaf
(lambda (x)
(if (null? x)
nullnode
(list x nullnode nullnode nullnode))))
It works as expected with the sample input:
(lookup tritree 3)
=> #t
(lookup tritree 5)
=> #f
I want to get all sublists that start with a number. So I did
(defun function (list)
(cond
((atom list) nil)
((and (numberq (car list)) (consp (car list)))
(cons (function (car list)) (number (cdr list))) )
((not (and (numberq (car list)) (consp (car list)))) (function (cdr list))) ) )
(function '((3 f g h) l s (v k) (2 m n) (9 d) c))
It returns nil instead of ((3 f g h) (2 m n) (9 d)).
Thank you for your help!
I guess this is roughly what you were trying to do:
(defun f (lst)
(when lst
(let ((e (car lst)))
(if (and (consp e) (numberp (car e)))
(cons e (f (cdr lst)))
(f (cdr lst))))))
Alternatively, you can use remove-if-not:
(defun f (lst)
(remove-if-not
(lambda (e) (and (consp e) (numberp (car e))))
lst))
In both cases, it works as expected:
? (f '((3 f g h) l s (v k) (2 m n) (9 d) c))
((3 F G H) (2 M N) (9 D))
I've been trying this question for a long time but am not getting very far with it. The question is asking to produce a string where all the repeated characters from the inputed string are replaced by a single instance of the character.
For example,
(remove-repeats "aaaab") => "ab"
(remove-repeats "caaabb aa") => "cab a"
Since I 'm trying to do this using accumulative recursion, so far I have:
(define (remove-repeats s)
(local
[(define (remove-repeats-acc s1 removed-so-far)
(cond
[(empty? (string->list s1))""]
[else
(cond
[(equal? (first (string->list s1)) (second (string->list s1)))
(list->string (remove-repeats-acc (remove (second (string->list s1)) (string->list s1)) (add1 removed-so-far)))]
[else (list->string (remove-repeats-acc (rest (string->list s1)) removed-so-far))])]))]
(remove-repeats-acc s 0)))
But this doesn't seem to be right. Please help me modify this to work.
Thank You!!
Strings are a bit annoying to work with, so we wrap it around a worker function that deals with lists instead. This way we can avoid messing around with conversions everywhere.
(define (remove-repeats str)
(list->string (remove-repeats/list (string->list str))))
Now we can define the remove-repeats/list function using a straightforward recursion:
(define (remove-repeats/list xs)
(cond
[(empty? xs) xs]
[(empty? (cdr xs)) xs]
[(equal? (car xs) (cadr xs)) (remove-repeats/list (cdr xs))]
[else (cons (car xs) (remove-repeats/list (cdr xs)))]))
This isn't tail-recursive, but now it should be easier to add accumulator:
(define (remove-repeats str)
(list->string (remove-repeats/list-acc (string->list str) '())))
(define (remove-repeats/list-acc xs acc)
(cond
[(empty? xs) (reverse acc)]
[(empty? (cdr xs)) (reverse (cons (car xs) acc))]
[(equal? (car xs) (cadr xs)) (remove-repeats/list-acc (cdr xs) acc)]
[else (remove-repeats/list-acc (cdr xs) (cons (car xs) acc))]))
Here's a version I'm fond of, in Typed Racket:
#lang typed/racket
(: remove-repeats : String -> String)
(define (remove-repeats s)
(define-values (chars last)
(for/fold: ([chars : (Listof Char) null] [last : (Option Char) #f])
([c (in-string s)] #:when (not (eqv? last c)))
(values (cons c chars) c)))
(list->string (reverse chars)))