Is there a way to do this:
(defvar long-list ((1 1 1 1) (2 2 2 2) (3 3 3 3)
(4 4 4 4) (5 5 5 5) (6 6 6 6))
(format t "magic" long-list)
To output something like:
(1 1 1 1) (2 2 2 2) (3 3 3 3)
(4 4 4 4) (5 5 5 5) (6 6 6 6)
Where I would define the number of columns to print?
I know about (format t "~/my-function/" long-list) option, but maybe there's something built-in?
The reference is being highly unhelpful on this particular topic.
OK, sorry, I actually found it: http://www.lispworks.com/documentation/lw51/CLHS/Body/f_ppr_fi.htm#pprint-tabular but before I found it, I wrote this:
(defun pplist-as-string (stream fmt colon at)
(declare (ignore colon at))
(dolist (i fmt)
(princ i stream)))
(defun ppcolumns (stream fmt colon at cols)
(declare (ignore at colon))
(when (or (not cols) (< cols 1)) (setq cols 1))
(let* ((fmt-length (length fmt))
(column-height (floor fmt-length cols))
(remainder (mod fmt-length cols))
(printed 0)
columns
column-sizes)
(do ((c fmt (cdr c))
(j 0 (1+ j))
(r (if (zerop remainder) 0 1) (if (zerop remainder) 0 1))
(i 0 (1+ i)))
((null c))
(when (or (= j (+ r column-height)) (zerop i))
(setq columns (cons c columns)
column-sizes
(cons
(+ r column-height) column-sizes))
(unless (zerop remainder)
(unless (zerop i) (decf remainder)))
(setq j 0)))
(setq columns (reverse columns)
column-sizes (reverse column-sizes))
(when (/= fmt-length (* column-height cols))
(incf column-height))
(dotimes (i column-height)
(do ((c columns (cdr c))
(size column-sizes (cdr size)))
((or (null c)))
(when (> printed (1- fmt-length))
(return-from ppcolumns))
(when (< 0 (car size))
(pplist-as-string stream (caar c) nil nil)
(when (caar c) (incf printed))
(unless (null c) (princ #\ ))
(rplaca c (cdar c))))
(princ #\newline))))
which prints it in another direction. In case you would need it.
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))
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)))
How would I recurse through nested lists?
For example, given: '((A 1 2) (B 3 4))
How would I add 2 to the second element in each nested sublist?
(defun get-p0 (points)
(loop for x from 0 to
(- (list-length points) 1) do
(+ 2 (cadr (nth x points)))
)
)
I'm not really sure why (get-p0 '((A 1 2) (B 3 4))) returns NIL.
I'd go with something like this:
(loop for (letter x y) in '((A 1 2) (B 3 4))
collect (list letter (+ 2 x) y))
The reason: it's shorter and you don't measure the length of the list in order to iterate over it (why would you do that?)
Since you ask for a recursive solution:
(defun get-p0 (lst &optional (n 0))
(if (null lst)
nil
(let ((elt1 (first lst)) (eltn (cdr lst)))
(if (listp elt1)
(cons (get-p0 elt1) (get-p0 eltn))
(cons (if (= n 1) (+ elt1 2) elt1) (get-p0 eltn (+ n 1)))))))
so
? (get-p0 '((A 1 2) (B 3 4)))
((A 3 2) (B 5 4))
and it recurses further down if necessary:
? (get-p0 '((A 0 2) ((B -4 4) (C 10 4))))
((A 2 2) ((B -2 4) (C 12 4)))
The way you put it, you can consider the problem as a basic recursion pattern: you go through a list using recursion or iteration (mapcar, reduce, etc.; dolist, loop, etc.) and apply a function to its entries. Here is a functional solution:
(defun get-p0 (points)
(mapcar #'add-2 points))
where the auxiliary function can be defined as follows:
(defun add-2 (lst)
"Add 2 to the 2nd item"
(let ((res '()))
(do ((l lst (cdr l))
(i 1 (1+ i)))
((null l) (nreverse res))
(push (if (= 2 i)
(+ 2 (car l))
(car l))
res))))
As written your 'loop' use does not return anything; thus NIL is returned. As is your code is simply iterating over x and computing something; that something isn't stored anywhere.
So, how to get your desired result? Assuming you are willing to modify each point in points, this should work:
(defun get-p0 (points)
(loop for x from 0 to (- (list-length points) 1) do
(let ((point (nth x points)))
(setf (cadr point) (+ 2 (cadr point)))))
points)
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))
(defun merge-matrix (matrix-1 matrix-2)
(if (not (or (eql (matrix-rows matrix-1) (matrix-rows matrix-2)) (null matrix-1) (null matrix-2))) (error "Invalid dimensions."))
(cond
((null matrix-1) (copy-tree matrix-2))
((null matrix-2) (copy-tree matrix-1))
(t (let ((result (copy-tree matrix-1)))
(dotimes (i (matrix-rows matrix-1))
(setf (nth i result) (nconc (nth i result) (nth i matrix-2))))
result))))
(merge-matrix '((3 1) (1 3)) '((4 2) (1 1)))
*** - EVAL: variable NULL has no value
I receive an error like that how I can fix the problem, thanks
The OP's code works for me. However I felt motivated to improve it and
I implemented the same idea (but a bit more powerful).
The semantics are the same as Matlab's vertcat.
The function appends all arguments into one big matrix.
Note that due to the declarations my code should be super efficient.
(deftype mat ()
"Non-square matrices. Last index is columns, i.e. row-major order."
`(simple-array single-float 2))
(defun are-all-elements-typep (type ls)
(reduce #'(lambda (b x) (and b (typep x type)))
ls))
(defun are-all-matrix-heights-equalp (ls)
(let ((first-height (array-dimension (first ls) 0)))
(reduce #'(lambda (b x) (and b
(= first-height
(array-dimension x 0))))
ls)))
(defun vertcat (&rest rest)
(declare (type cons rest))
(unless (are-all-elements-typep 'mat rest)
(break "At least one of the arguments isn't a matrix."))
(unless (are-all-matrix-heights-equalp rest)
(break "All Matrices must have the same number of rows."))
(let* ((height (array-dimension (first rest) 0))
(widths (mapcar #'(lambda (mat) (array-dimension mat 1)) rest))
(result (make-array (list height
(reduce #'+ widths))
:element-type 'single-float))
(current-width 0))
(dotimes (m (length rest))
(let ((e (elt rest m)))
(destructuring-bind (y x) (array-dimensions e)
(dotimes (j y)
(dotimes (i x)
(setf (aref result j (+ current-width i))
(aref e j i))))
(incf current-width (elt widths m)))))
(the mat result)))
#+nil
(let ((a (make-array '(2 3)
:initial-contents '((1s0 2s0 3s0)
(2s0 4s0 5s0))
:element-type 'single-float))
(b (make-array '(2 2)
:initial-contents '((6s0 7s0)
(9s0 8s0))
:element-type 'single-float)))
(vertcat a b a))
;=> #2A ((1.0 2.0 3.0 6.0 7.0 1.0 2.0 3.0) (2.0 4.0 5.0 9.0 8.0 2.0 4.0 5.0))
The error message you're getting suggests that lisp is trying to treat one of your calls to null as a variable. I was able to replicate this behavior by defining matrix-rows like Frank Shearar did and deleting the parentheses around the ((null matrix-1) (copy-tree matrix-2)) s-expression, for example. I'd suggest you check your parentheses, either manually or using something like SLIME, which gave me a warning when I tried to compile the function.