Access array with list of indices - arrays

I want to access arrays with the indices being in a list. Let's call this utility arefl, and it's defined as follows:
(arefl array '(x y z ...)) equals (aref array x y z ...)
My goal is to create some generic functions that operate on matrices of any size.
I have failed to implement such a thing with macros and just aref. The closest thing that I have is:
(defmacro arefl (array is)
"Access array by a list of indices"
`(apply #'aref (cons ,array ,is)))
which works, and actually it also works with (setf (arefl array is) value) but the compiler, at least sbcl, throws a warning telling me that I'm redefining setf for (I guess) apply. The warning is:
; in: DEFUN (SETF AREFL**)
; (SETF (APPLY #'AREF ARRAY (REDUCE 'CONS ARGS :FROM-END T)) NEW-VALUE)
; --> LET* MULTIPLE-VALUE-BIND LET APPLY MULTIPLE-VALUE-CALL
; ==>
; #'(SETF AREF)
;
; caught STYLE-WARNING:
; defining as a SETF function a name that already has a SETF macro:
; (SETF AREF)
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
--
Is there a better way? I'm looking for an implementation that works well with setf and does not need a call to another function like apply nor does do any cons

Ok, define-setf-expander is overkill for this.
(defun arefl (array list)
(apply #'aref array list))
(defun (setf arefl) (x array list)
(setf (apply #'aref array list) x))
See "APPLY Forms as Places": http://clhs.lisp.se/Body/05_abe.htm

First, though I recognize that you said
I'm looking for an implementation that works well with setf and does not need a call to another function like apply nor does do any cons
however, you can simply use apply 'aref here, and you don't need to do any consing, since only apply's final argument needs to be a list. That means that all the following are equivalent:
(aref array 0 1)
(apply 'aref (list array 0 1))
(apply 'aref array (list 0 1))
(apply 'aref array 0 (list 1))
(apply 'aref array 0 1 '())
Most importantly, if you want to avoid calling cons, it means that you can do
(apply 'aref array indices)
You can use setf with this too (although you will have to use #'array, and not 'array):
(setf (apply #'aref array indices) new-value)
Since apply works here, you just need to make your aref* and (setf aref*) functions (to be analogous with list*):
(defun aref* (array &rest args)
  (apply 'aref array (reduce 'cons args :from-end t)))
             
(defun (setf aref*) (new-value array &rest args)
  (setf (apply #'aref array (reduce 'cons args :from-end t)) new-value))
The (reduce 'cons args :from-end t) in those is used to support spreadable argument list designators, which are what apply uses. Using this idiom, you can pass exactly the same kinds of arguments to (aref* ...) that you could use in (apply #'aref ...). That might be a bit more complex than the use cases that you've described, but it means that rather than having to specifically describe what sorts of arguments aref* takes, you can simply say (like the documentation for apply does), that aref*'s args are a spreadable argument list designator, and that aref* applies aref to the args.

Related

why is inner loop collect not returning results?

I was trying to use standard loop facilities to collect into a result but it just returns nil. Why is this? it feels like this should work:
(defun coll-intersects (bounds mv)
(let ((res (list))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (not (member (cl-byte (aref mapa x y)) mv))
collect (aref mapa x y) into res
))))
but no, i have to do this:
(defun coll-intersects (bounds mv)
(let ((res (list)))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
do
(if (not (member (cl-byte (aref mapa x y)) mv))
(push (aref mapa x y) res))
))
res))
why? i was really confused why the first one was not working
As Ehvince's answer says, the problem is that
(loop ...
collect ... into x
...)
binds x. The purpose of this construct is really so you can collect multiple lists:
(defun partition (l)
(loop for e in l
if (evenp e)
collect e into evens
else
collect e into odds
finally (return (values evens odds))))
for instance.
In the case where you want to collect a single list from nested loops and you care about order you can do this trick:
(defun sublist-evens (l)
(loop for s in l
nconcing
(loop for e in s
when (evenp e)
collect e)))
Here the outer loop essentially nconcs together the results from the inner loop. This can nest of course:
(loop ...
nconcing
(loop ...
nconcing
(loop ...
collect ...)))
will work. It is also possible that loop is smart enough to keep a tail pointer to the list it's building with nconc / nconcing, although you'd have to check that.
However in cases where you want to build some list in-order from some deeply-nested loop (or any other search process) I find it's almost always more pleasant to use a collecting macro to do that (disclaimer: I wrote this one). With such a macro the above sublist-evens function looks like this:
(defun sublist-evens (l)
(collecting
(dolist (s l)
(dolist (e s)
(when (evenp e) (collect e))))))
and
> (sublist-evens '((1 2 3) (4 5 6)))
(2 4 6)
And you can do better:
(defun tree-partition (tree)
(with-collectors (evens odds)
(labels ((search (it)
(typecase it
(list
(dolist (e it)
(search e)))
(integer
(if (evenp it)
(evens it)
(odds it)))
(t
(warn "unexpected ~A" (type-of it))))))
(search tree))))
and now
> (tree-partition '(((1 2 3) (4)) 5))
(2 4)
(1 3 5)
(And for hack value you can use another macro to express the above more concisely:
(defun tree-partition (tree)
(with-collectors (evens odds)
(iterate search ((it tree))
(typecase it
(list
(dolist (e it)
(search e)))
(integer
(if (evenp it)
(evens it)
(odds it)))
(t
(warn "unexpected ~A" (type-of it)))))))
Disclaimer: I wrote that macro too.)
Here's the first snippet, with the let parenthesis corrected, simplified to be made reproducible:
(defun coll-intersects (bounds mv)
(let ((res (list))) ;; <-- third closing paren
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
collect y into res
))))
Now when I enter it into the REPL, SBCL warns me about an unused res:
; caught STYLE-WARNING:
; The variable RES is defined but never used.
That's a big hint.
The issues I see:
you use do for the outer loop, not collect, and you don't return res, so the functions always returns nil.
collect … into presumably uses an internal variables, not your res :S In addition the loop doesn't say what to do with it. I added finally (return res) and I get results. You can also use push like in the second example. But it doesn't seem necessary to use into, just use collect y.
it is usually not necessary to declare intermediate variables with an outer let.
Here's a simpler function that returns (dumb) results:
(defun coll-intersects (bounds)
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) collect
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
collect y)))
(coll-intersects '(1 2 3 4))
((2 4 6) (2 4 6) (2 4 6) (2 4 6))
If you use nconcing instead of the first collect, you'll get a flat list (as pointed out by #tfb).
or:
(defun coll-intersects (bounds)
(let ((res (list)))
(loop for x from (first bounds) to (+ (first bounds) (third bounds)) do
(loop for y from (second bounds) to (+ (second bounds) (fourth bounds))
if (evenp y)
do (push y res)
))
res))
(coll-intersects '(1 2 3 4))
(6 4 2 6 4 2 6 4 2 6 4 2)
In your first example, the return value from the function is the return value from the outer loop. It doesn't collect any values (the inner loop does) and thus most probably just returns a nil.
In your second example, your function explicitly returns the value of res.

Lisp Loop Largest Number

I've been fiddling with Lisp programs for a little while and one thing that I can never seem to figure out is how to use a loop on a list inside a function. I'm trying to create a function that will take a list as the parameters while using a do... loop. I know how to do it with if statements but now I need to use a loop. Does anyone have a clue on how to do that?
(defun maximum (a_list)
(if (= (length a_list) 1)
(car a_list)
(if (> (car a_list) (maximum (cdr a_list)))
(car a_list)
(maximum (cdr a_list))))
(format t "~d" a_list))
Here's what I have so far on the if statements. They might not work right but at least they work.
Here another set of possibilities, in addition to those proposed in another answers.
First of all, when writing a function, one should also test for special cases, while you do not check for an empty list. So the structure of the function could be something of this type:
(defun maximum (l)
(if (null l)
nil ; or give an error
...normal solution...))
In case of returning nil, this structure in Common Lisp is identical to the following one, given that and evaluates its arguments in sequence, and returns nil as soon as an argument is evaluated to nil, otherwise returns the value of the last argument:
(defun maximum (l)
(and l ...normal solution...))
Here the alternative solutions.
Without loop or recursion, with predefined functions reduce (manual) and max (manual).
(defun maximum (l)
(and l (reduce #'max l)))
With the construct dolist (manual), that iterates a variable over a list:
(defun maximum (l)
(and l (let ((result (car l)))
(dolist (x (cdr l) result)
(when (> x result)
(setf result x))))))
And finally, with a compact version of do (manual):
(defun maximum (l)
(and l (do ((maximum-so-far (car l) (max (pop l) maximum-so-far)))
((null l) maximum-so-far))))
With loop the solution is trivial:
(loop for x in '(1 2 7 4 5) maximize x)
I assume therefore that what you intend to do is to write the function with a do loop. In this case you have to traverse the list keeping track of the maximum element so far, and updating this value if you find a larger value:
(setq list '(1 2 7 4 5))
(do* ((l list (cdr l))
(x (car l) (car l))
(max x) )
((null l) max)
(if (> x max)
(setq max x) ))
(defun maximum (list)
(let ((result)) ;; short for ((result nil))
(dolist (x list)
(if result
(when (> x result)
(setf result x))
(setf result x)))
result))
(dolist (x list) ... ) is like Python's [... for x in list]
It is typical imperative style to create a variable with
let and setf to it to change its value.

How to have two equal arrays but with a different internal state

I want to create a copy of an array that already exists, but i want to be able to change values on one of them not altering the other one.
(setf arayONE (make-array(list 2 2)))
(setf arayTWO arayONE)
(setf (aref arayONE 1 1) 2) ; this will change both arayONE and arayTWO values
I also tryed passing the value with the (let ....) statement but gave the same answer..
Thanks sorry for the newbie question.
When you do (setf arayTWO arayONE) you are actually giving to the same array two different names, since setf does not perform any copy, but simply assign to the variable arayTWO the value of arayONE, which is a reference to an array.
So you have to explicitly copy the array, but since there is no primitive function in Common Lisp to copy arrays, you have to write it by yourself or use the function provided by some library, like Alexandria.
For a simple copy like that of this case, you could for instance write something like this:
(setf arayTWO (make-array (array-dimensions arayONE)))
(dotimes (i (array-total-size arayONE))
(setf (row-major-aref arayTWO i)
(row-major-aref arayONE i)))
For a more general function that works for every kind of array, with fill pointer, adjustability, etc., you could look at this answer: How do you copy an array in common lisp?

Copy of a 2d array instead of reference in CLISP

I am trying to create a copy of the first element in the array and add the copy to the end of the array. I then want to do work (move_NE) on the copy I just created, changing it but not the original. The intended result is to have an array of two elements, one which points to the original and the other which points to a modified original.
(vector-push-extend (initialize_board 5) *all_states*)
(vector-push-extend (elt *all_states* 0) *all_states*)
(move_NE (elt *all_states* 1) 0 2)
From what I can figure, (elt *all_states* 0) is producing a reference to the original element which results in an array with two elements, both which point to the same thing.
The context of this program is from my attempts to write a program to generate all possible moves for a triangular peg solitaire (cracker barrel) game. *all_states* is an array of boardstates, each of which are a 2d array.
Any help is appreciated.
EDIT: My background is in C/C++ programming.
There's no copying-on-assignment in Common Lisp. (And, as far as I'm aware, There's not in most Object Oriented Programming languages, either. E.g., in Java, if you have Object x = ...; Object y = x; there's just one object. If you modify that object through either the variable x or y, the change will be visible if you access the object through the other variable.) If you need a copy of an object, you'll need to make that copy yourself. That's just the same for other built in datatypes, too.
First, note that if you store a value in an element of an array, it doesn't modify the previous value that was stored in that array:
CL-USER> (let ((a (make-array 10 :adjustable t :fill-pointer 1)))
(setf (aref a 0) "one")
(print a)
(vector-push-extend (aref a 0) a)
(print a)
(setf (aref a 1) "five")
(print a))
; #("one")
; #("one" "one")
; #("one" "five")
But, when the array looked like #("one" "one"), the value of (aref a 0) and (aref a 1) is the same string. You can see this if we modify that string:
CL-USER> (let ((a (make-array 10 :adjustable t :fill-pointer 1)))
(setf (aref a 0) "one")
(print a)
(vector-push-extend (aref a 0) a)
(setf (char (aref a 1) 2) #\3)
(print a))
; #("one")
; #("on3" "on3") ; we changed the **single** string
When you extend the array you can, of course, make a copy of the object, and then there will be two distinct objects:
CL-USER> (let ((a (make-array 10 :adjustable t :fill-pointer 1)))
(setf (aref a 0) "one")
(print a)
(vector-push-extend (copy-seq (aref a 0)) a)
(print a)
(setf (char (aref a 1) 2) #\3)
(print a))
; #("one")
; #("one" "one")
; #("one" "on3")
You mentioned
From what I can figure, (elt *all_states* 0) is producing a reference
to the original element which results in an array with two elements,
both which point to the same thing.
That's really the behavior that you want. If (elt *all_states* 0) didn't return the object at index 0 of the array, but returned a copy of the object, there'd be no way to modify the actual thing that's stored in the array (if the array was the only way to get ahold of the object). You mentioned coming from a C/C++ background; I highly recommend that rather than try to adapt that mental model to become a mental model for Common Lisp, that you spend some time building a mental model of Common Lisp from (almost) scratch. I don't mean that in a dismissive sense; in my opinion, it's good advice for any programmer learning a new language. If you try to "get by" with assumptions based on other languages, you can end up with some pretty subtle and hard-to-find bugs. I'd make a similar suggestion to someone with a Lisp background learning C/C++. If, for some reason, you don't have the time to do that, the quickest and safest advice I can give you is this:
If you you need to think of Common Lisp with a C/C++ model, choose C, not C++. Primitive datatypes (ints, chars, etc.) are roughly the same, and everything is is handled by pointers.
With that model, then your initial problem is very clear. You've got an array of pointers to objects, and you extended an array with another pointer to the same object. It's no surprise, then, that when you modified the object pointed at by that pointer, it was visible through all pointers to that object. You need to allocate a new object that's a copy of the first, and put a pointer to that in the array.
This is really the behavior that you want

How to compare two lists in lisp that are not exactly the same in length or structure?

I have these two lists:
'(and 1 (or a b))
'( (a 0)(b 1) )
I am new to lisp, and I am finding it very hard to figure out how to compare these two lists. I am thinking of creating a comparison function, but I don't know how to compare them one by one as in lisp values aren't returned until the expression is evaluated. Since they aren't the same structure either, I can't assume they will be the same, structurally at least. Any explanation how this works?
Edit: Sorry, I forgot to say why I am comparing. The second list is to suppose to bind the number to everywhere where those variables exists in the first list. So the resulting first list should be:
'(and 1(or 0 1))
Built in:
$ clisp -q
[1]> (sublis '((a . 0) (b . 1)) '(and 1 (or a b)))
(AND 1 (OR 0 1))
[2]>
So the homework reduces to making a wrapper for SUBLIS which accepts the bindings in the form ((a 0) (b 1)) rather than ((a . 0) (b . 1)).
Clue:
(loop for (x y) in vars collecting (cons x y))
;;; Look up a var like A a list like ((A 0) (B 1))
;;; and retrieve the (A 0). Or nil if not found.
(defun lookup-var (var bindings)
(find var bindings :key #'first))
;;; The homework
(defun subst-vars (tree bindings)
(cond
;; if the tree is a cons cell, then substitute in the
;; car, substitute in the cdr, and combine the results by consing
;; a new cons! Easy!
((consp tree) (cons (subst-vars (car tree) bindings)
(subst-vars (cdr tree) bindings)))
;; Otherwise the tree must be an atom. See if the atom is
;; a var that we can substitute. If not, return the atom.
(t (let ((binding (lookup-var tree bindings)))
(if binding
(second binding) ;; got a binding entry; return its value!
tree))))) ;; no deal, just return the original
Typed this right in the stackoverflow window and it ran with no edits. :)
This is quite inefficient though. Suppose that the variables do not occur in the tree at all. It makes a wasteful copy of the tree instead of just returning the tree. So that you do some work on this yourself, can you figure out a way to optimize it so that it avoids calling the cons function unnecessarily? Hint: check if the recursive calls to subst-vars just return the same object.

Resources