How to make pairs using nested loop in Lisp - loops

I am trying to make a pairs function in Lisp. The pairs function gets two inputs then makes a pair with each other and make one list. Here is my code:
(defun npair (s1 s2)
(let ((result '()))
(cond ((null s1) s2)
((null s2) s1)
(t (loop
(when (null s1) (return result))
(while (not (null s2))
(setq result (cons (list (car s1) (car s2)) result))
(setq s2 (cdr s2)))
(setq s1 (cdr s1)))))))
This function should have returned like (npair '(a b c) '(1 2)) -> ((a 1) (a 2) (b 1) (b 2) (c 1) (c 2))
But my result is only ((a 1) (a 2)).
Please help!

If you want to accumulate the value(s) from an inner loop in an outer loop, you're probably better off simply accumulating the values rather than trying to do it by mutating variables:
(loop for e1 in p1
append (loop for e2 in p2
collect (list e1 e2)))
Your formatting is also way off, the custom is to not put terminating parentheses on a new line.
Using the loop construction from above, your entire function would thus be:
(defun npair (p1 p2)
(loop for e1 in p1
append (loop for e2 in p2
collect (list e1 e2))))
Nice, simple and quite readable.

While the others have shown you better alternatives to achieve the result you want than your implementation, here's the reason why your implementation doesn't work: you change the value of s2 to null while combining the first element of s1 with the elements of s2, and never restore the original value of s2 before handling the remaining elements of s1. (This is one of multiple good reasons why you should loop over the input values without mutating them in the first place.)
Here's a version of your implementation what actually works because it doesn't mutate its inputs:
(defun npair (s1 s2)
(let ((result '()))
(cond ((null s1) s2)
((null s2) s1)
(t (loop for e1 in s1
do (loop for e2 in s2
do (push (list e1 e2) result)))
(nreverse result)))))

by the looks of it, the result you hope for is called a cartesian product.
An implementation that I use in the Scheme programming language goes like this:
(define (product . args)
(if (null? args)
(list '())
(apply append
(map (lambda (rest)
(map (lambda (first)
(cons first rest))
(car args)))
(apply product (cdr args))))))
For example here is the output using Chez Scheme:
> (product '(a b c) '(1 2))
((a 1) (b 1) (c 1) (a 2) (b 2) (c 2))

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.

Building a string in Clojure with recursion

I need to generate a random char and build a string and only stop when my string contains the newly generated char.
(defn rand-char [len]
(apply str (take len (repeatedly #(char (+ (rand 26) 65))))))
(def random-string
(loop [x (rand-char 1)
result []]
(if (some #(= x %) result)
(apply str (conj result x))
(recur (conj result x) (x (rand-char 1))))))
I am getting
java.lang.String cannot be cast to clojure.lang.IFn
rand-char returns a string but in (x (rand-char 1)) you're attempting to call x as a function, hence the error. You only need to call rand-char to generate the next random string to try. The arguments to recur should be in the same order as those declared in the loop so yours are in the wrong order:
(recur (rand-char 1) (conj result x))
something like this does it serve you?
(defn random-string []
(loop [x (rand-char 1)
result []]
(if (.contains result x)
(apply str result)
(recur (rand-char 1) (conj result x)))))

How to generate one cartesian product in lisp?

This is my code to generate a cartesian product:
(defun cartesian-product (LIST)
(LOOP FOR X IN LIST
NCONC
(LOOP FOR Y IN LIST
COLLECT (LIST X Y))))
I tried outputting one of the cartesian products with this:
(defun cartesian-product-generator (CALLBACK LIST)
(LOOP FOR X IN LIST
NCONC
(LOOP FOR Y IN LIST
        DO(FUNCALL CALLBACK (LIST X Y)))))
However there are errors when I tried testing it with:
(cartesian-product-generator '(A B C))
Error: Too few arguments in call to #<Compiled-function cartesian-product-generator #x30200097E60F>:
1 argument provided, at least 2 required. While executing: cartesian-product-generator, in process listener(1).
I am new to LISP and would like to know why there's an error and how to fix this error. Ultimately, I would like to output each cartesian product per call of the function.
For example, if the lists consists of ((1 1) (1 2) (2 1) (2 2)).
I would like to generate (1 1). Then (1 2). Then (2 1). Lastly, (2 2).
Your first code does work correctly.
(defun cartesian-product (list)
(loop
for x in list
nconc (loop for y in list
collect (list x y))))
Calling it with '(a b c) returns a list:
((A A) (A B) (A C) (B A) (B B) (B C) (C A) (C B) (C C))
You want to avoid building a list and use a callback instead.
To simplify, first try to only print elements instead of collecting them.
That means that you do not care about returning the generated values
up to the caller: you just want to generate them and print them as
soon as they are available.
Basically, you can replace all nconc and collect keywords by do, and add a call to print:
(defun cartesian-product (list)
(loop
for x in list
do (loop for y in list
do (print (list x y)))))
A quick test on the REPL with '(a b c) should print the same
elements as previously, each one on a separte line.
Now, you can just generalize print and call anything you want:
(defun map-cartesian-product (function list)
(loop
for x in list
do (loop for y in list
do (funcall function (list x y)))))
Just to see if it still works, do a quick test:
(map-cartesian-product #'print '(a b c))
This should have the same behaviour as before.
Since you only iterate over a list for side-effects, you can use
DOLIST:
(defun map-cartesian-product (function list)
(dolist (x list)
(dolist (y list)
(funcall function (list x y)))))
Again, you can test that it still works as previously.
You may want to look into the cl-coroutine library available via quicklisp. Then your cartesian-product could be written as
(cl-coroutine:defcoroutine cartesian-product (list)
(loop for x in list
do (loop for y in list
do (cl-coroutine:yield (list x y)))))
An example use could be:
(cl-coroutine:with-coroutine (cartesian-product)
(let ((x (list 1 2 3)))
(loop for y = (cartesian-product x)
while y do (print y))))
; outputs (1 1) (1 2) ... (3 3)
Just want to leave my 2 cents here.
You can also do this with a macro
(defmacro cartesian-product (lists)
(let* ((indices (loop for i from 1 to (length lists)
collect (gensym (format nil "~a-i-" i))))
(initial-value `(loop for ,(car (last indices)) in ',(car (last lists))
collect `(,,#indices))))
(reduce
(lambda (x y)
`(loop for ,(car x) in ',(cadr x)
nconc ,y))
(mapcar #'list (butlast indices) (butlast lists))
:from-end t
:initial-value initial-value)))
which expands with
(cartesian-product ((H P) (a b c) (1 2 3 5)))
to
(loop for #:|1-i-806| in '(h p)
nconc (loop for #:|2-i-807| in '(a b c)
nconc (loop for #:|3-i-808| in '(1 2 3 5)
collect `(,#:|1-i-806| ,#:|2-i-807| ,#:|3-i-808|))))
and results into
((H A 1) (H A 2) (H A 3) (H A 5) (H B 1) (H B 2) (H B 3) (H B 5) (H C 1) (H C 2) (H C 3) (H C 5)
(P A 1) (P A 2) (P A 3) (P A 5) (P B 1) (P B 2) (P B 3) (P B 5) (P C 1) (P C 2) (P C 3) (P C 5))
I like it because it is quite simple and does not require recursion.
Let me give a more basic answer (without loops), but more general, i.e., cartesian products of two, three and four lists (your case is binary cartesian product with two identical arguments):
(defun make-tuples-with-object (obj lst)
(mapcar #'(lambda (x) (list obj x)) lst))
(defun cartesian-product (list-1 list-2)
(apply #'append (mapcar #'(lambda (x) (make-tuples-with-object x list-2)) list-1)))
(defun cartesian-product-ternary (list-1 list-2 list-3)
(mapcar #'(lambda (x) (cons (car x) (second x)))
(cartesian-product list-1 (cartesian-product list-2 list-3))))
(defun cartesian-product-quaternary (list-1 list-2 list-3 list-4)
(mapcar #'(lambda (x) (cons (car x) (second x)))
(cartesian-product list-1 (cartesian-product-ternary list-2 list-3 list-4))))

What is the difference between LOOP and Iterate for Common Lisp?

Common Lisp has a powerful Loop macro built in. It's really useful and powerful, and I use it quite often.
I've also heard of a very similar thing, called Iterate. It look really similar to Loop, but has more Lispy feel to it. What are the differences between these two? May there be any reason to switch to any of these, apart from simple preference of style?
Some things that are unique to iterate:
No rigid order for clauses
loop requires that all for clauses appear before the loop body, for example before while. It's ok for iter:
(iter (for x in '(1 2 99)
(while (< x 10))
(for y = (print x))
(collect (list x y)))
Accumulating clauses can be nested
collect, appending and the like can appear anywhere:
(iter (for x in '(1 2 3))
(case x
(1 (collect :a))
(2 (collect :b))))
finding
;; Finding the longest list in a list of lists:
(iter (for lst in '((a) (b c d) (e f)))
(finding lst maximizing (length lst)))
=> (B C D)
;; The rough equivalent in LOOP:
(loop with max-lst = nil
with max-key = 0
for lst in '((a) (b c d) (e f))
for key = (length lst)
do
(when (> key max-key)
(setf max-lst lst
max-key key))
finally (return max-lst))
=> (B C D)
https://common-lisp.net/project/iterate/ first example
Finding the minimum of x^2 - 4x + 1 in an interval:
(iter (for x from -5 to 5 by 1/100)
(finding x minimizing (1+ (* x (- x 4)))))
2
©Common Lisp Recipes p.198
next-iteration
it is like "continue" and loop doesn't have it.
iter also has first-iteration-p and (if-first-time then else).
https://web.archive.org/web/20170713081006/https://items.sjbach.com/211/comparing-loop-and-iterate
generators
generate and next. A generator is lazy, it goes to the next value when said explicitly.
(iter (for i in '(1 2 3 4 5))
(generate c in-string "black")
(if (oddp i) (next c))
(format t "~a " c))
b b l l a
NIL
https://sites.google.com/site/sabraonthehill/loop-v-iter
previous
(iter (for el in '(a b c d e))
(for prev-el previous el)
(collect (list el prev-el)))
=> ((A NIL) (B A) (C B) (D C) (E D))
although it is doable with loop's parallel binding and:
(loop for el in '(a b c d e)
and prev-el = nil then el
collect (list el prev-el))
more clauses
in-string
LOOP offers collecting, nconcing, and appending. ITERATE has these and also adjoining, unioning, nunioning, and accumulating.
(iter (for el in '(a b c a d b))
(adjoining el))
=> (A B C D)
(adjoin is a set operation)
LOOP has summing, counting, maximizing, and minimizing. ITERATE also includes multiplying and reducing. reducing is the generalized reduction builder:
(iter (with dividend = 100)
(for divisor in '(10 5 2))
(reducing divisor by #'/ initial-value dividend))
=> 1
https://web.archive.org/web/20170713105315/https://items.sjbach.com/280/extending-the-iterate-macro
It is extensible
(defmacro dividing-by (num &keys (initial-value 0))
`(reducing ,num by #'/ initial-value ,initial-value))
(iter (for i in '(10 5 2))
(dividing-by i :initial-value 100))
=> 1
but there is more.
https://common-lisp.net/project/iterate/doc/Rolling-Your-Own.html#Rolling-Your-Own
https://web.archive.org/web/20170713105315/https://items.sjbach.com/280/extending-the-iterate-macro where in the Appendix, we see two examples of loop extensions. But they are not portable really, the code is full of #+(or allegro clisp-aloop cmu openmcl sbcl scl) (ansi-loop::add-loop-path …, sb-loop::add-loop-path etc.
Stuff missing in iterate
No parallel binding like loop's and, but not needed?.
I'm probably missing here.
But that's not all, there are more differences.

Resources