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.
Related
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))
I would like to code a program that given a list and a percentage, splits the list in two different size lists. It should have random pick of the elements, that way the created lists are always different.
These code is able to do that:
(define (clamp x a b)
(max (min x b) a))
(define (split pct xs)
(define pos (exact-round (* (clamp pct 0.0 1.0) (length xs))))
(split-at (shuffle xs) pos))
Here is an example:
(split 0.25 '(1 2 3 4 5 6 7 8 9))
'(6 2)
'(3 7 1 4 5 8 9)
But, instead of "shuffle" I would like to use this function to achieve the same:
(define (get-randomly-no-pair list)
(list-ref list (random (length list))))
so, get-randomly-no-pair takes one element randomly from the initial list. And all the elements are used to create both lists.
(define (shuffle-list lst)
(define indexes (shuffle (range (length lst))))
(lambda ()
(begin0
(list-ref lst (car indexes))
(set! indexes (cdr indexes)))))
(define gen (shuffle-list (list 10 12 14 16 18 20))
(gen) ; ==> 14 (e.g.)
Now I see you assume you need to pass the list then I would rather make a mapper:
(define (shuffle-accessor len)
(define indexes (list->vector (shuffle (range len))))
(lambda (lst index)
(list-ref lst (vector-ref indexes index))))
(define lst3-ref (shuffle-accessor 3))
(lst3-ref '(1 2 3) 0) ; ==> 3 (e.g.)
(lst3-ref '(6 7 8) 0) ; ==> 8
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 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)))
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))