I have a sorted list of integers, (1 2 4 5 6 6 7 8 10 10 10). I want to group them all, so that I get ((1) (2) (4) (5) (6 6) (7) (8) (10 10 10)).
So far I have this, which works:
(let ((current-group (list)) (groups (list)))
(dolist (n *sorted*)
(when (and (not (null current-group)) (not (eql (first current-group) n)))
(push current-group groups)
(setf current-group (list)))
(push n current-group))
(push current-group groups)
(nreverse groups))
But I'm sure there must be a much more LISPy way to do this. Any ideas?
Not that bad. I would write it this way:
(defun group (list)
(flet ((take-same (item)
(loop while (and list (eql (first list) item))
collect (pop list))))
(loop while list
collect (take-same (first list)))))
CL-USER 1 > (group '(1 2 4 5 6 6 7 8 10 10 10))
((1) (2) (4) (5) (6 6) (7) (8) (10 10 10))
There's already an accepted answer, but I think it's worth looking at another way of decomposing this problem, although the approach here is essentially the same). First, let's define cut that takes a list and a predicate, and returns the prefix and suffix of the list, where the suffix begins with the first element of the list that satisfies the predicate, and the prefix is everything before that that didn't:
(defun cut (list predicate)
"Returns two values: the prefix of the list
containing elements that do no satisfy predicate,
and the suffix beginning with an element that
satisfies predicate."
(do ((tail list (rest tail))
(prefix '() (list* (first tail) prefix)))
((or (funcall predicate (first tail))
(endp tail))
(values (nreverse prefix) tail))))
(cut '(1 1 1 2 2 3 3 4 5) 'evenp)
;=> (1 1 1) (2 2 3 3 4 5)
(let ((l '(1 1 2 3 4 4 3)))
(cut l (lambda (x) (not (eql x (first l))))))
;=> (1 1), (2 3 4 4 3)
Then, using cut, we can move down the an input list taking prefixes and suffixes with a predicate that's checking whether an element is not eql to the first element of the list. That is, beginning with (1 1 1 2 3 3) you'd cut with the predicate checking for "not eql to 1", to get (1 1 1) and (2 3 3). You'd add the first to the list of groups, and the second becomes the new tail.
(defun group (list)
(do ((group '()) ; group's initial value doesn't get used
(results '() (list* group results))) ; empty, but add a group at each iteration
((endp list) (nreverse results)) ; return (reversed) results when list is gone
(multiple-value-setq (group list) ; update group and list with the prefix
(cut list ; and suffix from cutting list on the
(lambda (x) ; predicate "not eql to (first list)".
(not (eql x (first list))))))))
(group '(1 1 2 3 3 3))
;=> ((1 1) (2) (3 3 3))
On implementing cut
I tried to make that cut relatively efficient, insofar as it only makes one pass through the list. Since member returns the entire tail of the list that begins with the found element, you can actually use member with :test-not to get the tail that you want:
(let ((list '(1 1 1 2 2 3)))
(member (first list) list :test-not 'eql))
;=> (2 2 3)
Then, you can use ldiff to return the prefix that comes before that tail:
(let* ((list '(1 1 1 2 2 3))
(tail (member (first list) list :test-not 'eql)))
(ldiff list tail))
;=> (1 1 1)
It's a simple matter, then, to combine the approaches and to return the tail and the prefix as multiples values. This gives a version of cut that takes only the list as an argument, and might be easier to understand (but it's a bit less efficient).
(defun cut (list)
(let ((tail (member (first list) list :test-not 'eql)))
(values (ldiff list tail) tail)))
(cut '(1 1 2 2 2 3 3 3))
;=> (1 1), (2 2 2 3 3)
I like to use reduce:
(defun group (lst)
(nreverse
(reduce (lambda (r e) (if (and (not (null r)) (eql e (caar r)))
(cons (cons e (car r)) (cdr r))
(cons (list e) r)))
lst
:initial-value nil)))
or using push:
(defun group (lst)
(nreverse
(reduce (lambda (r e)
(cond
((and (not (null r)) (eql e (caar r))) (push e (car r)) r)
(t (push (list e) r))))
lst
:initial-value nil)))
Related
I have a list who's length is divisible by two, and I'm looking for something similar to the answer to this question:
(loop for (a b) on lst while b
collect (+ a b))
However there is overlap between elements:
(1 2 3 4 5) -> (3 5 7 9)
adding 1 and 2 and then 2 and 3 etc.
Where as I have a list like (1 2 3 4) and am looking for something like
((1 2) (3 4))
as output. Is there a way to make loop step correctly over the list?
Another solution.
Something like this should work:
(let ((list '(1 2 3 4)))
(loop :for (a b) :on list :by #'cddr :while b
:collect (cons a b)))
Also a more verbose variant:
(let ((list '(1 2 3 4)))
(loop :for a :in list :by #'cddr
:for b :in (cdr list) :by #'cddr
:collect (cons a b)))
Another approach using the SERIES package.
See also the user manual from Richard C. Waters.
Setup
(ql:quickload :series)
(defpackage :stackoverflow (:use :series :cl))
(in-package :stackoverflow)
Code
(defun pairs (list)
(collect 'list
(mapping (((odd even) (chunk 2 2 (scan 'list list))))
(list odd even))))
scan the content of list as a "serie"
chunk it with M=2 and N=2:
This function has the effect of breaking up the input series items
into (possibly overlapping) chunks of length m. The starting positions
of successive chunks differ by n. The inputs m and n must both be
positive integers.
More precisely, (chunk 2 2 (scan '(1 2 3 4))) produces #Z(1 3) and #Z(2 4)
mapping in parallel over each odd and even element of those series, produce a series of couples, as done by (list odd even).
finally, collect the result, as a list.
Compilation
All the intermediate "series" are compiled away thanks to a stream-fusion mechanism. Here is the macro expansion when pointing at collect:
(LET* ((#:OUT-1120 LIST))
(LET (#:ELEMENTS-1117
(#:LISTPTR-1118 #:OUT-1120)
(#:COUNT-1113 0)
#:CHUNK-1114
#:CHUNK-1115
#:ITEMS-1123
(#:LASTCONS-1106 (LIST NIL))
#:LST-1107)
(DECLARE (TYPE LIST #:LISTPTR-1118)
(TYPE FIXNUM #:COUNT-1113)
(TYPE CONS #:LASTCONS-1106)
(TYPE LIST #:LST-1107))
(SETQ #:COUNT-1113 1)
(SETQ #:LST-1107 #:LASTCONS-1106)
(TAGBODY
#:LL-1124
(IF (ENDP #:LISTPTR-1118)
(GO SERIES::END))
(SETQ #:ELEMENTS-1117 (CAR #:LISTPTR-1118))
(SETQ #:LISTPTR-1118 (CDR #:LISTPTR-1118))
(SETQ #:CHUNK-1114 #:CHUNK-1115)
(SETQ #:CHUNK-1115 #:ELEMENTS-1117)
(COND ((PLUSP #:COUNT-1113) (DECF #:COUNT-1113) (GO #:LL-1124))
(T (SETQ #:COUNT-1113 1)))
(SETQ #:ITEMS-1123
((LAMBDA (ODD EVEN) (LIST ODD EVEN)) #:CHUNK-1114 #:CHUNK-1115))
(SETQ #:LASTCONS-1106
(SETF (CDR #:LASTCONS-1106) (CONS #:ITEMS-1123 NIL)))
(GO #:LL-1124)
SERIES::END)
(CDR #:LST-1107)))
CL-USER 156 > (loop with list = '(1 2 3 4)
while list
collect (loop repeat 2
while list
collect (pop list)))
((1 2) (3 4))
or
CL-USER 166 > (loop with list = '(1 2 3 4 5 6)
while (and list (cdr list))
collect (loop repeat 2 collect (pop list)))
((1 2) (3 4) (5 6))
CL-USER 167 > (loop with list = '(1 2 3 4 5 6 7)
while (and list (cdr list))
collect (loop repeat 2 collect (pop list)))
((1 2) (3 4) (5 6))
I'm trying to get the largest sublist from a list using Common Lisp.
(defun maxlist (list)
(setq maxlen (loop for x in list maximize (list-length x)))
(loop for x in list (when (equalp maxlen (list-length x)) (return-from maxlist x)))
)
The idea is to iterate through the list twice: the first loop gets the size of the largest sublist and the second one retrieves the required list. But for some reason I keep getting an error in the return-from line. What am I missing?
Main problem with loop
There are a few problems here. First, you can write the loop as the following. There are return-from and while forms in Common Lisp, but loop defines its own little language that also recognizes while and return, so you can just use those:
(loop for x in list
when (equalp maxlen (list-length x))
return x)
A loop like this can actually be written more concisely with find though. It's just
(find maxlen list :key list-length :test 'equalp)
Note, however, that list-length should always return a number or nil, so equalp is overkill. You can just use eql, and that's the default for find, so you can even write
(find maxlen list :key list-length)
list-length and maximize
list-length is a lot like length, except that if a list has circular structure, it returns nil, whereas it's an error to call length with an improper list. But if you're using (loop ... maximize ...), you can't have nil values, so the only case that list-length handles that length wouldn't is one that will still give you an error. E.g.,
CL-USER> (loop for x in '(4 3 nil) maximize x)
; Evaluation aborted on #<TYPE-ERROR expected-type: REAL datum: NIL>.
(Actually, length works with other types of sequences too, so list-length would error if you passed a vector, but length wouldn't.) So, if you know that they're all proper lists, you can just
(loop for x in list
maximizing (length x))
If they're not all necessarily proper lists (so that you do need list-length), then you need to guard like:
(loop for x in list
for len = (list-length x)
unless (null len) maximize len)
A more efficient argmax
However, right now you're making two passes over the list, and you're computing the length of each sublist twice. Once is when you compute the maximum length, and the other is when you go to find one with the maximum value. If you do this in one pass, you'll save time. argmax doesn't have an obvious elegant solution, but here are implementations based on reduce, loop, and do*.
(defun argmax (fn list &key (predicate '>) (key 'identity))
(destructuring-bind (first &rest rest) list
(car (reduce (lambda (maxxv x)
(destructuring-bind (maxx . maxv) maxxv
(declare (ignore maxx))
(let ((v (funcall fn (funcall key x))))
(if (funcall predicate v maxv)
(cons x v)
maxxv))))
rest
:initial-value (cons first (funcall fn (funcall key first)))))))
(defun argmax (function list &key (predicate '>) (key 'identity))
(loop
for x in list
for v = (funcall function (funcall key x))
for maxx = x then maxx
for maxv = v then maxv
when (funcall predicate v maxv)
do (setq maxx x
maxv v)
finally (return maxx)))
(defun argmax (function list &key (predicate '>) (key 'identity))
(do* ((x (pop list)
(pop list))
(v (funcall function (funcall key x))
(funcall function (funcall key x)))
(maxx x)
(maxv v))
((endp list) maxx)
(when (funcall predicate v maxv)
(setq maxx x
maxv v))))
They produce the same results:
CL-USER> (argmax 'length '((1 2 3) (4 5) (6 7 8 9)))
(6 7 8 9)
CL-USER> (argmax 'length '((1 2 3) (6 7 8 9) (4 5)))
(6 7 8 9)
CL-USER> (argmax 'length '((6 7 8 9) (1 2 3) (4 5)))
(6 7 8 9)
Short variant
CL-USER> (defparameter *test* '((1 2 3) (4 5) (6 7 8 9)))
*TEST*
CL-USER> (car (sort *test* '> :key #'length))
(6 7 8 9)
Paul Graham's most
Please, consider also Paul Graham's most function:
(defun most (fn lst)
(if (null lst)
(values nil nil)
(let* ((wins (car lst))
(max (funcall fn wins)))
(dolist (obj (cdr lst))
(let ((score (funcall fn obj)))
(when (> score max)
(setq wins obj
max score))))
(values wins max))))
This is the result of test (it also returns value that's returned by supplied function for the 'best' element):
CL-USER> (most #'length *test*)
(6 7 8 9)
4
extreme utility
After a while I came up with idea of extreme utility, partly based on Paul Graham's functions. It's efficient and pretty universal:
(declaim (inline use-key))
(defun use-key (key arg)
(if key (funcall key arg) arg))
(defun extreme (fn lst &key key)
(let* ((win (car lst))
(rec (use-key key win)))
(dolist (obj (cdr lst))
(let ((test (use-key key obj)))
(when (funcall fn test rec)
(setq win obj rec test))))
(values win rec)))
It takes comparison predicate fn, list of elements and (optionally) key parameter. Object with the extreme value of specified quality can be easily found:
CL-USER> (extreme #'> '(4 9 2 1 5 6))
9
9
CL-USER> (extreme #'< '(4 9 2 1 5 6))
1
1
CL-USER> (extreme #'> '((1 2 3) (4 5) (6 7 8 9)) :key #'length)
(6 7 8 9)
4
CL-USER> (extreme #'> '((1 2 3) (4 5) (6 7 8 9)) :key #'cadr)
(6 7 8 9)
7
Note that this thing is called extremum in alexandria. It can work with sequences too.
Using recursion:
(defun maxim-list (l)
(flet ((max-list (a b) (if (> (length a) (length b)) a b)))
(if (null l)
nil
(max-list (car l) (maxim-list (cdr l))))))
The max-list internal function gets the longest of two list. maxim-list is getting the longest of the first list and the maxim-list of the rest.
I am trying to create a list of digits starting from a list of numbers.
For example I want to break (11 4 6) into (1 5 6) by dividing the head of the list to 10 if the head is >= 10 and adding 1 to the next element.
My code looks like this
(defun createparameters (l)
(cond ((null l) l)
((> 9 (car l)) (setf (car l) (mod (car l ) 10))
(setf (cadr l) (+ (cadr l) 1)))
(t (createparameters (cdr l)))))
but it does not change my referenced list.
Help would be greatly appreciated.
You write that you want the operation done if the first element is greater than 9, but in your code you are doing the opposite. (> 9 (car l)) is the same as infix 9 > (car l) so you do your thing when first element is 8 or lower.
Here is a functional version of your code that continues to process the next sublist:
(defun createparameters (l)
(cond ((null l) l)
((and (consp l) (< 9 (car l)))
(cons (mod (car l ) 10)
(createparameters
(cons (+ (cadr l) 1)
(cddr l)))))
(t (cons (car l)
(createparameters (cdr l))))))
(defparameter test (list 11 11 2 3))
(setf test (createparameters test))
test ; ==> (1 2 3 3)
Here is a modified mutating version (similar to your code):
(defun createparameters (l)
(cond ((null l) l)
((< 9 (car l)) (setf (car l) (mod (car l ) 10))
(setf (cadr l) (+ (cadr l) 1))
(createparameters (cdr l)))
(t (createparameters (cdr l)))))
(defparameter test (list 11 11 2 3))
(createparameters test)
test ; ==> (1 2 3 3)
I'm starting to wonder if this is a carry so that the first element is the least significant digit and the last is the most. If so just adding one will only work if the number always are below 20 and the code will not work if the last digit became 10 or higher.
A direct approach
Here's a version that performs the task directly.
(defun decompose (digits)
"Given a list of digits (least-significant digit first), return a
list of normalized digits, i.e., where each digit is less than 10."
(do ((digits digits (rest digits)) ; iterate through the digits.
;; There's no initial digit, and the carry is initially 0.
(carry 0) (digit)
;; The result starts as '(), and adds a digit on each successive
;; iteration, where the digit is computed in the loop body.
(result '() (list* digit result)))
;; End when there are no digits left. Most of the result is
;; simply the reversed result, but if there's a non-zero carry
;; at the end, put it into a list and decompose it, too.
((endp digits)
(nreconc result (if (zerop carry) '()
(decompose (list carry)))))
;; At each iteration, add the first digit to the carry, and divide
;; by 10. The quotient is the carry for the next iteration, and
;; the remainder is the digit that's added into the results.
(multiple-value-setq (carry digit)
(floor (+ carry (first digits)) 10))))
(decompose '(10005 2 3))
;=> (5 2 3 0 1)
(decompose '(11 2 4))
;=> (1 3 4)
(decompose '(23 0))
;=> (3 2)
(decompose '(11 11 4 6))
;=> (1 2 5 6)
A modular approach
A more modular approach might break this down into two parts. First, given a list of digits, each of which might be greater than 9, we can reconstruct the original number as a number (i.e., not as a list of digits). This is pretty straightforward:
(defun digits->number (digits)
(reduce (lambda (digit number)
(+ digit (* 10 number)))
digits
:from-end t))
(digits->number '(1 2 3 4))
;=> 4321
(digits->number '(205 3))
;=> 235
Now, converting a number into a list of digits isn't too hard either.
(defun number->digits (number)
(do ((digit)
(digits '() (list* digit digits)))
((zerop number) (nreverse digits))
(multiple-value-setq (number digit)
(floor number 10))))
(number->digits 1024)
;=> (4 2 0 1)
(number->digits 8923)
;=> (3 2 9 8)
Now, we can observe that digits->number converts the digits list into the number in the form that we need, even when there are 'digits' that are greater than 9. number->digits always produces a representation where all the digits are less than 10. Thus, we can also implement decompose as number->digits of digits->number.
(defun decompose (digits)
(number->digits (digits->number digits)))
(decompose '(10005 2 3))
;=> (5 2 3 0 1)
(decompose '(11 2 4))
;=> (1 3 4)
(decompose '(23 0))
;=> (3 2)
(decompose '(11 11 4 6))
;=> (1 2 5 6)
As an interesting observation, I think you can say that the space of input for decompose is lists of non-negative integers, and that each list of non-negative integers less than 10 is a fixed point of decompose.
I am trying to write a function that takes one or more integers and returns a list of all the arguments that have the same even-odd parity as the first argument, for example
(same-parity 1 2 3 4 5 6 7)->(1 3 5 7)
(same-parity 2 3 4 5 6)->(2 4 6).
my code is
(define (same-parity g . w)
(define (iter-parity items)
(if (= (length items) 1)
(if (= (remainder items 2) (remainder g 2))
item
'())
(if (= (remainder g 2) (remainder (car items) 2))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
when try this (same-parity (list 1 2 3 4)), I got an error message:
the object (), passed as the first argument to car, is not the correct type.
Can I somebody tell me what is going on?
Your code
Here's a refactoring proposal, keeping with your basic structure:
(define (same-parity g . w)
(define filter-predicate? (if (odd? g) odd? even?))
(define (iter-parity items)
(if (null? items)
'()
(if (filter-predicate? (car items))
(cons (car items) (iter-parity (cdr items)))
(iter-parity (cdr items)))))
(cons g (iter-parity w)))
Note that it is more idiomatic
to use the procedures odd? and even? rather than remainder
to have as a base case when the list is empty, not when it has only one item (in your code this clearly avoids repetition as a positive effect).
Also, since there is a built-in filter procedure in Scheme, you could express it as follows:
(define (same-parity g . w)
(cons g (filter (if (odd? g) odd? even?) w)))
Your question
As for your question regarding (same-parity (list 1 2 3 4)): you need either (as described in your specification) use your procedure like so
(same-parity 1 2 3 4)
or to use apply here:
> (apply same-parity (list 1 2 3 4))
'(1 3)
because apply will transform (same-parity (list 1 2 3 4)) (1 parameter, a list) into (same-parity 1 2 3 4) (4 parameters).
The following Emacs Lisp function takes a list of lists and returns a list in which the items of the inner lists have been concatenated to one big list. It is pretty straight-forward and I am convinced something like this must already be part of the standard function library.
(defun flatten (LIST)
(if LIST
(append (car LIST) (flatten (cdr LIST)))
nil))
I am looking for a function that will take a single list of lists as its argument and then append all the inner lists.
(flatten '((a b) (c d)))
will give
(a b c d)
Does anyone know whether this function is already built in, and if so, under which name?
Thanks!
You're either looking for append:
(defun flatten (list-of-lists)
(apply #'append list-of-lists))
If (and only if) you know that you'll always have a list of lists.
Otherwise:
(defun flatten (list)
(mapcan (lambda (x) (if (listp x) x nil)) list))
Emacs 27.1 has flatten-tree:
(flatten-tree '((a b) (c d)))
(a b c d)
See: https://www.gnu.org/software/emacs/manual/html_node/elisp/Building-Lists.html
I stepped into this only recently whilst looking for something different; there is something that might not have been put into evidence by the test data utilized to check the function, depending on whether the original question was meant to refer to generic lists (i.e.: list of list of list of list of...) or just to two-level lists (as in the example).
The solution based on append works fine only with two-level lists, and there is a further issue with the solution based on mapcan.
Basically, the general solution has to be recursive both on car and cdr, as in the flatten defun below.
(setq l '((((1 2) 3) 4) (5 6 7)))
(defun flatten(x)
(cond ((null x) nil)
((listp x) (append (flatten (car x)) (flatten (cdr x))))
(t (list x))))
(defun flatten2(l)
(if l (append (car l) (flatten2 (cdr l))) nil))
(defun flatten3(l)
(mapcan (lambda(x) (if (listp x) x nil)) l))
(flatten l)
(1 2 3 4 5 6 7)
(apply #'append l)
(((1 2) 3) 4 5 6 7)
(flatten2 l)
(((1 2) 3) 4 5 6 7)
The further issue is with the usage of mapcan in flatten3: as mapcan hides an nconc inside, the user must remember that it alters its argument.
l
((((1 2) 3) 4) (5 6 7))
(flatten3 l)
(((1 2) 3) 4 5 6 7)
l
((((1 2) 3) 4 5 6 7) (5 6 7))
Dash is a modern list library for Emacs, and has flatten. It's the second most downloaded package on Melpa, after magit. From the readme:
-flatten (l): Takes a nested list l and returns its contents as a single, flat list.
(-flatten '((1))) ;; => '(1)
(-flatten '((1 (2 3) (((4 (5))))))) ;; => '(1 2 3 4 5)
(-flatten '(1 2 (3 . 4))) ;; => '(1 2 (3 . 4))
-flatten-n (num list): Flatten num levels of a nested list.
(-flatten-n 1 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 (3 4) ((5 6)))
(-flatten-n 2 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 3 4 (5 6))
(-flatten-n 3 '((1 2) ((3 4) ((5 6))))) ;; => '(1 2 3 4 5 6)
This package was started 2012-09.
I realize that the original question was "what is the built in function". It appears that there is none. The other solutions do not actually flatten all lists that I tested. This function appears to work. I'm posting it here because this was the first place Google hit when I did my search.
(defun flatten (LIST)
"flattens LIST"
(cond
((atom LIST) (list LIST))
((null (cdr LIST)) (flatten (car LIST)))
(t (append (flatten (car LIST)) (flatten (cdr LIST))))))
e.g.
(flatten (list "a" (list "b" "c" nil) (list (list "d" "e") "f")))
("a" "b" "c" nil "d" "e" "f")
Have a look at nconc