I wanted to split a sequence using LOOP.
I thought the easiest way would be a loop collecting all elements, but this seems not to be possible with loop.
It would look this way:
(loop for i in '(1 2 3 4 5) with-rest rest
if (not (= i 3))
collect i
else
return (values i rest))
It should return the values (1 2) and (3 4 5)(or maybe (4 5) as second value).
Is there a keyword in loop that can do this (or in the iterate system), or is this only possible by writing new macros (or using tagbody)?
LOOP can destructure lists into head and tail. Then one would not use in, but on. You can also collect into a variable.
CL-USER 13 > (loop for (i . rest) on '(1 2 3 4 5)
if (not (= i 3))
collect i into head
else return (values head (cons i rest)))
(1 2)
(3 4 5)
or
CL-USER 16 > (loop with list = '(1 2 3 4 5)
for i in list
for rest on (rest list)
if (not (= i 3))
collect i into head
else return (values head (cons i rest)))
(1 2)
(3 4 5)
One terse option that avoids LOOP, but traverses part of the list twice:
(let ((tail (member 3 list)))
(values (ldiff tail list) tail))
Related
I wanted to define a new clause for the iterate macro. Something similar to Python's range where you have a start, stop, step. Here's a first try:
(defmacro-clause (for var start start stop stop step step)
(if (minusp step)
`(for ,var from ,start downto ,stop by (- ,step))
`(for ,var from ,start to ,stop by ,step)))
It deals with increasing and decreasing ranges using the to and downto keywords of iterate. (Note that, unlike Python, these include the stop value.)
This works as desired for
(iter (for x start 5 stop 3 step -1)
(collect x))
;; => (5 4 3)
(iter (for x start 2 stop 5 step 1)
(collect x))
;; => (3,4,5)
However it fails for anything like
(let ((a 9)
(b 3)
(c -1))
(iter (for x start a stop b step c)
(collect x)))
Is it a quirk of iterate that it requires explicit numbers in these places? It has no problem with things like
(iter (for x below (+ 3 3) by (+ 1 1))
(collect x))
Concretely my question is, how can I define a new iterate clause that accepts variables which are bound to numbers in these places?
The problem is that you are trying to decide things at macro-expansion time which can't be known then, such as the sign of a variable. In particular you can't write a macro which expands into (part of) another macro depending on anything which is only known at run time, or you can, but that necessarily means you have to call the moral equivalent of eval at run-time, and ... don't do that.
Instead you have to make the decision about which way to count at run-time. This means you can't use any of the (for var from ...) or related clauses because there don't seem to be any which are agnostic about direction (why (for i from 1 to -5 by -1) doesn't work is beyond me but ... well).
So whatever clause you end up with needs to expand into a (for var next ...) clause, I think.
Here is an attempt at such. Disclaimer: not tested very much, I don't use iterate, may explode on contact, poisonous to fish.
(defmacro-driver (for v in-range a to b &optional by s)
(let ((firstp (make-symbol "FIRSTP"))
(value (make-symbol "VALUE"))
(limit (make-symbol "LIMIT"))
(step (make-symbol "STEP")))
`(progn
(with ,firstp = t)
(with ,value = (let ((v ,a))
(unless (numberp v)
(warn "doomed"))
(when (null v)
(warn "extremely doomed"))
v))
(with ,limit = (let ((v ,b))
(unless (numberp v)
(warn "also doomed"))
v))
(with ,step = (let ((v (or ,s (signum (- ,limit ,value)))))
(when (not (numberp v))
(warn "doomed again"))
(when (zerop v)
(warn "zero step"))
(when (not (= (signum v) (signum (- ,limit ,value))))
(warn "likely doomed"))
v))
(,(if generate 'generate 'for)
,v
next (if ,firstp
(progn
(setf ,firstp nil)
,value)
(progn
(incf ,value ,step)
(when (if (> ,step 0)
(>= ,value ,limit)
(<= ,value ,limit))
(terminate))
,value))))))
And now
> (iter (for i in-range 1 to 5 by 2)
(print i))
1
3
nil
> (iter (for i in-range 1 to -1)
(print i))
1
0
nil
> (iter (for i in-range 1 to 5 by -2)
(when (< i -20)
(terminate)))
Warning: likely doomed
nil
Obviously some of the checks could be better.
Let's suppose I have an array - which I will call *my-array* - that looks like this:
#2A((1 2 3)
(4 5 6)
(7 8 9))
and I wish to apply some function f on the subarray
#2A((5 6)
(8 9))
I'd love to be able to write
(f (subarray *my-array* '(1 2) '(1 2))
where subarray takes as arguments:
the original array
a 2-element list with starting point and ending point on the 1st dimension
another 2-element list with starting point and ending point on the 2nd dimension
etc.
I am looking for some way to pass the subarray as argument to function f by reference (or by pointer?) instead of by value.
(The dumb way to address this would be to write a function that creates (in this specific case) a 2*2 array and loops over i and j copying values from the original array. However, if you are dealing relatively large arrays, this would be quite costly.)
I found there exists a cl-slice package but I do not get whether it copies values or accesses data by reference.
Common Lisp has Displaced Arrays which are exactly what you are asking about (see array-displacement &c).
However, in your case, displaces arrays are no help because:
Multidimensional arrays store their components in row-major order; that is, internally a multidimensional array is stored as a one-dimensional array, with the multidimensional index sets ordered lexicographically, last index varying fastest.
This means that your subarray is not a contiguous section of your main array, and, thus, you cannot create another array displaced to it.
PS. If you cannot figure out how cl-slice works, you can use time to see how much memory it uses and make your inference from that.
PPS. It is, in fact, not too hard to whip up something like what you want:
(defmacro slice (array &rest ranges)
"Return an accessor into ARRAY randing in RANGES."
(let ((args (loop for r in ranges collect (gensym "SLICE-ARG-")))
(arr (gensym "SLICE-ARRAY-")))
`(let ((,arr ,array))
(lambda ,args
(aref ,arr
,#(loop for arg in args and (lo hi) in ranges
for range = (- hi lo)
collect
`(progn
(unless (<= 0 ,arg ,range)
(error "~S is out of range [0;~S]" ,arg ,range))
(+ ,lo ,arg))))))))
(defparameter *my-array*
#2A((1 2 3)
(4 5 6)
(7 8 9)))
(defparameter f (slice *my-array* (1 2) (1 2)))
(loop for i from 0 to 1 do
(loop for j from 0 to 1 do
(format t " ~S" (funcall f i j)))
(terpri))
5 6
8 9
As others pointed out, you cannot use displaced arrays for matrices (maybe you could with non-standard functions). But all you need is to change how you interact with the original array. Here are some possibilities.
Sequences of displaced arrays
(defun area (matrix tlx tly brx bry)
;; you may also want to check that all coordinates are valid
;; inside current matrix. You could generalize this function for
;; more dimensions.
(assert (<= tlx tly))
(assert (<= brx bry))
(loop
for y from tly upto bry
collect (make-array (1+ (- brx tlx))
:displaced-to matrix
:displaced-index-offset
(array-row-major-index matrix y tlx))))
(tl means top-left, br means bottom-right).
Then, assuming you define your matrix as follows:
(defparameter *matrix* #2A((1 2 3)
(4 5 6)
(7 8 9)))
... the sub-matrix is obtained as follows:
(area *matrix* 1 1 2 2)
=> (#(5 6) #(8 9))
... and accessed like this:
(aref (nth ROW *) COL)
Any changes to *matrix* is reflected in one of the two displaced arrays, and inversely.
But if you coerce the resulting list as a vector, then you'll have a vector of arrays. This is different from multi-dimensional arrays, but gives you constant time access for rows:
(aref (aref area ROW) COL)
Wrapper closure
Another way to provide a restricted view of the original matrix is to create an accessor function that works only for the ranges of interest:
(defun sub-matrix (matrix tlx tly brx bry)
;; again, you should do more checks
(assert (<= tlx tly))
(assert (<= brx bry))
(lambda (x y &optional (value nil valuep))
(incf x tlx)
(incf y tly)
(assert (<= tlx x brx))
(assert (<= tly y bry))
(if valuep
(setf (aref matrix y x) value)
(aref matrix y x))))
This returns a closure which takes 2 or 3 arguments. The first two arguments are x and y coordinates relative to the inner matrix. When given a third argument, the closure sets the value. Otherwise, it gets the value.
This can be made more generic. I was partly inspired by sds's answer but tried to do things a little differently; here I can generate either a setter or a getter function. I also add some checks before creating the function and during the execution of the created function:
(defun slice-accessor (array ranges mode)
(let* ((dimensions (array-dimensions array))
(max-length (length dimensions)))
(check-type array array)
(loop
with r = (copy-list ranges)
for range = (pop r)
for (lo hi) = range
for d in dimensions
for x from 0
for $index = (gensym x)
collect $index into $indices
when range
do (assert (<= 0 lo hi d))
and collect `(check-type ,$index (integer 0 ,(- hi lo))) into checks
and collect `(incf ,$index ,lo) into increments
finally (let ((body `(apply #'aref ,array ,#$indices ())))
(return
(compile nil
(ecase mode
(:read `(lambda ,$indices
,#checks
,#increments
,body))
(:write (let (($v (make-symbol "VALUE")))
`(lambda (,$v ,#$indices)
(check-type ,$v ,(array-element-type array))
,#checks
,#increments
(setf ,body ,$v)))))))))))
CLOS
Once you have the above, you can provide a nice interface through objects. The setter and getter functions are updated whenever we change the ranges or the array being sliced:
(defclass array-slice ()
((array :initarg :array :accessor reference-array)
(ranges :initarg :ranges :accessor slice-ranges :initform nil)
(%fast-getter :accessor %fast-getter)
(%fast-setter :accessor %fast-setter)))
(flet ((update-fast-calls (o)
(setf (%fast-setter o)
(slice-accessor (reference-array o) (slice-ranges o) :write)
(%fast-getter o)
(slice-accessor (reference-array o) (slice-ranges o) :read))))
(defmethod initialize-instance :after ((o array-slice) &rest k)
(declare (ignore k))
(update-fast-calls o))
(defmethod (setf reference-array) :after (new-array (o array-slice))
(declare (ignore new-array))
(update-fast-calls o))
(defmethod (setf slice-ranges) :after (new-ranges (o array-slice))
(declare (ignore new-ranges))
(update-fast-calls o)))
(defgeneric slice-aref (slice &rest indices)
(:method ((o array-slice) &rest indices)
(apply (%fast-getter o) indices)))
(defgeneric (setf slice-aref) (new-value slice &rest indices)
(:method (new-value (o array-slice) &rest indices)
(apply (%fast-setter o) new-value indices)))
Examples
(defparameter *slice*
(make-instance 'array-slice :array *matrix*))
;; no range by default
(slice-aref *slice* 0 0)
=> 1
;; update ranges
(setf (slice-ranges *slice*) '((1 2) (1 2)))
(slice-aref *slice* 0 0)
=> 5
(incf (slice-aref *slice* 0 0) 10)
=> 15
*matrix*
=> #2A((1 2 3) (4 15 6) (7 8 9))
;; change array
(setf (reference-array *slice*) (make-array '(3 3) :initial-element -1))
(slice-aref *slice* 0 0)
=> -1
I don't think it is possible to do exactly what you want to do. In memory, multidimensional arrays are implemented as a single flat array with some metadata which is used to convert from the multidimensional interface to the flat one. In your case *my-array* would look like this:
#(1 2 3 4 5 6 7 8 9)
If you had the subarray you desired as a reference to the original array, it would look like this:
#(5 6 _ 8 9)
Which is impossible since you are trying to skip the 7 of the original array. If all of the desired elements were part of a contiguous sub-sequence, you would be able to use the :displaced-to argument of make-array in order to copy the sub-sequence by reference, but unfortunately, that is not the case.
I'm trying to convert this Python code into Common Lisp:
for a in xrange(1,1000):
for b in xrange(a,1000):
c = (a**2 + b**2) ** 0.5
s = a + b + c
if s == 1000:
return a * b * c
My first attempt was:
(loop for a from 1 to 999
do (loop for b from a to 999
for c = (sqrt (+ (expt a 2) (expt b 2)))
for s = (+ a b c)
until (= s 1000)
finally return (* a b c))))
This doesn't work. My task is: when s hits 1000 make the whole expression above return (* a b c). How to return some value from a nested loop macro?
You can use block and return-from operators: block establishes a named block of code, and you can return from this block with return-from using the name of the block
(let (c s)
(block nested-loops
(do ((a 1 (1+ a))) ((= a 999))
(do ((b a (1+ b))) ((= b 999))
(setf c (sqrt (+ (expt a 2) (expt b 2)))
s (+ a b c))
(if (= s 1000)
(return-from nested-loops (* a b c)))))))
PS, I don't use loop here, I just got used to do.
Also from http://www.gigamonkeys.com/book/loop-for-black-belts.html
To allow RETURN-FROM to be used to return from a specific loop (useful when nesting LOOP expressions), you can name a LOOP with the loop keyword named. If a named clause appears in a loop, it must be the first clause. For a simple example, assume lists is a list of lists and you want to find an item that matches some criteria in one of those nested lists. You could find it with a pair of nested loops like this:
(loop named outer for list in lists do
(loop for item in list do
(if (what-i-am-looking-for-p item)
(return-from outer item))))
The Python return statement doesn't return from the loop, it returns from the whole function that the loop is contained in. In Common Lisp, a function establishes an implicit block with the same name as the function. So you can use:
(return-from function-name (* a b c))
to perform the return equivalent to the Python code.
I think your solution should work with little adjustment while trying to keep the original form of the python code
(loop named outer for a from 1 below 1000 do
(loop for b from a below 1000
for c = (sqrt (+ (expt a 2) (expt b 2)))
for s = (+ a b c)
if (= s 1000) do (return-from outer (* a b c))))
And if you wanted to enter infix equations, you can use infix library available from quicklisp with (ql:quickload :infix), and then modify the above to get
(loop named outer for a from 1 below 1000 do
(loop for b from a below 1000
for c = #i(sqrt (a^^2 + b^^2))
for s = #i(a + b + c)
if (= s 1000) do (return-from outer #i(a * b * c))))
I have to define a variadic function in Scheme that takes the following form: (define (n-loop procedure [a list of pairs (x,y)]) where the list of pairs can be any length.
Each pair specifies a lower (inclusive) and upper bound (exclusive). That is, the following function call: (n-loop (lambda (x y) (inspect (list x y))) (0 2) (0 3)) produces:
(list x y) is (0 0)
(list x y) is (0 1)
(list x y) is (0 2)
(list x y) is (1 0)
(list x y) is (1 1)
(list x y) is (1 2)
Now, I had posted on this topic one previous time and was helped wonderfully. However, I have been given new guidelines to adhere to. The solution is to be found using nested maps only.
The way I've been going about this is as follows: find all of the values specified by the first set of bounds (in the example, (0 1 2)). This can be done by a function called (enumerate lowBound highBound). Then, I need to take each of those numbers, and cons each number in the next set of bounds (0 1 2 3), resulting in ((0 0) (0 1) (0 2) (0 3) (1 0)...).
What I've written to this point is the following:
(define (n-loop op . pairs)
(apply op (generate pairs))
)
(define (generate pairs)
(map (lambda (x) (cons x (generate (cdr pairs))))
(map (lambda (x) (enumerate (car x) (cadr x))) pairs))
)
But for the given numbers, this outputs (0 1 0 1 2 0 1 2 0 1 2) when I need ((0 0) (0 1) (0 2) (0 3) (1 0)...). This is a nasty problem. Does anyone have any insight?
This problem is more complex than you seem to realize. In particular, generating the cartesian product of an arbitrary list of ranges needs far more work - have you tried your procedure with more than two ranges? It piqued my interest, this time I'll give my shot to a complete solution, using only procedures defined for the solution, simple operations over lists (cons, car, cdr, append), lambda, apply and map.
First, the helper procedures from simplest to hardest. We need a way to generate a range of numbers. If available, use build-list or for-list, but if you need to implement it from scratch:
(define (enumerate low high)
(if (>= low high)
'()
(cons low
(enumerate (add1 low) high))))
Now we need a mechanism for folding (reducing, accumulating) the values in a list. If available use foldr, otherwise implement it like this:
(define (reduce proc lst init)
(if (null? lst)
init
(proc (car lst)
(reduce proc (cdr lst) init))))
To avoid unnecessary nesting in lists, use a flatmap - a procedure that both maps and flattens a list of values:
(define (flatmap proc lst)
(reduce (lambda (e acc)
(append (proc e) acc))
lst '()))
This is the core of the solution - a procedure that generates the cartesian product of an arbitrarily long list of lists of values denoting ranges:
(define (product . args)
(reduce (lambda (pool result)
(flatmap (lambda (x)
(map (lambda (y)
(cons x y))
result))
pool))
args
'(())))
Finally, the procedure in the question. It uses the helper procedures defined above, noticing that the op received can have an arbitrary number of parameters (depending on the number of ranges specified), so we need to use apply on each generated tuple of values:
(define (n-loop op . pairs)
(map (lambda (tuple) (apply op tuple))
(apply product
(map (lambda (pair)
(enumerate (car pair) (cadr pair)))
pairs))))
Test it like this:
(n-loop (lambda (x y z) (list x y z))
'(0 2) '(0 3) '(4 6))
> '((0 0 4) (0 0 5) (0 1 4) (0 1 5) (0 2 4) (0 2 5)
(1 0 4) (1 0 5) (1 1 4) (1 1 5) (1 2 4) (1 2 5))
Is it possible to generate n-sized permutations of a list using only the basic scheme constructs?
With define you can do it like this (without define the answer would be no, because you'll need to use recursion):
First define a function that takes a list of lists and a value and returns a list of lists where the given item has been prepended to each list in the original list of lists.
This can be done by writing a simple recursive function that uses cons to prepend the item to the first list (using car to get the first list) and then uses cons again to prepend the extended list to the result of calling the function on the other lists (i.e. on the cdr of the list of lists). If the list is empty (and thus doesn't have a car and cdr), return the empty list.
You'll also need a function that removes a given item from a list. This can also be done by defining a simple recursive function that takes an item and a list. At each step the `car´ of the given list should be prepended to the result of the recursive call if it is not equal to the item that is to be deleted. If it is equal, the result of the recursive call should be returned directly.
Further you'll need a function to concatenate lists. This can also be implemented recursively without too much trouble.
Then define a function that given a list of lists and an item calls the previous function with the item and each sublist as its argument.
Now define the a function that creates n-sized permutations. This function should take the number n and a list. If n is 0, it should return the empty list. Otherwise it should call itself recursively for each item x in the list with (- n 1) as the new value for n and the result of removing x from the list as the new value for the list. Then the results of the recursive calls should be concatenated.
This is an explanation of the code found in Rosetta, although, I have changed the variable names to help make it more readable, and added my explanation of the code below. I did check to see if the code works in DrRacket, and it does.
Before defining permute, two helper functions are required namely, seq and insert.
seq builds a list containing a sequence of numbers. For example (seq 0 3) -> (0 1 2 3).
The elements (numbers) in the list are used in the insert function to insert the carItem at various positions in the 'cdr' list.
(define (seq start end)
(if (= start end)
(list end) ; if start and end are the same number, we are done
(cons start (seq (+ start 1) end))
)
)
insert generates a list with the carItem inserted in the "n"th position of the cdrList. For example, (insert '(b c) 0 'a) -> '(a b c) and (insert '(b c) 2 'a) -> '(b c a).
(define (insert cdrList n carItem)
(if (= 0 n)
(cons carItem cdrList) ; if n is 0, prepend carItem to cdrList
(cons (car cdrList)
(insert (cdr cdrList) (- n 1) carItem))))
Finally, as for the main function permute, it uses insert and seq in a recursive manner.
For example, when plist = '(b,c) the lambda evals to the following:
; (map (lambda (n)
; (insert '(b c) n 'a))
; '(0 1 2)) -> output of seq function given n = 2, which is length of '(b c)
; '((a b c) (b a c) (b c a)) ---> will be the output
(define (permute mylist)
(if (null? mylist)
'(())
(apply append (map (lambda (plist)
(map (lambda (n)
(insert plist n (car mylist)))
(seq 0 (length plist))))
(permute (cdr mylist))))))
(permute '(a b c))
If the above nested lambdas makes your head spin (it did for me), find below, IMHO, a more readable "define" version, thanks to Matthias Felleisen:
(define (permute mylist)
(cond
[(null? mylist) '(())]
[else
(define (genCombinationsFor plist)
(define (combineAt n) (insert plist n (car mylist)))
(map combineAt (seq 0 (length plist))))
(apply append (map genCombinationsFor (permute (cdr mylist))))]))