Use of Labels in Common Lisp - lisp

In this question on code review I have been told to use labels instead of defun. I have looked on the internet, but I couldn't find any way to use it and still keep my code the way it is.
How could I use labels in my code?

(defun example ()
(let ((a 0)
(f nil))
(macrolet ((next (state)
`(setf f (function ,state))))
(labels ((init ()
(setf a 0)
(next inc))
(inc ()
(incf a)
(next inc)
(when (> a 5)
(next reset)))
(reset ()
(setf a 0)
(next inc))
(controller ()
(funcall f)
(print a)))
(init)
(loop repeat 20
do (controller))))))
Example call:
CL-USER 7 > (example)
1
2
3
4
5
6
0
1
2
3
4
5
6
0
1
2
3
4
5
6
NIL

Related

Common lisp: loop through pairs of a list

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))

Intersection of multiple lists in elisp

How to get the intersection of multiple lists using elisp? I'm a elisp newbie but I'm imagining there is some builtin function or a nicer solution using reduce. I cobbled this together, but it seems overly complicated.
;; get the intersection of these lists
;; result should be (3 4 5)
(setq test '((0 1 2 3 4 5) (2 3 4 5 6) (3 4 5 6 7)))
(require 'cl-lib)
(cl-remove-if-not
(lambda (x) (cl-every
(lambda (y) (> (length (memq x y) ) 0 ) )
(cdr test) ) )
(car test) )
;; ( 3 4 5)
There is a cl-intersection that takes only two operands:
(cl-intersection '(0 1 2 3 4 5) '(2 3 4 5 6))
You can use it do define your own intersection:
(defun my-intersection(l)
(cond ((null l) nil)
((null (cdr l)) (car l))
(t (cl-intersection (car l) (my-intersection (cdr l))))))
(my-intersection '((0 1 2 3 4 5) (2 3 4 5 6) (3 4 5 6 7)))
Updated
Thanks to the #Tobias comment below, you could have in the new function the same keyword parameters of cl-intersection, that is (:test :test-not :key) and propagate them to all the calls to it inside the recursion.
Here is the extended version:
(defun my-intersection(l &rest cl-keys)
(cond ((null l) nil)
((null (cdr l)) (car l))
(t (apply 'cl-intersection (car l) (apply 'my-intersection (cdr l) cl-keys) cl-keys))))
Install dash third-party list manipulation library (follow instructions to install it). Then you need:
(-reduce '-intersection '((1 2 3 4) (2 3 4 5) (3 4 5 6))) ; => (3 4)
If you need a function that accepts variable number of lists, instead of a single list of lists, wrap it in a function using &rest keyword, like that:
(defun -intersection* (&rest list-of-lists)
(-reduce '-intersection list-of-lists))
;; (-intersection* '(1 2 3 4) '(2 3 4 5) '(3 4 5 6)) ; => (3 4)
If it's the first time you use -reduce, it's a “fold” function: it takes a binary function, a list of elements, and reduces them to a final result one list element at a time. This answer explains the concept behind the fold.

Elements removal from list

What I have to do is removing some elements from the list,the 1st,2nd,4th,8th,elements on positions power of 2.I figured out that the easyest way for me to solve this is to construct how the result list should look like without destroying the original list.Here's my code but it doesn't work yet,I'm getting a type error.I'm using contor to know with which element of the list I'm working with an counter to specify only the position from which the elements should be removed.My question is what am I doing wrong and how can it be fixed?
(defun remo(l)
(defparameter e ())
(setq contor 0)
(setq counter 0)
(dolist (elem l) (
(cond
(
((or (< (expt 2 contor) counter) (> (expt 2 contor) counter))
((push elem e) (setq contor (+ 1 contor))))
))
(setq counter (+1 counter))
)
)
(print e)
)
(defun remo (l)
(do ((power-of-2 1)
(counter 1 (1+ counter))
(result ())
(sublist l (cdr sublist)))
((null sublist) (nreverse result))
(if (= counter power-of-2)
(setq power-of-2 (* 2 power-of-2))
(push (car sublist) result))))
(remo '(1 2 3 4 5 6 7 8 9 10))
=> (3 5 6 7 9 10)
I already improved another of your attempts at https://stackoverflow.com/a/20711170/31615, but since you stated the real problem here, I propose the following solution:
(defun remove-if-index-power-of-2 (list)
(loop :for element :in list
:for index :upfrom 1 ; correct for language: "1st" is index 0
:unless (power-of-2-p index)
:collect element))
(defun power-of-2-p (number)
"Determines whether number, which is assumed to be a nonnegative
integer, is a power of 2 by counting the bits."
(declare (type (integer 0 *) number))
(= 1 (logcount number)))

Circular list in Common Lisp

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.

Is there a common lisp macro for popping the nth element from a list?

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)