I have a macro called compare-and-swap!:
(define-macro (compare-and-swap! l x y)
`(if (> (vector-ref ,l ,x) (vector-ref ,l ,y))
(vector-swap! ,l ,x ,y)))
It works, I'm testing it like this:
(define v (list->vector '(5 4 3 2 1)))
(print v)
(compare-and-swap! v 1 2)
(print v)
I have a function that returns a list of pairs that I can call compare-and-swap! on serially to sort the whole list:
(batcher 8) → ((0 1) (2 3) (0 2) (1 3) (1 2) (4 5) (6 7) (4 6) (5 7) (5 6) (0 4) (2 6) (2 4) (1 5) (3 7) (3 5) (1 2) (3 4) (5 6))
Now I wish to create a macro that generates a lambda that sorts an N element list by calling batcher and doing the compare-and-swap! for each pair.
For example,
(generate-sorter 8)
→
(lambda (l) (begin (compare-and-swap! l 0 1) (compare-and-swap! l 2 3) ...))
→
(lambda (l) (begin (if (> (vector-ref l 0) (vector-ref l 1)) (vector-swap! 0 1)) (if (> (vector-ref l 2) (vector-ref l 3)) (vector-swap! 2 3))) ... )
I made a function that generates the necessary code:
(define generate-sorter (lambda (len)
(list 'lambda '( li ) 'begin (map (lambda (pair) (list 'compare-and-swap! 'li (first pair) (second pair))) (batcher len)))
))
But I don't now how to make it into a macro.
You don't need a macro for this and, in particular, for the 'generate' part. I suspect that you were thinking macro because the result of generate-sorter can vary from call to call and you hoped to encode the result through macro expansion. An alternative is to capture the result in the lexical environment as such:
(define-syntax compare-and-swap!
(syntax-rules ()
((_ l x y)
(when (> (vector-ref l x) (vector-ref l y))
(vector-swap! l x y)))))
(define (generate-sorter n)
(let ((sorters (generate-sorter n)))
(lambda (l)
(for-each (lambda (sorter)
(compare-and-swap! l (car sorter) (card sorter)))
sorters))))
(define sorter-8 (generate-sorter 8))
(sorter-8 <l-thingy>)
-> <sorted-l-thingy>
Related
(define (avg . l)
(/ (apply + l) (length l)))
(define (delist ls)
(apply values ls))
(avg (delist '(1 2 3))) ;;error
(avg 1 2 3) ;; return 2
without call-with-values, can I bind the value returned by values to each parameter in other ways?
can I bind the value returned by values to each parameter in other ways?
Here are most of the ways I know of to bind variables to returned values in Racket:
#lang racket/base
(define (list->values lst) (apply values lst))
(define-values (a b c) (list->values '(1 2 3)))
(displayln (+ a b c))
(let-values ([(d e f) (list->values '(4 5 6))])
(displayln (+ d e f)))
(require racket/match)
(match/values (list->values '(7 8 9))
([x y z] (displayln (+ x y z))))
(require srfi/8)
(receive (i j k) (list->values '(10 11 12)) (displayln (+ i j k)))
(displayln (call-with-values (lambda () (list->values '(13 14 15))) +))
I would like to write a macro to create shorthand syntax for hiding more verbose lambda expressions, but I'm struggling to understand how to write macros (which I realize is an argument against using them).
Given this example:
(define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(define ($ alist name)
(cdr (assoc name alist)))
((lambda (a) (map (lambda (x y z) (+ x y z)) ($ a 'x) ($ a 'y) ($ a 'z))) alist-example)
((lambda (a) (map (lambda (y) (/ y (apply max ($ a 'y)))) ($ a 'y))) alist-example)
I would like to write a macro, with-alist, that would allow me to write the last two expressions similar to this:
(with-alist alist-example (+ x y z))
(with-alist alist-example (/ y (apply max y)))
Any advice or suggestions?
Here is a syntax-rules solution based on the feedback that I received in the other answer and comments:
(define ($ alist name)
(cdr (assoc name alist)))
(define-syntax with-alist
(syntax-rules ()
[(_ alist names expr)
(let ([alist-local alist])
(apply map (lambda names expr)
(map (lambda (name) ($ alist-local name)) (quote names))))]))
Here is some example usage:
> (define alist-example
'((x 1 2 3) (y 4 5 6) (z 7 8 9)))
> (with-alist alist-example (x) (+ x 2))
(3 4 5)
> (with-alist alist-example (x y) (+ x y))
(5 7 9)
> (with-alist alist-example (x y z) (+ x y z))
(12 15 18)
This answer stops short of solving the more complicated example, (with-alist alist-example (/ y (apply max y))), in my question, but I think this is a reasonable approach for my purposes:
> (with-alist alist-example (y) (/ y (apply max ($ alist-example 'y))))
(2/3 5/6 1)
EDIT: After some additional tinkering, I arrived at a slightly different solution that I think will provide more flexibility.
My new macro, npl, expands shorthand expressions into a list of names and procedures.
(define-syntax npl
(syntax-rules ()
[(_ (names expr) ...)
(list
(list (quote names) ...)
(list (lambda names expr) ...))]))
The output of this macro is passed to a regular procedure, with-list-map, that contains most the core functionality in the with-alist macro above.
(define (with-alist-map alist names-proc-list)
(let ([names-list (car names-proc-list)]
[proc-list (cadr names-proc-list)])
(map (lambda (names proc)
(apply map proc
(map (lambda (name) ($ alist name)) names)))
names-list proc-list)))
The 3 examples of with-alist usage above can be captured in a single call to with-alist-map.
> (with-alist-map alist-example
(npl ((x) (+ x 2))
((x y) (+ x y))
((x y z) (+ x y z))))
((3 4 5) (5 7 9) (12 15 18))
The immediate problem I see is that there is no way to tell which bindings to pick. Eg. is apply one of the elements in the alist or is it a global variable? That depends. I suggest you do:
(with-alist ((x y z) '((x 1 2 3) (y 4 5 6) (z 7 8 9)))
(+ x y z))
(let ((z 10))
(with-alist ((x y) alist-example)
(+ x y z)))
And that it should translate to:
(let ((tmp '((x 1 2 3) (y 4 5 6) (z 7 8 9))))
(apply map (lambda (x y z) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y z))))
(let ((z 10))
(let ((tmp alist-example))
(apply map (lambda (x y) (+ x y z))
(map (lambda (name) ($ tmp name)) '(x y)))))
This is then straight forward to do with syntax-rules. Eg. make a pattern and write the replacement. Good luck.
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))
While reading up on some lisp history here From LISP 1 to LISP 1.5, I came across this function:
(define (testr x p f u)
(if (p x)
(f x)
(if (atom? x)
(u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
According to McCarthy, "The difficulty was that when an inner recursion occurred, the value of car[x] wanted was the outer value, but the inner value was actually used. In modern terminology, lexical scoping was wanted, and dynamic scoping was obtained."
I can't quite figure out what "outer value" and "inner value" he is referring to nor can I see how this function misbehaves when evaluated with dynamical scoping. I could understand if the lambda some how shadowed 'x' but it is a function of zero arguments.
(It was quite difficult to actually find this function as it seems to be missing from the webpage itself. It was only after exploring the images.tex file here:http://www-formal.stanford.edu/jmc/history/lisp/images.tex that I found it).
Let's do it in Lisp, here Common Lisp. In Common Lisp it's easy to switch between dynamic and lexical binding.
Lexical Scope
This example uses lexical binding.
(defun testr (x p f u)
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
What should the function do? It should find the right most element in nested lists for which P is true.
CL-USER 36 > (testr '(1 (2 3) 3 (7 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
7
CL-USER 37 > (testr '(1 (2 3) 3 (6 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
3
As you see, the returned values are as expected.
Dynamic Scope
If we use dynamic binding, then this happens:
(defun testr (x p f u)
(declare (special x p f u)) ; use dynamic binding
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (car x) p f u))))))
CL-USER 38 > (testr '(1 (2 3) 3 (6 6 6))
(lambda (y) (and (numberp y) (oddp y)))
#'identity
nil)
Stack overflow (stack size 15998).
If we define ecar like car, but to signal an error when the item is not a cons:
(defun ecar (item)
(if (consp item)
(car item)
(error "Item ~a not a cons" item)))
(defun testr (x p f u)
(declare (special x p f u))
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u)
(testr (cdr x)
p
f
(lambda ()
(testr (ecar x) p f u))))))
CL-USER 52 > (testr '(1 2)
(lambda (y)
(and (numberp y) (oddp y)))
#'identity
nil)
Error: Item NIL not a cons
At the end of the list, x is nil and that's not a cons, so (ecar x) signals an error.
Problem
(defun testr (x p f u)
(declare (special x p f u)) ; use dynamic binding
(if (funcall p x)
(funcall f x)
(if (atom x)
(funcall u) ; INNER: here the lambda function is called
; with dynamic binding, the value of X
; is the current binding of X from
; the current call.
: at the end of a list, X would be NIL.
; Inside the lambda function then X would be NIL, too.
; (car x) -> returns NIL
; then we are in an endless recursion
; OUTER: with lexical binding, the value
; of X would be the value of some
; binding where the function was
; defined and called earlier.
(testr (cdr x)
p
f
(lambda () ; our lambda function
(testr (car x) ; the reference to X
p f u))))))
Simple tracing
Let's see how it visits the elements:
Lexical:
CL-USER 42 > (testr '(1 (2 3) 4 (6 8 10))
(lambda (y)
(print (list :test y))
(and (numberp y) (oddp y)))
#'identity
nil)
(:TEST (1 (2 3) 4 (6 8 10)))
(:TEST ((2 3) 4 (6 8 10)))
(:TEST (4 (6 8 10)))
(:TEST ((6 8 10)))
(:TEST NIL) ; it has reached the end of the top list
(:TEST (6 8 10)) ; it recurses down the rightmost sublist
(:TEST (8 10))
(:TEST (10))
(:TEST NIL) ; end of the rightmost sublist
(:TEST 10) ; checks the elements of the rightmost sublist
(:TEST 8)
(:TEST 6)
(:TEST 4) ; back up, next element of the top list
(:TEST (2 3)) ; next sublist of the top list
(:TEST (3))
(:TEST NIL) ; end of that sublist
(:TEST 3) ; checks right element, found
3
Dynamic:
CL-USER 40 > (testr '(1 (2 3) 4 (6 8 10))
(lambda (y)
(print (list :test y))
(and (numberp y) (oddp y)))
#'identity
nil)
(:TEST (1 (2 3) 4 (6 8 10)))
(:TEST ((2 3) 4 (6 8 10)))
(:TEST (4 (6 8 10)))
(:TEST ((6 8 10)))
(:TEST NIL) ; it reaches the end of the top list
(:TEST NIL) ; it goes into the endless recursion
(:TEST NIL)
(:TEST NIL)
(:TEST NIL)
(:TEST NIL)
...
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))