(defun list-parser (list count)
...);;this function reads items by count from list and do some process to them.
;;i.e.convert items read from code to char, or to other things and then return it.
;;Also, the items in list should be consumed, globally.
(defmethod foo ((obj objtype-2) data-list)
(setf (slot-1 obj) (read-list data-list 1))
obj)
(defmethod foo ((obj objtype-1) data-list)
(setf (slot-1 obj) (read-list data-list 1)
(print data-list)
(slot-2 obj) (read-list data-list 2)
(print data-list)
(slot-3 obj) (foo (make-instance 'objtype-2) data-list)
(print data-list)
(slot-4 obj) (read-list data-list 3))
obj)
How to let it work like this:(read-list just works like read-byte in some way:
1.return a value read(and parsed here)
2.change the stream position(here the list)).
(let ((obj)
(data))
(setf data '(1 2 3 4 5 6 7 8)
obj (foo (make-instance 'objtype-1) data))
(print data))
>>(2 3 4 5 6 7 8)
>>(4 5 6 7 8)
>>(5 6 7 8)
>>(8)
Or rather, how do you deal with this kind of task? Do you convert list to other type?
I am not quite sure what you are after, but here is a function which creates a 'list reader' object (just a function). A list reader will let you read chunks of a list, treating it a bit like a stream.
(defun make-list-reader (l)
;; Make a list reader which, when called, returns three values: a
;; chunk of list, the length of tha chunk (which may be less than
;; how much was asked for) and the remaining length. The chunk is
;; allowed to share with L
(let ((lt l)
(len (length l)))
(lambda (&optional (n 1))
(cond
((zerop len)
(values nil 0 0))
((< len n)
(values lt len 0))
(t
(let ((it (subseq lt 0 n)))
(setf lt (nthcdr n lt)
len (- len n))
(values it n len)))))))
(defun read-from-list-reader (r &optional (n 1))
;; Read from a list reader (see above for values)
(funcall r n))
And now:
(defvar *l* (make-list-reader '(1 2 3)))
*l*
> (read-from-list-reader *l* 1)
(1)
1
2
> (read-from-list-reader *l* 2)
(2 3)
2
0
> (read-from-list-reader *l* 10)
nil
0
0
What you can't really do is write a function (not actually a function of course since it modifies its argument) which works like this while modifying its argument list. So you can write a function which will do this:
> (let ((l (list 1 2)))
(values (read-from-list l)
l))
(1)
(2)
which works by modifying the car and cdr of the first cons of l as you'd expect. But this can't work when there is no more to read: l is a cons and nil isn't a cons, so you can't ever make l nil with a function.
But in any case such a function is just a mass of traps for the unwary and generally horrid: for instance your example would involve modifying a literal, which isn't legal.
Related
I'm trying to write the "closest" function,in Lisp, without using setq/setf etc...
The function finds the nearest vector of a given vector (finding it on a list of lists).
I tried but without sets is too hard,thanks a lot.
Usually the updating of variable is done by recursion:
(defun main-function (arg)
(main-function-helper arg 0 1))
(defun main-function-helper (arg var1 var2)
(if (= arg var1)
var2
(main-function-helper arg (1+ var1) (1+ var2))))
When you're done you can put the helper into the main function:
(defun main-function (arg)
(labels ((helper (var1 var2) ; arg left out since it's not changed
(if (= arg var1)
var2
(helper (1+ var1) (1+ var2)))))
(helper 0 1)))
This is of course a silly implementation of 1+ for positive arguments.
Without set, returns a list of lists in case there are ties:
(NOTE: loop macro uses set at some point :P)
(defun euclid (v1 v2)
(sqrt (loop for x in v1 for y in v2 sum
(expt (- x y) 2))))
(defun closest (target listoflists distancefn)
(loop for l in listoflists for d = (apply distancefn (list target l))
minimizing d into min
collecting (list l d) into col
finally (return
(loop for (vec dis) in col when
(eql dis min) collect vec))))
(closest '(1 2 3) '((1 2 2) ( 1 2 2) ( 2 2 2)) #'euclid)
> ((1 2 2) (1 2 2))
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 have two lists: (1 2 3) and (a b) and I need to create something like this (1 2 3 1 2 3). The result is a concatenation of the first list as many times as there are elements in the second. I should use some of the functions (maplist/mapcar/mapcon, etc.). This is exactly what I need, although I need to pass first list as argument:
(mapcan #'(lambda (x) (list 1 2 3)) (list 'a 'b))
;=> (1 2 3 1 2 3)
When I try to abstract it into a function, though, Allegro freezes:
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) (list 'a 'b))
; <freeze>
Why doesn't this definition work?
There's already an accepted answer, but I think some more explanation about what's going wrong in the original code is in order. mapcan applies a function to each element of a list to generate a bunch of lists which are destructively concatenated together. If you destructively concatenate a list with itself, you get a circular list. E.g.,
(let ((x (list 1 2 3)))
(nconc x x))
;=> (1 2 3 1 2 3 1 2 3 ...)
Now, if you have more concatenations than one, you can't finish, because to concatenate something to the end of a list requires walking to the end of the list. So
(let ((x (list 1 2 3)))
(nconc (nconc x x) x))
; ----------- (a)
; --------------------- (b)
(a) terminates, and returns the list (1 2 3 1 2 3 1 2 3 ...), but (b) can't terminate since we can't get to the end of (1 2 3 1 2 3 ...) in order to add things to the end.
Now that leaves the question of why
(defun foo (a b)
(mapcan #'(lambda (x) a) b))
(foo (list 1 2 3) '(a b))
leads to a freeze. Since there are only two elements in (a b), this amounts to:
(let ((x (list 1 2 3)))
(nconc x x))
That should terminate and return an infinite list (1 2 3 1 2 3 1 2 3 ...). In fact, it does. The problem is that printing that list in the REPL will hang. For instance, in SBCL:
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
; <I manually stopped this, because it hung.
CL-USER> (let ((x (list 1 2 3)))
(nconc x x) ; terminates
nil) ; return nil, which is easy to print
NIL
If you set *print-circle* to true, you can see the result from the first form, though:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((x (list 1 2 3)))
(nconc x x))
#1=(1 2 3 . #1#) ; special notation for reading and
; writing circular structures
The simplest way (i.e., fewest number of changes) to adjust your code to remove the problematic behavior is to use copy-list in the lambda function:
(defun foo (a b)
(mapcan #'(lambda (x)
(copy-list a))
b))
This also has an advantage over a (reduce 'append (mapcar ...) :from-end t) solution in that it doesn't necessarily allocate an intermediate list of results.
You could
(defun f (lst1 lst2)
(reduce #'append (mapcar (lambda (e) lst1) lst2)))
then
? (f '(1 2 3) '(a b))
(1 2 3 1 2 3)
Rule of thumb is to make sure the function supplied to mapcan (and destructive friends) creates the list or else you'll make a loop. The same applies to arguments supplied to other destructive functions. Usually it's best if the function has made them which makes it only a linear update.
This will work:
(defun foo (a b)
(mapcan #'(lambda (x) (copy-list a)) b))
Here is some alternatives:
(defun foo (a b)
;; NB! apply sets restrictions on the length of b. Stack might blow
(apply #'append (mapcar #'(lambda (x) a) b))
(defun foo (a b)
;; uses loop macro
(loop for i in b
append a))
I really don't understand why b cannot be a number? You're really using it as church numbers so I think I would have done this instead:
(defun x (list multiplier)
;; uses loop
(loop for i from 1 to multiplier
append list))
(x '(a b c) 0) ; ==> nil
(x '(a b c) 1) ; ==> (a b c)
(x '(a b c) 2) ; ==> (a b c a b c)
;; you can still do the same:
(x '(1 2 3) (length '(a b))) ; ==> (1 2 3 1 2 3)
I want to define a method that will specialize on an object of array type with unsigned byte 8 elements. In sbcl, when you (make-array x :element-type '(unsigned-byte 8)) the object class is implemented by SB-KERNEL::SIMPLE-ARRAY-UNSIGNED-BYTE-8. Is there an implementation independent way of specializing on unsigned-byte array types?
Use a sharpsign-dot to insert the implementation dependent object class at read-time:
(defmethod foo ((v #.(class-of (make-array 0 :element-type '(unsigned-byte 8)))))
:unsigned-byte-8-array)
The sharpsign-dot reader macro evaluates the form at read-time, determining the class of the array. The method will be specialized on the class the particular Common Lisp implementation uses for the array.
Notice that the :ELEMENT-TYPE argument to MAKE-ARRAY does something special and its exact behavior might be a bit surprising.
By using it, you are telling Common Lisp that the ARRAY should be able to store items of that element type or some of its subtypes.
The Common Lisp system then will return an array that can store these elements. It may be a specialized array or an array that can also store more general elements.
Notice: it is not a type declaration and it will not necessarily be checked at compile or runtime.
The function UPGRADED-ARRAY-ELEMENT-TYPE tells you what element an array may actually be upgraded to.
LispWorks 64bit:
CL-USER 10 > (upgraded-array-element-type '(unsigned-byte 8))
(UNSIGNED-BYTE 8)
CL-USER 11 > (upgraded-array-element-type '(unsigned-byte 4))
(UNSIGNED-BYTE 4)
CL-USER 12 > (upgraded-array-element-type '(unsigned-byte 12))
(UNSIGNED-BYTE 16)
So, Lispworks 64bit has special arrays for 4 and 8 bit elements. For 12 bit elements it allocates an array which can store up to 16bit elements.
We generate an array which can store ten numbers of upto 12 bits:
CL-USER 13 > (make-array 10
:element-type '(unsigned-byte 12)
:initial-element 0)
#(0 0 0 0 0 0 0 0 0 0)
Let's check its type:
CL-USER 14 > (type-of *)
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (10))
It is a simple array (non-adjustable, no fill pointer).
It can store elements of type (UNSIGNED-BYTE 16) and its subtypes.
It is of length 10 and has one dimension.
In a normal function you could use etypecase to do the dispatch:
The following code isn't self-contained but should give an idea how to implement
a function that does point-wise operations when the even for 3D arrays:
(.* (make-array 3 :element-type 'single-float
:initial-contents '(1s0 2s0 3s0))
(make-array 3 :element-type 'single-float
:initial-contents '(2s0 2s0 3s0)))
Here is the code:
(def-generator (point-wise (op rank type) :override-name t)
(let ((name (format-symbol ".~a-~a-~a" op rank type)))
(store-new-function name)
`(defun ,name (a b &optional (b-start (make-vec-i)))
(declare ((simple-array ,long-type ,rank) a b)
(vec-i b-start)
(values (simple-array ,long-type ,rank) &optional))
(let ((result (make-array (array-dimensions b)
:element-type ',long-type)))
,(ecase rank
(1 `(destructuring-bind (x)
(array-dimensions b)
(let ((sx (vec-i-x b-start)))
(do-region ((i) (x))
(setf (aref result i)
(,op (aref a (+ i sx))
(aref b i)))))))
(2 `(destructuring-bind (y x)
(array-dimensions b)
(let ((sx (vec-i-x b-start))
(sy (vec-i-y b-start)))
(do-region ((j i) (y x))
(setf (aref result j i)
(,op (aref a (+ j sy) (+ i sx))
(aref b j i)))))))
(3 `(destructuring-bind (z y x)
(array-dimensions b)
(let ((sx (vec-i-x b-start))
(sy (vec-i-y b-start))
(sz (vec-i-z b-start)))
(do-region ((k j i) (z y x))
(setf (aref result k j i)
(,op (aref a (+ k sz) (+ j sy) (+ i sx))
(aref b k j i))))))))
result))))
#+nil
(def-point-wise-op-rank-type * 1 sf)
(defmacro def-point-wise-functions (ops ranks types)
(let ((specific-funcs nil)
(generic-funcs nil))
(loop for rank in ranks do
(loop for type in types do
(loop for op in ops do
(push `(def-point-wise-op-rank-type ,op ,rank ,type)
specific-funcs))))
(loop for op in ops do
(let ((cases nil))
(loop for rank in ranks do
(loop for type in types do
(push `((simple-array ,(get-long-type type) ,rank)
(,(format-symbol ".~a-~a-~a" op rank type)
a b b-start))
cases)))
(let ((name (format-symbol ".~a" op)))
(store-new-function name)
(push `(defun ,name (a b &optional (b-start (make-vec-i)))
(etypecase a
,#cases
(t (error "The given type can't be handled with a generic
point-wise function."))))
generic-funcs))))
`(progn ,#specific-funcs
,#generic-funcs)))
(def-point-wise-functions (+ - * /) (1 2 3) (ub8 sf df csf cdf))
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)