I have developed a purely functional queue in Lisp (Scheme) as follows:
;Internal functions
(define (delay-cons x s)
(cons x (lambda () s)))
(define (delay-car s)
(car s))
(define (delay-cdr s)
((cdr s)))
(define (delay-append s t)
(if (null? s)
t
(delay-cons (delay-car s) (delay-append (delay-cdr s) t))))
;API
(define (enqueue x q) (delay-append q (delay-cons x empty)))
(define dequeue delay-cdr)
(define peek delay-car)
(define empty '())
(define empty? null?)
delay-cons is similar to cons, but it suspends the evaluation of the tail by wrapping it in a closure. delay-append similarly (delay-append s t) appends t to s by recursive suspensions of the tail.
Consequently each enqueue wraps one layer of closure, making it O(1), each peek simply retrieves a value making it O(1), and each dequeue retrieves and evaluated one closure making it O(1).
I haven't seen this elsewhere; for example in Okasaki's Purely Functional Data Structures the simplest queue is a Banker's Queue which is significantly more complicated than this, and only has amortized O(1) enqueue, peek and dequeue. Which makes me suspicious that there's an error in my reasoning.
Is this data structure sound? Is there a reference for it somewhere?
Edit:
delay-cons is the wrong thing to use in delay-append here; I'm trying to use a function like a macro (thanks Will Ness).
I tried to correct it using
(define (delay-append s t)
(if (null? s)
t
(cons (delay-car s) (lambda () (delay-append (delay-cdr s) t)))))
but this doesn't work with the API.
First, delay-cons can not be a function. It must be a macro. For instance,
(define-syntax s-cons
(syntax-rules ()
((s-cons h t) (cons h (lambda () t)))))
works in MIT Scheme.
But you get around this by not using delay-cons in your delay-append:
(define (delay-append s t)
(if (null? s)
t
(cons (delay-car s) (lambda () (delay-append (delay-cdr s) t)))))
So it's OK.
As for complexities, delay-append is not without cost. It wraps around the original queue. Imagine it had 30 elements; then you append 10 more, one by one. Now the original is wrapped in 10 layers of delay-append, which must be navigated to get at each of those 30 elements (29 actually, as the head is pulled out into the immediate car, by the delay-append). So for n-appended, n-accessed use pattern, it looks like a quadratic complexity.
The classic treatise of this problem in Haskell context is "Why are difference lists more efficient than regular concatenation?". Your delay-append is similar to "regular concatenation" there:
[] ++ t = t
s ++ t = (head s) : ((tail s) ++ t)
Here's an illustration:
(define (wrap x) (cons x (lambda () () )))
(define (decdr s) ((cdr s)))
(define (app s t) (if (null? s) t
(cons (car s) (lambda () (app (decdr s) t)))))
;; RIGHT NESTING
(app (wrap 1) (app (wrap 2) (app (wrap 3) (wrap 4)))) ==
(app #A=#[1 . (\->())]
(app #B=#[2 . (\->())]
(app #C=#[3 . (\->())] #D=#[4 . (\->())] ))) ==
(app #A# (app #B#
#E=#[3 . (\-> (app (decdr #C#) #D#) )] )) ==
(app #A# #F=#[2 . (\-> (app (decdr #B#) #E#))] ) ==
#G=#[1 . (\-> (app (decdr #A#) #F#))] ;; the return value
;; NOW, (car #G#) is O(1), but what about (decdr #G#)?
(decdr #G#) == (app (decdr #A#) #F#)
== (app () #F#)
== #F# ;; O(1) steps as well
;; LEFT NESTING
(app (app (app (wrap 1) (wrap 2)) (wrap 3)) (wrap 4)) ==
(app (app (app #D=#[1 . (\->())] #C=#[2 . (\->())] )
#B=#[3 . (\->())] )
#A=#[4 . (\->())] ) ==
(app (app #E=#[1 . (\-> (app (decdr #D#) #C#))] #B#) #A#) ==
(app #F=#[1 . (\-> (app (decdr #E#) #B#))] #A#) ==
#G=#[1 . (\-> (app (decdr #F#) #A#))] ;; the return value
;; NOW, (car #G#) is O(1), but what about (decdr #G#)?
(decdr #G#) == (app (decdr #F#) #A#)
== (app (app (decdr #E#) #B#) #A#)
== (app (app (app (decdr #D#) #C#) #B#) #A#)
== ... ;; O(N) steps, re-creating the left-nesting structure
Related
This question already has answers here:
Is it possible to implement auto-currying to the Lisp-family languages?
(6 answers)
Closed 2 years ago.
I would like to write functions like this:
(define foo (\ (a b c) (+ a (+ b c))))
get it automatically transformed into this:
(define foo (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c))))))
and use it like this (if possible):
(map (foo 1 2) (interval 1 10))
as if I was writing this:
(map ((foo 1) 2) (interval 1 10))
I don't know how to write macros in scheme, but I'd need to write a function that transforms a quoted expression
(f arg1 arg2 argn)
like this:
(define-macro clambda ;curried lambda
(lambda xs
(if (< (length xs) 2)
(if (eq? 1 (length xs))
(lambda () xs)
(lambda (head xs) (tail xs)))
(lambda (head xs) (clambda (tail xs))))))
How can I do this?
Here is my suggestion for your macro:
(define-syntax \
(syntax-rules ()
[(_ "build" (a) body)
(lambda (a . rest)
(if (null? rest)
body
(error "Too many arguments")))]
[(_ "build" (a b ...) body)
(lambda (a . rest)
(define impl (\ "build" (b ...) body))
(if (null? rest)
impl
(apply impl rest)))]
[(_ (a b ...) body)
(\ "build" (a b ...) body)]
[(_ . rest) (error "Wong use of \\")]))
(define test (\ (a b c) (+ a b c)))
(define partial (test 4 5))
(partial 6) ; ==> 15
This does make the resulting code have more overhead since every lambda will apply the next if it gets more arguments. It also will produce an error if you pass too many arguments since you'd otherwise get the unclear "application, not a procedure"
error you may need to implement.
i would like to ask you for help to complete code below with condition which is testing if lists ws and vs are not equal. If they are not equal so return text false(#f) else process code below. I stared with fulfilling variables len1 and len2 which are counting length of both lists. When i run it i am getting this error: lambda: no expression after a sequence of internal definitions in: lambda What i am doing wrong?
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(if (not (equal? (len1 len2) '#f))
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs)))
sub)
Thanks for help.
length is almost always an anti-pattern in Scheme.
length is a O(n) operation, which is called twice, then you call another O(n) operation, foldl, resulting in a O(3n) process for weighted-sum - far from the ideal minimum O(n). foldl is a nice candidate for many linear computations, but because of the length-matching requirement, you've created a bit of a square-peg-in-a-round-hole situation.
Using a named-let and match*, we write weighted-sum as a O(n) computation -
#lang racket
(define ((weighted-sum . ws) . vs) ;; curried form syntactic sugar
(let loop ((acc 0)
(ws ws)
(vs vs))
(match* (ws vs)
;; both lists have at least one value
[((list w ws ...) (list v vs ...))
(loop (+ acc (* w v))
ws
vs)]
;; both lists are empty
[((list) (list))
acc]
;; any other case
[(_ _)
#f])))
Of course match* is a pretty fancy macro, so I'll show you how to rewrite weighted-sum using a simple cond expression. Get your logical reasoning hat ready: the order of the condition clauses is very important here -
(define ((weighted-sum . ws) . vs)
(let loop ((acc 0)
(ws ws)
(vs vs))
(cond
;; both lists are empty
[(and (null? ws)
(null? vs))
acc]
;; at least one list is empty
[(or (null? ws)
(null? vs))
#f]
;; inductive: both lists have at least one value
[else
(loop (+ acc (* (car ws)
(car vs)))
(cdr ws)
(cdr vs))])))
Both programs have the same output -
((weighted-sum 1 2 3) 1 2 3)
;; 14
((weighted-sum 1 2 3) 1 2)
;; #f
((weighted-sum 1 2) 1 2 3)
;; #f
((weighted-sum))
;; 0
Erase )) after #f . Add )) after len1 len2), and it'll work. (not quite, but close(*))
#f is self-evaluating, you don't need to quote it. Indent the (foldl ...) form which became a part of the if expression now.
Lastly, (if (not A) #f B) is the same as (if A B #f) is the same as (and A B).
You are correct in checking that the lengths of both lists, the carried (sic) and the expected, are equal. I don't see why the lists themselves should be equal, though. They shouldn't, as far I can tell.
(weighted-sum list-of-weights) creates a procedure expecting a list of numbers to calculate its weighted sum using the previously supplied weights.
(*) The corrected code, after a few more fixes, is:
(define (weighted-sum . ws)
(define (sub . vs)
(let ((len1 (length ws)) (len2 (length vs)))
(and (equal? len1 len2)
(foldl
(lambda (i j res) (+ res (* i j)))
0
ws vs))))
sub)
It is highly advisable to install e.g. Racket and use its editor to see and correct the parentheses mismatches etc.
I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo
I just started learning Common Lisp 2 days ago, so please excuse spaghetti code and non-understanding.
My problem is the following: I want to write a function that performs the set-
operation A\B, where A and B sets that are not empty. They are represented by two lists.
So far I came up with this:
(defun myDifference (a b)
(if (null a)
(return-from myDifference) ;when a hits NIL, get outta the whole function
)
(if (not(member (car a) b)) ; if the first element of A ist not in B, add it to a list (which later should be the return)
(cons (car a) '())
)
(myDifference (cdr a) b) ; proceed with the remaining elements of A, until (null a) hits
)
I tried it with:
(myDifference '( 1 2 3) '(1 5 6))
But the output is NIL, whichever lists I try it on.
I suspect the problem occurs in quitting the function.
You have 3 expressions in your my-difference body. The first returns nil if (null a)
The second computes either (list a) or (list), then discards that value.
The third recurses with a changed to (cdr a).
It's clear that this has to return nil since the last one eventuelly recurses with a becoming nil and the recursion then returns nil since that is the default value when you don't supply a value. A better approach would be to make it one expression like this:
(defun my-difference (a b)
(if (null a)
a
(if (not (member (car a) b))
(cons (car a) (my-difference (cdr a) b))
(my-difference (cdr a) b))))
The third part of if is the else part and as you see we nest to get somthing similar to if-elseif-else of other languages. This can be written flatter with cond:
(defun my-difference (a b)
(cond ((null a) a)
((not (member (car a) b))
(cons (car a) (my-difference (cdr a) b)))
(t (my-difference (cdr a) b))))
Can anyone tell me what I need to do here?
(define (count-values abst v)
(cond [(empty? abst) 0]
[else (+ (cond [(equal? v (bae-fn abst)) 1]
(else 0))
(count-values .... v)
(count-values .... v ))]))
I basically need a function that counts the amount of symbols v inside a binary tree
(define bae
(make-bae '+
(make-bae '* (make-bae '+ 4 1)
(make-bae '+ 5 2))
(make-bae '- 6 3)))
(count-values bae '+) => 3
because there are 3 '+ in bae
You need to:
Post the definition of the tree - I'm guessing bae is a struct - don't assume we know your code, post all the relevant information as part of the question
Make sure that the code you post works at least in part - for instance, the (define bae ...) part won't work even if you provided the definition of bae, because of a naming conflict
Follow the recipe for traversing a binary tree, I bet it's right in the text book
The general idea for the solution goes like this, without taking a look at the actual implementation of the code you've done so far is the only help I can give you:
If the tree is empty, then return 0
If the current element's value equals the searched value, add 1; otherwise add 0
Either way, add the value to the result of recursively traversing the left and right subtrees
If you define your data structure recursively, then a recursive count algorithm will naturally arise:
;; Utils
(define (list-ref-at n)
(lambda (l) (list-ref l n)))
(define (eq-to x)
(lambda (y) (eq? x y)))
;; Data Type
(define (make-bae op arg1 arg2)
`(BAE ,op, arg1, arg2))
(define (bae? thing)
(and (list? thing) (eq? 'BAE (car thing)) (= 4 (length thing))))
(define bae-op (list-ref-at 1))
(define bae-arg1 (list-ref-at 2))
(define bae-arg2 (list-ref-at 3))
;; Walk
(define (bae-walk func bae) ;; 'pre-ish order'
(if (not (bae? bae))
(func bae)
(begin
(func (bae-op bae))
(bae-walk func (bae-arg1 bae))
(bae-walk func (bae-arg2 bae)))))
;; Count
(define (bae-count-if pred bae)
(let ((count 0))
(bae-walk (lambda (x)
(if (pred x)
(set! count (+ 1 count))))
bae)
count))
(define (bae-count-if-plus bae)
(bae-count-if (eq-to '+) bae))
> bae
(BAE + (BAE * (BAE + 4 1) (BAE + 5 2)) (BAE - 6 3))
> (bae-count-if-plus bae)
3
;; Find
(define (bae-find-if pred bae)
(call/cc (lambda (exit)
(bae-walk (lambda (x)
(if (pred x) (exit #t)))
bae)
#f)))