I am working using a visual programming environment for musical composition based on CL . I am trying to create a function that when given say 3 elements (1 2 3) will return 1, 2, 3, 1, 2, 3 etc., one number at the time each time it is evaluated. The book Common Lisp a Gentle Introduction, mentions briefly that it's possible to create circular lists using sharp-equal notation but does not get into details on how to use them.
Keep in mind that I can insert actual Lisp code in the program using a object specifically designed for that.
CL-USER 3 > (defun circular (items)
(setf (cdr (last items)) items)
items)
CIRCULAR
CL-USER 4 > (setf *print-circle* t)
T
CL-USER 5 > (circular (list 1 2 3))
#1=(1 2 3 . #1#)
Example:
CL-USER 16 > (setf c1 (circular (list 1 2 3)))
#1=(1 2 3 . #1#)
CL-USER 17 > (pop c1)
1
CL-USER 18 > (pop c1)
2
CL-USER 19 > (pop c1)
3
CL-USER 20 > (pop c1)
1
also:
CL-USER 6 > '#1=(1 2 3 . #1#)
#1=(1 2 3 . #1#)
With a bit of CLOS added:
(defclass circular ()
((items :initarg :items)))
(defmethod initialize-instance :after ((c circular) &rest initargs)
(setf (slot-value c 'items) (circular (slot-value c 'items))))
(defmethod next-item ((c circular))
(prog1 (first (slot-value c 'items))
(setf (slot-value c 'items)
(rest (slot-value c 'items)))))
CL-USER 7 > (setf circ1 (make-instance 'circular :items (list 1 2 3)))
#<CIRCULAR 40200017CB>
CL-USER 8 > (next-item circ1)
1
CL-USER 9 > (next-item circ1)
2
CL-USER 10 > (next-item circ1)
3
CL-USER 11 > (next-item circ1)
1
CL-USER 12 > (next-item circ1)
2
In Sharpsign Equal-Sign notation, it's written as #0=(1 2 3 . #0#).
Here's a function which creates such a list from the given arguments:
(defun circular (first &rest rest)
(let ((items (cons first rest)))
(setf (cdr (last items)) items)))
Then, calling (circular 1 2 3) will return the circular list you wanted. Just use car and cdr to iterate through the elements ad infinitum.
And if you really want an iterator function that takes no arguments and returns the next item for each call, here's how you might do it:
(defun make-iter (list)
(lambda ()
(pop list)))
First, you want to let the printer know to recognize circular lists instead of trying to print the whole list:
(setf *print-circle* t)
Next, you can create a circular list using the Sharpsign Equal-Sign notation:
(setq x '#1=(1 2 3 . #1#))
Here is an idea worked out for a circular list in Lisp.
;;; Showing structure of the list
;;; (next prev is-end val)
; create items
setf L-0 (L-1 L-3 t "L-0 sentry") ; this will be the sentry item so know where to stop
setf L-1 (L-2 L-0 nil "L-1")
setf L-2 (L-3 L-1 nil "L-2")
setf L-3 (L-0 L-2 nil "L-3")
; how to access L-2 from L-0
eval (first (eval (first L-0)))
; result: (L-3 L-1 NIL "L-2")
I'm not giving defun functions to make adding, removing, and accessing the items. I'm thinking that what I gave is enough to show what you need to do in any functions you define for this kind of circular list. This appeared to me to work in the Listener.
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))
Say, we would like to use a function that requires a predicate, but for some reason we're interested in other features of the function (like :start and :end parameters), so we need to supply a predicate, that always returns true.
Obviously, it's not a problem at all:
CL-USER> (defparameter *list* '(0 1 2 3 4 5))
*LIST*
CL-USER> (remove-if (lambda (x) t) *list* :start 1 :end 3)
(0 3 4 5)
Works, but not beautifully at all. And we may get ugly message that variable x is not used. Since I'm in LISP for beauty, I'm curious if there is a 'always t' predicate?
We can define it:
(defun tp (&rest rest)
(declare (ignore rest))
t)
..but may be it exists?
You're looking for the function constantly that takes an argument and returns a function that always returns that value. The predicate you need, then is (constantly t). Thus:
CL-USER> (remove-if (constantly t) '(0 1 2 3 4 5) :start 1 :end 3)
(0 3 4 5)
The notes on constantly show that you were absolutely on the right track with your proposed implementation. (You did even better, though, by adding the (declare (ignore …)).)
Notes:
constantly could be defined by:
(defun constantly (object)
#'(lambda (&rest arguments) object))
After writing this, it occurred to me that this might be a duplicate. I didn't find a proper duplicate, found a similar, more specific, question that was looking to remove a single element at a position, Is there a common lisp macro for popping the nth element from a list?, in which Rainer Joswig's answer includes:
Removing the nth element of a list:
(defun remove-nth (list n)
(remove-if (constantly t) list :start n :end (1+ n)))
This is really just a generalization of that approach, since you're working with arbitrary sequence boundaries. Thus we could have (making the boundary argument analogous to subseq's):
(defun remove-subseq (sequence &optional (start 0) end)
(remove-if (constantly t) sequence :start start :end end))
(defun remove-nth (sequence n)
(remove-subseq sequence n (1+ n)))
CL-USER> (remove-subseq '(0 1 2 3 4 5) 1 3)
(0 3 4 5)
CL-USER> (remove-nth '(0 1 2 3 4 5) 3)
(0 1 2 4 5)
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)))
(defparameter *todo* '("Conquer the world" "Bake cake"))
(defun how-many-items (list)
if (list
(1+ (how-many-items (cdr list)))
0))
(defun add-item (item)
(cons item *todo*)) ; Attempt to add an item to the todo list
(princ (how-many-items *todo*))
(princ '#\newline)
(add-item "Write a book")
(princ (how-many-items *todo*))
(princ '#\newline)
(princ (cdr *todo*))
(princ '#\newline)
I'm still learning Lisp but I can't understand why the size of the list doesn't add when I supposedly add the item "Write a book" to it, the cdr call returns "Bake Cake" and the number of items is always two.
The output is:
2
2
(Bake cake)
Your problem is that cons is non-destructive. This means that even though you're adding an item to the item to the list that *todo* contains, you're not modifying *todo*
> (defparameter x '(1 2 3))
(1 2 3)
> (cons 1 x)
(1 1 2 3)
> x
(1 2 3)
See? No modification.
Instead use push. It does modify its parameters.
> (defparameter x '(1 2 3))
(1 2 3)
> (push 1 x)
(1 1 2 3)
> x
(1 1 2 3)
You can think of push like this
(push x 1) === (setf x (cons 1 x))
In fact, it's a macro that expands to just this in some implementations.
Your output can't be real, since your function has wrong syntax.
(defun how-many-items (list)
if (list
(1+ (how-many-items (cdr list)))
0))
CL-USER 20 > (how-many-items '(1 2))
Error: The variable IF is unbound.
I'm pretty fresh to the Common Lisp scene and I can't seem to find an quick way to get the nth element from a list and remove it from said list at the same time. I've done it, but it ain't pretty, what I'd really like is something like "pop" but took a second parameter:
(setf x '(a b c d))
(setf y (popnth 2 x))
; x is '(a b d)
; y is 'c
I'm pretty sure that "popnth" would have to be a macro, in case the parameter was 0 and it had to behave like "pop".
EDIT: Here's my crap first version:
(defmacro popnth (n lst)
(let ((tempvar (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let ((,tempvar (nth ,n ,lst)))
(setf (cdr (nthcdr ,(- n 1) ,lst)) (nthcdr ,(+ n 1) ,lst))
,tempvar))))
Something like this:
Removing the nth element of a list:
(defun remove-nth (list n)
(remove-if (constantly t) list :start n :end (1+ n)))
constantly returns a function, that always returns its argument.
As a macro that accepts a place, using define-modify-macro:
(define-modify-macro remove-nth-f (n) remove-nth "Remove the nth element")
POP-NTH
(defmacro pop-nth (list n)
(let ((n-var (gensym)))
`(let ((,n-var ,n))
(prog1 (nth ,n-var ,list)
(remove-nth-f ,list ,n-var)))))
Example:
CL-USER 26 > (defparameter *list* (list 1 2 3 4))
*LIST*
CL-USER 27 > (pop-nth *list* 0)
1
CL-USER 28 > *list*
(2 3 4)
CL-USER 29 > (pop-nth *list* 2)
4
CL-USER 30 > *list*
(2 3)
Yes, Lisp has a macro for popping the N-th element of a list: it is called pop.
$ clisp -q
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdddr list))
3
[3]> list
(0 1 2 4 5)
[4]>
pop works with any form that denotes a place.
The problem is that, unlike cddr, nthcdr isn't an accessor; a form like (nthcdr 3 list) does not denote a place; it works only as a function call.
Writing a specialized form of pop is not the best answer; rather, we can achieve a more general fix by writing a clone of nthcdr which behaves like a place accessor. Then the pop macro will work, and so will every other macro that works with places like setf and rotatef.
;; our clone of nthcdr called cdnth
(defun cdnth (idx list)
(nthcdr idx list))
;; support for (cdnth <idx> <list>) as an assignable place
(define-setf-expander cdnth (idx list &environment env)
(multiple-value-bind (dummies vals newval setter getter)
(get-setf-expansion list env)
(let ((store (gensym))
(idx-temp (gensym)))
(values dummies
vals
`(,store)
`(let ((,idx-temp ,idx))
(progn
(if (zerop ,idx-temp)
(progn (setf ,getter ,store))
(progn (rplacd (nthcdr (1- ,idx-temp) ,getter) ,store)))
,store))
`(nthcdr ,idx ,getter)))))
Test:
$ clisp -q -i cdnth.lisp
;; Loading file cdnth.lisp ...
;; Loaded file cdnth.lisp
[1]> (defvar list (list 0 1 2 3 4 5))
LIST
[2]> (pop (cdnth 2 list))
2
[3]> list
(0 1 3 4 5)
[4]> (pop (cdnth 0 list))
0
[5]> list
(1 3 4 5)
[6]> (pop (cdnth 3 list))
5
[7]> list
(1 3 4)
[8]> (pop (cdnth 1 list))
3
[9]> list
(1 4)
[10]> (pop (cdnth 1 list))
4
[11]> list
(1)
[12]> (pop (cdnth 0 list))
1
[13]> list
NIL
[14]>
A possible improvement to the implementation is to analyze the idx form and optimize away the generated code that implements the run-time check on the value of idx. That is to say, if idx is a constant expression, there is no need to emit the code which tests whether idx is zero. The appropriate code variant can just be emitted. Not only that, but for small values of idx, the code can emit special variants based on the "cadavers": cddr, cdddr, rather than the general nthcdr. However, some of these optimizations might be done by the Lisp compiler and thus redundant.
I came up with a solution that is a little more efficient than my first attempt:
(defmacro popnth (n lst)
(let ((t1 (gensym))(t2 (gensym)))
`(if (eql ,n 0)
(pop ,lst)
(let* ((,t1 (nthcdr (- ,n 1) ,lst))
(,t2 (car (cdr ,t1))))
(setf (cdr ,t1) (cddr ,t1))
,t2))))
Here is it in action:
[2]> (defparameter *list* '(a b c d e f g))
*LIST*
[3]> (popnth 3 *list*)
D
[4]> *list*
(A B C E F G)
[5]> (popnth 0 *list*)
A
[6]> *list*
(B C E F G)
I have same suspicion as #6502...If I remember right...Neither push nor pop can be defined as modify-macros, the former because the place is not its first argument, and the latter because its return value is not the modified object.
Definition of define-modify-macro
An expression of the form (define-modify-macro m (p1 ... pn) f) defines a new macro m, such that a call of the form (m place a1 ... an) will cause place to be set to (f val a1 ... an), where val represents the value of place. The parameters may also include rest and optional parameters. The string, if present, becomes the documentation of the new macro.
I have this popnth works just fine:
(defun nthpop (index lst)
(pop (nthcdr (1- index) lst)))
> *list*
(1 2 3 4 5)
> (nthpop 2 *list*)
2
> *list*
(1 3 4 5)