So, I wrote the following program to determine the max element in a 2D array using LISP. Note, this is my first time using the language, so I am unfamiliar with many aspects.
The function should return the coordinates of the largest element in row-major order. In the below example, the largest element, 7, is found at index (2, 4). However, when the program is executed, it returns (3, 15).
It seems to be starting the index at 1, rather than 0, for the row. Additionally, it seems to be counting all indexes up to 15, where the max element is found. I am unsure how to fix this issue.
(defun find-max-location (x)
(let (
(maxval -100)
(loc nil)
(cur 0)
(cur2 0)
(k 1)
(l 1)
(f 0))
(loop for i in x do
(loop for j in i do
(if (> j maxval)
(progn
(setf cur k)
(setf cur2 l)
(setf maxval j))
)
(setf l (+ l 1))
)
(setf k (+ k 1))
)
(list cur cur2)))
(find-max-location '((0 1 0 0 1) (0 2 2 0 0) (3 0 1 4 7) (0 1 2 0 0) (1 2 1 0 3)))
The error is very simple: you don't reinitialize tha value of l each time the inner iteration is started. For the indexes, instead, if you want to start from 0, then you should initialize them with 0, and not with 1. Here is a rewriting of the code, in which I have removed the unused variables loc and f, used when instead of the one-branch if, and used a more conventional way of writing in Common Lisp:
(defun find-max-location (x)
(let ((maxval -100)
(cur 0)
(cur2 0)
(k 0)
l)
(loop for i in x
do (setf l 0)
(loop for j in i
do (when (> j maxval)
(setf cur k)
(setf cur2 l)
(setf maxval j))
(setf l (+ l 1)))
(setf k (+ k 1)))
(list cur cur2)))
(find-max-location '((0 1 0 0 1) (0 2 2 0 0) (3 0 1 4 7) (0 1 2 0 0) (1 2 1 0 3))) ; => (2 4)
Note that setf can perform multiple assignments, so the code can be simplified as:
(defun find-max-location (x)
(let ((maxval -100)
(cur 0)
(cur2 0)
(k 0)
l)
(loop for i in x
do (setf l 0)
(loop for j in i
do (when (> j maxval)
(setf cur k
cur2 l
maxval j))
(setf l (+ l 1)))
(setf k (+ k 1)))
(list cur cur2))
Finally, there are very convenient mechanisms in loop that allow the initialization of variables (with) and the looping of variables “in parallel” with the iteration variables. So here is the final iterative version of the function (with the use of when as loop keyword):
(defun find-max-location (x)
(loop with maxval = -100
and cur = 0
and cur2 = 0
for i in x
for k from 0
do (loop for j in i
for l from 0
when (> j maxval)
do (setf cur k
cur2 l
maxval j))
finally (return (list cur cur2))))
A very good starting point to master the complexity of loop is the chapter “Loop for Black Belts" of the free book “Practical Common Lisp”. Another excellent resource to learn Common Lisp is the “Common Lisp Cookbook”.
Finally, it is worth to note that Common Lisp has arrays, including 2D arrays, so that you can represent them directly, instead that with lists of lists, as in your example.
It seems that you're thinking about this in a very procedural manner. Recursion is your friend here.
How would we find the max and its position in a simple list? We'd recursively count up from 0, evaluating each element to see if it's greater than the current max or if max hasn't yet been set. We'd use the max parameter to the function to update this information. Hitting the end of the list we'd return the max.
(defun find-max-in-row (lst &optional (pos 0) (max '()))
(cond ((null lst)
max)
(or (null max) (> (car lst) (car max))
(find-max-in-row (cdr lst) (1+ pos) (list (car lst) pos)))
(t
(find-max-in-row (cdr lst) (1+ pos) max))))
(defvar foo '(1 6 8 2 7))
(format t "~a~%" (find-max-in-row foo))
Prints:
(8 2)
This logic can be adapted to find the column where a max value occurs. A starting point would be to map this function to your list of rows.
(format t "~a~%"
(mapcar #'find-max-in-row
'((0 1 0 0 1)
(0 2 2 0 0)
(3 0 1 4 7)
(0 1 2 0 0)
(1 2 1 0 3))))
Prints:
((1 1) (2 1) (7 4) (2 2) (3 4))
Here is another answer that defines a higher-order function indexed-list-fold, similar to folding functions like reduce or fold_left in other functional languages.
It's purpose is to take a function that works on a accumulator, and element and its index, to produce the next value for the accumulator. I define it as follows, with loop:
(defun indexed-list-fold (function accumulator list)
(loop
:for acc = accumulator :then res
:for elt :in list
:for idx :from 0
:for res = (funcall function acc elt idx)
:finally (return acc)))
Notice the use of for/then construct and how the order of the clauses matter: for elt in list may interrupt the iteration when reaching the end of the list, so it is important that acc is computed first. This is especially important if the list is empty initially, otherwise its value would be always nil and not accumulator.
Let's write a function that finds the maximum value and its location, in a list:
(defun find-max-location-in-list (list)
(flet ((fold (max.pos elt idx)
(let ((max (car max.pos)))
(if (or (null max) (< max elt))
(cons elt idx)
max.pos))))
(indexed-list-fold #'fold (cons nil nil) list)))
For example:
> (find-max-location-in-list '(1 3 8 3 12 -4 -200))
(12 . 4)
The maximum value is 12 at position 4.
In order to generalize this to a list of lists (a tree), the fold function must be able to reference itself in a recursive call to indexed-list-fold, so it is now declared with labels:
(defun find-max-location-in-tree (tree)
(labels ((fold (max.pos elt idx)
(let ((idx (alexandria:ensure-list idx)))
(etypecase elt
(real (let ((max (car max.pos)))
(if (or (null max) (< max elt))
(cons elt idx)
max.pos)))
(list
(indexed-list-fold (lambda (max.pos elt child)
(fold max.pos elt (cons child idx)))
max.pos
elt))))))
(indexed-list-fold #'fold (cons nil nil) tree)))
The logic is the same as before, except that elt may now be a list itself, and idx is a stack of indices. For example:
> (find-max-location-in-tree '(1 3 8 3 12 -4 -200))
(12 4)
Notice how the cdr of the result is a list. For the example you provided:
> (find-max-location-in-tree '((0 1 0 0 1)
(0 2 2 0 0)
(3 0 1 4 7)
(0 1 2 0 0)
(1 2 1 0 3)))
(7 4 2)
The maximum value is 7 at index 4 of the list at index 2.
I would loop in a nested way through the list-of-list (lol) and setf the values when bigger than current max-val:
(defun find-max-location (lol)
"Find max element's coordinate in a lol"
(let ((max-val (caar lol))
(max-coord '(0 . 0))) ;; start with first element
(loop for il in lol
for i from 0
do (loop for e in il
for j from 0
when (> e max-val)
do (setf max-val e
max-coord (cons i j))))
(values max-coord max-val)))
This function can handle irregular list-of-lists.
Using values, you can decide whether just to use only the coordinates or
to also capture the max-value itself.
;; usage:
(find-max-location '((0 1 9) (4 9) (6 7 8)))
;; => (0 . 2)
;; => 9
;; capture max-val too:
(multiple-value-bind (coord val) (find-max-location '((0 1 9) (4 9) (6 7 8)))
(list val (car coord) (cdr coord)))
;; => (9 0 2)
;; or destructure coord:
(multiple-value-bind (coord val) (find-max-location '((0 1 9) (4 5) (6 7 8)))
(destructuring-bind (x . y) coord
(list val x y)))
The first max-val is the very first element in this list-of-list.
Related
I am writing an iterative version of the Pell numbers and I need to print out the output of the numbers in a list. I have done everything right up until the list. Instead of returning a flat list, it returns individual lists of the Pell numbers.
I tried to append all the individual lists but it does not work. What am I missing?
(defun iterPell (n)
(let ((a 0) (b 1) (c n))
(loop for i from 2 to n do
(setq c (+ a (* 2 b))
a b
b c))
c))
(dotimes (n 7)
(write(append(list(iterPell n))))
)
>>(0)(1)(2)(5)(12)(29)(70)
(loop for n from 0 to 7
collect (iterPell n))
;; => (0 1 2 5 12 29 70 169)
(let ((res)) ;; initialize collector = ((res nil))
(dotimes (n 7)
(setf res (cons (iterPell n) res))) ;; setf the result new-value-consed
(nreverse res)) ;; revert it (after all consing to beginning of list)
;; => (0 1 2 5 12 29 70 169)
;; or write recursive function
(defun apply-on-0-to-n (n func acc)
(cond ((zerop n) (cons (funcall func 0) acc))
(t (apply-on-0-to-n (1- n) func (cons (funcall func n) acc)))))
(apply-on-0-to-n 7 #'iterPell '())
;; => (0 1 2 5 12 29 70 169)
I'm a newbie in LISP. I'm trying to write a function in CLISP to generate the first n numbers of Fibonacci series.
This is what I've done so far.
(defun fibonacci(n)
(cond
((eq n 1) 0)
((eq n 2) 1)
((+ (fibonacci (- n 1)) (fibonacci (- n 2))))))))
The program prints the nth number of Fibonacci series. I'm trying to modify it so that it would print the series, and not just the nth term.
Is it possible to do so in just a single recursive function, using just the basic functions?
Yes:
(defun fibonacci (n &optional (a 0) (b 1) (acc ()))
(if (zerop n)
(nreverse acc)
(fibonacci (1- n) b (+ a b) (cons a acc))))
(fibonacci 5) ; ==> (0 1 1 2 3)
The logic behind it is that you need to know the two previous numbers to generate the next.
a 0 1 1 2 3 5 ...
b 1 1 2 3 5 8 ...
new-b 1 2 3 5 8 13 ...
Instead of returning just one result I accumulate all the a-s until n is zero.
EDIT Without reverse it's a bit more inefficient:
(defun fibonacci (n &optional (a 0) (b 1))
(if (zerop n)
nil
(cons a (fibonacci (1- n) b (+ a b)))))
(fibonacci 5) ; ==> (0 1 1 2 3)
The program prints the nth number of Fibonacci series.
This program doesn't print anything. If you're seeing output, it's probably because you're calling it from the read-eval-print-loop (REPL), which reads a form, evaluates it, and then prints the result. E.g., you might be doing:
CL-USER> (fibonacci 4)
2
If you wrapped that call in something else, though, you'll see that it's not printing anything:
CL-USER> (progn (fibonacci 4) nil)
NIL
As you've got this written, it will be difficult to modify it to print each fibonacci number just once, since you do a lot of redundant computation. For instance, the call to
(fibonacci (- n 1))
will compute (fibonacci (- n 1)), but so will the direct call to
(fibonacci (- n 2))
That means you probably don't want each call to fibonacci to print the whole sequence. If you do, though, note that (print x) returns the value of x, so you can simply do:
(defun fibonacci(n)
(cond
((eq n 1) 0)
((eq n 2) 1)
((print (+ (fibonacci (- n 1)) (fibonacci (- n 2)))))))
CL-USER> (progn (fibonacci 6) nil)
1
2
1
3
1
2
5
NIL
You'll see some repeated parts there, since there's redundant computation. You can compute the series much more efficiently, however, by starting from the first two numbers, and counting up:
(defun fibonacci (n)
(do ((a 1 b)
(b 1 (print (+ a b)))
(n n (1- n)))
((zerop n) b)))
CL-USER> (fibonacci 6)
2
3
5
8
13
21
An option to keep the basic structure you used is to pass an additional flag to the function that tells if you want printing or not:
(defun fibo (n printseq)
(cond
((= n 1) (if printseq (print 0) 0))
((= n 2) (if printseq (print 1) 1))
(T
(let ((a (fibo (- n 1) printseq))
(b (fibo (- n 2) NIL)))
(if printseq (print (+ a b)) (+ a b))))))
The idea is that when you do the two recursive calls only in the first you pass down the flag about doing the printing and in the second call instead you just pass NIL to avoid printing again.
(defun fib (n a b)
(print (write-to-string n))
(print b)
(if (< n 100000)
(funcall (lambda (n a b) (fib n a b)) (+ n 1) b (+ a b)))
)
(defun fibstart ()
(fib 1 0 1)
)
I'm not sure how to do this and couldn't find an example of it anywhere. How do I find the position of a value in a list. For example I have a (define findValue x lst) which accepts a value and list and from that list I want type in (findValue 3 '(1 2 0 8 5 6)) and it should return 0 since the value in position 3 is 0. From my understanding and how it usually is position 3 would be 8 and not 0 in arrays at least. How does it work in here and how do I approach this problem?
Thanks!
Try:
(define (at n xs)
(cond ((null? xs) xs)
((= n 1) (car xs))
(else (at (- n 1) (cdr xs)))))
Use it as follows:
(at 3 '(1 2 0 8 5 6)) => 0
For zero-based indexing change the (= n 1) check on the 3rd line to (= n 0).
Edit: So you want to partially apply the at function? All you need is curry and flip. They are defined as follows:
(define (curry func . args)
(lambda x (apply func (append args x))))
(define (flip func)
(lambda (a b) (func b a)))
Using curry and flip you can now partially apply at as follows:
(define position (curry (flip at) '(1 2 0 8 5 6)))
You can now use position as follows:
(position 3) => 0
(position 4) => 8
Hope that helped.
Usually indexes are counted starting from 0, and your understanding is correct. But if you're required to implement a findValue procedure that starts counting indexes from 1, it's not that hard to write the procedure:
(define (findValue idx lst)
(cond ((or (null? lst) (negative? idx)) #f)
((= idx 1) (car lst))
(else (findValue (sub1 idx) (cdr lst)))))
Explanation:
If the list received as parameter is empty or the index becomes negative, we treat that as a special case and return #f to indicate that the value was not found
If the index is 1 then we're right where we wanted, so it's time to return the current element
Otherwise advance the recursion: subtract one from the index and advance one position over the list
It works as expected:
(findValue 3 '(1 2 0 8 5 6))
=> 0
(findValue -1 '(1 2 0 8 5 6))
=> #f
(findValue 7 '(1 2 0 8 5 6))
=> #f
I am trying to write a function which takes a list (x) and a number (y) and deletes every occurance of that number in the list. Ex. (deepdeleting '(0 0 1 2 0 3 0) 0) ===> '(1 2 3)
Here's what I have so far:
(define (deepdeleting x y)
(if (pair? x)
(if (eqv? (car x) y)
(begin
(set! x (cdr x))
(deepdeleting x y)
)
(deepdeleting (cdr x) y) ; else
)
x ; else
)
)
The code works, but my problem is I want it to modify the original list, not just return a new list. Right now this is what happens:
> (define list '(0 0 1 2 0 3 0))
> (deepdeleting list 0)
(1 2 3)
> list
(0 0 1 2 0 3 0) ; <<< I want this to be (1 2 3)
This seems strange to me since both the set-car! and set-cdr! functions seem to change the input list, whereas set! does not...
Any insight would be much appreciated!
When you use set! you are redefining the innermost binding:
(define test 10)
(set! test 11) ; changes global test to 11
(define (change-test value)
(set! test value))
(change-test 12) ; changes global test to 12
(define (change-test! value new-value)
(display value)
(set! value new-value) ; changes the local binding value
(display value))
(change-test! test 13) ; changes nothing outside of change-test, prints 12 then 13
Variable bindings are totally different than list structure mutation. Here a binding is used to point to a pair that is altered:
(define lst '(1 2 3))
(define lst2 (cdr lst)) ; lst2 shares structure with lst
(set-cdr! lst2 '(8 7 6 5))
lst2 ; ==> (2 8 7 6 5)
lst ; ==> (1 2 8 7 6 5) the original binding share structure thus is changed too
(set-cdr! lst lst) ; makes a circular never ending list (1 1 1 1 ...)
(eq? lst (cdr lst)) ;==> #t
(set-car! lst 2) ; changes lst to be never ending list (2 2 2 2 ...)
So you can mutate pairs with set-cdr! and set-car! and a binding to the original list will point to the first pair. Thus you need the result to start with the same pair as the first. With that you can make your mutating procedure this way:
#!r6rs
(import (rnrs) (rnrs mutable-pairs))
(define (remove! lst e)
(if (pair? lst)
(let loop ((prev lst)(cur (cdr lst)))
(if (pair? cur)
(if (eqv? (car cur) e)
(begin
(set-cdr! prev (cdr cur))
(loop prev (cdr cur)))
(loop cur (cdr cur)))
(if (eqv? (car lst) e)
(if (pair? (cdr lst))
(begin
(set-car! lst (cadr lst))
(set-cdr! lst (cddr lst)))
(error 'first-pair-error "Not possible to remove the first pair"))
#f)))
#f))
(define test '(0 0 1 2 0 3 0))
(define test2 (cdr test))
test2 ;==> (0 1 2 0 3 0)
(remove! test 0)
test ; ==> (1 2 3)
test2 ; ==> (0 1 2 0 3 0)
(remove! '(0) 0)
; ==> first-pair-error: Not possible to remove the first pair
(remove! '(1 2 3) 2) ; this works too but you have no way of checking
While lst is bound to the list during removal and the same list has one element less there was not binding to it outside of the remove! procedure so the result is forever lost.
EDIT
For R5RS remove the first two lines and add error:
;; won't halt the program but displays the error message
(define (error sym str)
(display str)
(newline))
Given a list, how do I process N items at a time? Ruby has each_slice method on the Enumerable that does this; what would be the Lisp equivalent?
Common Lisp's loop can be used for this very nicely, as in the following two examples. The first example loops for (x y z) in a list. However, the default step is cdr (rest), so if the list is (1 2 3 4 5), you get (1 2 3), (2 3 4), etc., for (x y z).
CL-USER> (loop for (x y z) on '(1 2 3 4 5 6 7 8 9 10 11 12)
do (print (list z y x)))
(3 2 1)
(4 3 2)
(5 4 3)
(6 5 4)
(7 6 5)
(8 7 6)
(9 8 7)
(10 9 8)
(11 10 9)
(12 11 10)
(NIL 12 11)
(NIL NIL 12)
NIL
If you do not want the overlap between iterations, specify the stepping function to be something that moves farther down the list. For instance, if you're pulling three elements at a time, use cdddr:
CL-USER> (loop for (x y z) on '(1 2 3 4 5 6 7 8 9 10 11 12) by 'cdddr
do (print (list z y x)))
(3 2 1)
(6 5 4)
(9 8 7)
(12 11 10)
NIL
Implementing partition with this technique
Another answer implemented the counterpart to each_slice using an auxiliary function. However, notice that partition (in that sense) is just each_slice with the identity function. This suggests that we should be able to implement it using the idiom above. The anonymous function
(lambda (list)
(nthcdr n list))
is the step function that we need. Since we do not know how many elements the cells have until run time, we can't bind each element like we did above with (x y z). We do have to match each tail of the list as we step down and extract the subsequence n elements. Here's a loop based implementation of partition.
CL-USER> (defun partition (list cell-size)
(loop for cell on list by #'(lambda (list)
(nthcdr cell-size list))
collecting (subseq cell 0 cell-size)))
PARTITION
CL-USER> (partition '(1 2 3 4 5 6) 2)
((1 2) (3 4) (5 6))
(defun partition-helper (lst acc x)
(if (< (length lst) x)
acc
(partition-helper (subseq lst x) (cons (subseq lst 0 x) acc) x)))
(defun partition (lst x)
(reverse (partition-helper lst '() x)))
Then you can:
[25]> (PARTITION '(1 2 3 4 5 6) 2)
((1 2) (3 4) (5 6))
or:
[26]> (PARTITION '(1 2 3 4 5 6) 3)
((1 2 3) (4 5 6))
and then just mapcar over the list to process it 2 or 3 elements at a time.
If you wanted to split your list on a predicate (as opposed to a fixed length sublists), I would have recommended nsplit-list.
For fixed length sublists, you may want to use loop:
(defun by-N (list n fun)
(loop for tail on list by (lambda (l) (nthcdr n l))
do (funcall fun (subseq tail 0 (min (length tail) n)))))
(by-n (loop for i from 0 to 20 collect i) 5 #'print)
(0 1 2 3 4)
(5 6 7 8 9)
(10 11 12 13 14)
(15 16 17 18 19)
(20)
Note that this is not very efficient (it scans the list more than necessary and allocates a fresh sublist for passing to fun).
The efficient version is more complicated:
(defun batch-map (list batch-size function)
"Call FUNCTION on sublists of LIST of size BATCH-SIZE.
Returns the list of return values of FUNCTION."
(do ((tail list (cdr end)) end ret (bs1 (1- batch-size)))
((endp tail) (nreverse ret))
(setq end (nthcdr bs1 tail))
(if (consp end)
(let ((next (cdr end)))
(setf (cdr end) nil)
(unwind-protect (push (funcall function tail) ret)
(setf (cdr end) next)))
(push (funcall function tail) ret))))
All the answers are practical and can be used, but I believe none replicates exactly the Ruby's behavior:
> 1.upto(7).each_slice(3) { |x, y, z| p [x, y, z] }
[1, 2, 3]
[4, 5, 6]
[7, nil, nil]
To emulate Ruby, I believe the proper code is something similar to:
CL-USER> (defun each-slice (n list thunk)
(apply thunk (loop for i below n collect (nth i list)))
(if (> (length list) n)
(each-slice n (subseq list n) thunk)))
Generates a similar response when called:
CL-USER> (each-slice 3 '(1 2 3 4 5 6 7) (lambda (x y z) (print (list x y z))))
(1 2 3)
(4 5 6)
(7 NIL NIL)
NIL