looping through two lists while updating one of the lists - lisp

I have two lists as follows:
(x y z) & (2 1)
and I want to have a result like:
((x y) (z))
The relation of the lists is quite clear. So basically I want to rearrange the members of the first list into a list of lists with two (length of second list) lists.
I have tried running two dotimes iterations to do this:
(let ((result) (list1* list1))
(dotimes (n (length list2) result)
(progn (setq result
(append result
(list (let ((result2))
(dotimes (m (nth n list2) result2)
(setq result2
(append result2
(list (nth m list1*)))))))))
(setq list1*
(subseq list1* 0 (nth n list2))))))
The idea is that I make the first list of the expected result (x y), and then I want to update the (x y z) list so that the x any y are removed and I only have (z). Then the loop runs again to get the (z) list in the expected result. This does not work correctly and results in:
((x y) (x))
which means apparently the second command for progn which is basically updating the list1* is not working. Clearly there must be a correct and better way of doing this and I was wondering whether anyone can help with this. Also explain why it is not possible to have the solution explained?

If I see that right, your problem is in (subseq list1* 0 (nth n list2)), which returns the part of the list that you do not want.
I have the following to offer:
(defun partition-list (list lengths)
(mapcar (lambda (length)
(loop :repeat length
:collect (pop list)))
lengths))
This is a bit simplistic, of course, as it does not handle unexpected input, such as (length list) being smaller than (reduce #'+ lengths), but it can be expanded upon.

Just for the sake of example, an alternative using iterate:
(defun partition-list (list by)
(iter:iter
(iter:for element in list)
(iter:for i from 1)
(iter:generating measure in by)
(iter:collect element into sublist)
(when (= (or measure (iter:next measure)) i)
(iter:collect sublist)
(iter:next measure)
(setf i 0 sublist nil))))

Related

Common Lisp - Function which return an element appears n times in a list

I'm trying to write a function which return an element appears n times in a list.
For example, for a list like : (setq lst '(a b b b c)), the function returns :
count-list (lst 3) --> b
But when there is two element (or more) which appears in n same time, the function only returns the first element :
count-list (lst 1) --> a
Instead of
count-list (lst 1) --> a b
Here is the function :
(defun count-list (lst nb)
(loop for x in lst do
(if (eq (count x lst) nb)
(return x)
)
)
)
What did I miss ?
return tells the count-list function to exit immediately as soon as it finds a hit, so it won't look for other elements matching the count.
One possible solution is this:
(defun count-list (lst n)
(remove-duplicates
(mapcan #'(lambda (x)
(when (eql (count x lst) n)
(list x) ))
lst )))
However, this is very inefficient since for each item the list has to be traversed twice, one for the function itself and one for count, so this would take a time proportional to the square of the length of the list.
A more efficient way would be to accumulate the values (e.g. in an assoc list) and select at the end those items matching the input count number.
(defun count-list (lst n)
(let* (count-list pair)
(dolist (x lst)
(if (setq pair (assoc x count-list))
(incf (cdr pair))
(push (cons x 1) count-list) ))
(mapcan #'(lambda (pair)
(when (eql n (cdr pair))
(list (car pair)) ))
count-list )))
I never used LISP. I assume your problem is that your function returns at the first match. Either create an array in your function for storing all the elements appearing n times and return to that array, or, for example, in Python I would use print(x) so the function does not return at the first match, like in your case.

LISP: how to get running sum of a list? (without a global variable)

I am a LISP newbie.
To get the running sum of a list, I am writing like --
(setf sum 0.0)
(mapcar #'(lambda(x)
(setf sum (+ sum x)) sum) values))
For example, if you give '(1 2 3 4) as input, the above code returns '(1 3 6 10) as output and so forth.
Is it possible to do the same thing (in a more elegant way) without using the global variable sum ?
(loop for x in '(1 2 3 4) sum x into y collect y)
scanl is a oneliner:
(defun scanl (f init xs)
(loop for x in xs collect (setf init (funcall f init x))))
You could use loop, like this:
(defun running-sum (xs)
(loop with sum = 0
for x in xs
collect (setf sum (+ sum x))))
(running-sum '(1 2 3 4))
It's fundamentally the same thing, but it uses a local variable instead of a global one, and might be more clear.
Alternatively, you could define a recursive function, and a wrapper function:
(defun running-sum-recursive (xs)
(running-sum-recursive2 0 xs))
(defun running-sum-recursive2 (sum xs)
(if (eq xs nil)
nil
(let ((new-sum (+ sum (car xs))))
(cons new-sum (running-sum-recursive2 new-sum (cdr xs))))))
(running-sum-recursive '(1 2 3 4))
However this seems needlessly complicated to me when loop is available.
Note that in Haskell, you could do a running sum like this:
runningSum xs = scanl1 (+) xs
runningSum [1, 2, 3, 4]
The key here is the scanl1 function. It's possible that something similar exists in Lisp (and we've very nearly written it twice now), but I haven't used Lisp in a while.
Edit: After some searching, I don't think Common Lisp includes anything quite like scanl or scanl1, so here they are:
(defun scanl (f val xs)
(loop for x in xs
collect (setf val (funcall f val x))))
(defun scanl1 (f xs)
(cons (car xs)
(scanl f (car xs) (cdr xs))))
(scanl1 #'+ '(1 2 3 4))
Edit: Thanks to huaiyuan's answer for a suggestion about how the loops could be shortened.
Or you could use higher-order functions
(define (running-sum ls)
(cdr (reverse (foldl (lambda (y xs) (cons (+ (car xs) y) xs)) '(0) ls))))
Haskell does have a rich inventory of functions for list recursion, but we've got reduce at least. Here is an elementary (i. e. without the loop magic) functional solution:
(defun running-sum (lst)
(reverse (reduce (lambda (acc x)
(cons (+ (first acc) x) acc))
(rest lst)
:initial-value (list (first lst)))))
I'm using the head of the original list as the initial value and walk through the rest of the list adding sums at the head (because it's natural to add at the head), finally reversing the list thus obtained.
One can use reduce in most cases when there's a need to traverse a sequence accumulating a value.
Here is an elementary iterative solution using the push-nreverse idiom:
(defun running-sum (lst)
(let ((sums (list (first lst))))
(dolist (x (rest lst))
(push (+ x (first sums)) sums))
(nreverse sums)))
In Scheme I would calculate the sum of the list recursively using an accumulator. Like so:
; Computes a list of intermediary results of list summation
(define list-sum
(lambda (l)
(letrec ((recsum (lambda (lst acc acclst)
(if (pair? lst)
(recsum (cdr lst) (+ acc (car lst)) (cons acc acclst))
(cons acc acclst)))))
(recsum (cdr l) (car l) '()))))
Output:
> (list-sum '(1 2 3 4))
(10 6 3 1)
> (list-sum '(2 4 6 8 10))
(30 20 12 6 2)
>
The trick to recurse over a list is to take the first element/car off each time and pass the rest/cdr. You can keep intermediary results by using an extra parameter (called an accumulator) and pass the sum in that. I've used two accumulators above: one for the last sum and one for a list of all previous sums.
I've never done anything in LISP, so I can't tell if this translates directly to your dialect(?), but it's conceptually simple and I'm sure it's doable in LISP as well.
Do ask if something is not immediately clear. It's been a while since I've used this family of languages :)

LISP - count occurences of every value in a list

I apologize for the bad English..
I have a task to write a function called "make-bag" that counts occurences of every value in a list
and returns a list of dotted pairs like this: '((value1 . num-occurences1) (value2 . num-occurences2) ...)
For example:
(make-bag '(d c a b b c a))
((d . 1) (c . 2) (a . 2) (b . 2))
(the list doesn't have to be sorted)
Our lecturer allows us to us functions MAPCAR and also FILTER (suppose it is implemented),
but we are not allowed to use REMOVE-DUPLICATES and COUNT-IF.
He also demands that we will use recursion.
Is there a way to count every value only once without removing duplicates?
And if there is a way, can it be done by recursion?
First of, I agree with Mr. Joswig - Stackoverflow isn't a place to ask for answers to homework. But, I will answer your question in a way that you may not be able to use it directly without some extra digging and being able to understand how hash-tables and lexical closures work. Which in it's turn will be a good exercise for your advancement.
Is there a way to count every value only once without removing duplicates? And if there is a way, can it be done by recursion?
Yes, it's straight forward with hash-tables, here are two examples:
;; no state stored
(defun make-bag (lst)
(let ((hs (make-hash-table)))
(labels ((%make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(%make-bag (cdr lst)))
hs)))
(%make-bag lst))))
Now, if you try evaluate this form twice, you will get the same answer each time:
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
And this is a second example:
;; state is stored....
(let ((hs (make-hash-table)))
(defun make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(make-bag (cdr lst)))
hs)))
Now, if you try to evaluate this form twice, you will get answer doubled the second time:
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 5
> T
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 10
> T
Why did the answer doubled?
How to convert contents of a hash table to an assoc list?
Also note that recursive functions usually "eat" lists, and sometimes have an accumulator that accumulates the results of each step, which is returned at the end. Without hash-tables and ability of using remove-duplicates/count-if, logic gets a bit convoluted since you are forced to use basic functions.
Well, here's the answer, but to make it a little bit more useful as a learning exercise, I'm going to leave some blanks, you'll have to fill.
Also note that using a hash table for this task would be more advantageous because the access time to an element stored in a hash table is fixed (and usually very small), while the access time to an element stored in a list has linear complexity, so would grow with longer lists.
(defun make-bag (list)
(let (result)
(labels ((%make-bag (list)
(when list
(let ((key (assoc (car <??>) <??>)))
(if key (incf (cdr key))
(setq <??>
(cons (cons (car <??>) 1) <??>)))
(%make-bag (cdr <??>))))))
(%make-bag list))
result))
There may be variations of this function, but they would be roughly based on the same principle.

Changing the nth element of a list

I want to change the nth element of a list and return a new list.
I've thought of three rather inelegant solutions:
(defun set-nth1 (list n value)
(let ((list2 (copy-seq list)))
(setf (elt list2 n) value)
list2))
(defun set-nth2 (list n value)
(concatenate 'list (subseq list 0 n) (list value) (subseq list (1+ n))))
(defun set-nth3 (list n value)
(substitute value nil list
:test #'(lambda (a b) (declare (ignore a b)) t)
:start n
:count 1))
What is the best way of doing this?
How about
(defun set-nth4 (list n val)
(loop for i from 0 for j in list collect (if (= i n) val j)))
Perhaps we should note the similarity to substitute and follow its convention:
(defun substitute-nth (val n list)
(loop for i from 0 for j in list collect (if (= i n) val j)))
BTW, regarding set-nth3, there is a function, constantly, exactly for situation like this:
(defun set-nth3 (list n value)
(substitute value nil list :test (constantly t) :start n :count 1))
Edit:
Another possibility:
(defun set-nth5 (list n value)
(fill (copy-seq list) value :start n :end (1+ n)))
It depends on what you mean for "elegance", but what about...
(defun set-nth (list n val)
(if (> n 0)
(cons (car list)
(set-nth (cdr list) (1- n) val))
(cons val (cdr list))))
If you have problems with easily understanding recursive definitions then a slight variation of nth-2 (as suggested by Terje Norderhaug) should be more "self-evident" for you:
(defun set-nth-2bis (list n val)
(nconc (subseq list 0 n)
(cons val (nthcdr (1+ n) list))))
The only efficiency drawback I can see of this version is that traversal up to nth element is done three times instead of one in the recursive version (that's however not tail-recursive).
How about this:
(defun set-nth (list n value)
(loop
for cell on list
for i from 0
when (< i n) collect (car cell)
else collect value
and nconc (rest cell)
and do (loop-finish)
))
On the minus side, it looks more like Algol than Lisp. But on the plus side:
it traverses the leading portion of the input list only once
it does not traverse the trailing portion of the input list at all
the output list is constructed without having to traverse it again
the result shares the same trailing cons cells as the original list (if this is not desired, change the nconc to append)

Position of All Matching Elements in List

I'm trying to write a function in Common Lisp similar to the built in position function, that returns a list of the positions of all elements in the haystack that match the needle, as opposed to just the first. I've come up with a few possible solutions (for example recursively searching for the next element using a cdr-from function on the position and adding the result to the previous position) but none of the approaches I've come up with so far seem particularly elegant.
Can anyone suggest what would be the best way of approaching this, as I'm currently struggling.
The obvious way to solve the problem is just to look at each element of the list in turn, and each time one compares as equal to the needle collect its position into an output list. Getting the position is very easy in this case, because we are starting from the beginning of haystack; we can use a variable to count the current position starting from 0.
So if we describe the full algorithm in a sentence, we'd say something like "to find all the positions of a needle in a haystack, for each element in the haystack, and the position starting from 0, when the element is equal to the needle, collect the position."
The LOOP facility is basically the right thing to break out when you want to do iterative processing. Even though its syntax is complicated to describe formally, after some experience you can pretty much just put the English-language description of the algorithm in the body of LOOP and it will work.
(defun all-positions (needle haystack)
(loop
for element in haystack
and position from 0
when (eql element needle)
collect position))
Take this one with a grain of salt (and be sure to load Alexandria beforehand):
(defun positions (item sequence &key (test #'eql))
(mapcar #'car
(remove item (map 'list #'cons (alexandria:iota (length sequence)) sequence)
:test-not test
:key #'cdr)))
That said, it does have the advantage of working on arbitrary sequences:
CL-USER> (positions 'x #(x x y y x x y y))
(0 1 4 5)
CL-USER> (positions 5 (list 5.0 -1 5 5.0 -1) :test #'=)
(0 2 3)
CL-USER> (positions #\l "Hello")
(2 3)
If you want a recursive function, rather than a (loop ...) based one, you could use something like:
(defun all-positions (needle haystack)
(labels ((f (n h c r)
(if (null h)
r
(if (eql (car h) n)
(f n (cdr h) (1+ c) (cons c r))
(f n (cdr h) (1+ c) r))))))
(reverse (f needle haystack 0 nil)))
Here's another (not necessarily better) way to do it.
(defun get-positions (needle haystack)
(let ((result nil))
(dotimes (i (length haystack))
(if (eq (nth i haystack) needle)
(push i result)))
(nreverse result)))