How to do stored in place adjoin in lisp - lisp

I'm new to lisp and I'm looking for a function to do a stored in place adjoin, is there any? i found the pushnew macro but it seems to work on items not lists.
(pushnew '((1)) '((1) (1 2) (1 2 3)))
(pushnew '(1) lst) => ((1) (1) (1 2) (1 2 3))

PUSHNEW is the modifying version of ADJOIN. You need to use the proper :TEST argument for comparing the kind of elements the list contains (such as #'EQUAL for lists).
CL-USER> (defparameter *list* (list (list 1)
(list 1 2)
(list 1 2 3)))
*LIST*
CL-USER> (adjoin '(1) *list*) ; Adds
((1) (1) (1 2) (1 2 3))
CL-USER> (adjoin '(1) *list* :test #'equal) ; Doesn't add
((1) (1 2) (1 2 3))
CL-USER> (pushnew '(1) *list*) ; Pushes
((1) (1) (1 2) (1 2 3))
CL-USER> *list*
((1) (1) (1 2) (1 2 3))
CL-USER> (pushnew '(1) *list* :test #'equal) ; Doesn't push
((1) (1) (1 2) (1 2 3))

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

cons two elements outputs the wrong result

#lang racket
I need to create a pair from an element and a list
however when I do (cons 2 (list 1 2 3)) I get (2 (1 2 3)), I want to get (2 . (1 2 3))
how do I get the dot in ?
Since (cons a b) is the same as (a . b) we get that (2 . (1 2 3)) is the same as (cons 2 (list 1 2 3) which is the same as (list 2 1 2 3). To confirm:
> (cons 2 (list 1 2 3))
'(2 1 2 3)
> '(2 . (1 2 3))
'(2 1 2 3)
Note that the printer prints (2 1 2 3) and not (2 . (1 2 3)). The printer attempts to use the dot only when absolutely needed.
There is a difference between the syntax that explains the structure, how it's stored and how display would represent it.
For a list of two elements there are two ways you can represent it (1) and (1 . ()). When this list is displayed it will always prefer the one with the least parentheses. Thus '(2 . (1 2 3)) will always be printed as (2 1 2 3) by display. If you don't want that you can make yourself a cons-write like:
;; displays cons always as dotted
(define (cons-write x)
(if (pair? x)
(begin
(display "(")
(cons-write (car x))
(display " . ") ; spaces are important
(cons-write (cdr x))
(display ")"))
(write x)))
(cons-write '(1 2 3 4)) ; prints (1 . (2 . (3 . (4 . ()))))

Find and remove a list item based on the item's third element

I need to find and return the first item in a list when that item's third element matches a value passed into the function. I then need that item to be permanently removed from the list.
I have written this function to do it and am wondering if there are any built-in functions that might accomplish the same without this fairly messy implementation:
(defun find-remove-third (x)
(let ((item (first (member x *test-list* :key #'third))))
(setf *test-list* (remove item *test-list* :test #'equal))
item))
Operation:
CL-USER> *test-list*
((1 2 3) (2 3 4) (3 4 5) (4 4 4) (5 4 3) (6 5 4) (2 2 2))
CL-USER> (find-remove-third 4)
(2 3 4)
CL-USER> *test-list*
((1 2 3) (3 4 5) (4 4 4) (5 4 3) (6 5 4) (2 2 2))
CL-USER> (find-remove-third 4)
(4 4 4)
CL-USER> *test-list*
((1 2 3) (3 4 5) (5 4 3) (6 5 4) (2 2 2))
For example pop mutates and returns from a list, though is more limited, but I'm wondering if anything more elegant than my function above might be possible, or if this implementation is normal and idiomatic?
Your implementation scans the list twice, so it is suboptimal.
I don't think you can write what you need without an explicit loop (or, equivalently, recursion):
(defun pop-from-list (object list &key (key #'identity) (test #'eql) kept)
"Like `remove', but return the object removed as the second value."
(let ((1st (car list)))
(if (funcall test object 1st)
(values (revappend kept (rest list))
1st)
(pop-from-list object (rest list) :key key :test test
:kept (cons 1st kept)))))
Now you can define your function like this:
(defun find-remove-third (x)
(multiple-value-bind (list object)
(pop-from-list x *test-list* :key #'third)
(setq *test-list* list)
object))
Edit - Deleting this doesn't seem right so I'll leave it up, but as noted by #sds and #WillNess in the comments, this has serious issues.
Here's a destructive version which only scans the list once. It has the potential benefit that you don't have to hardcode the name of the list you're operating on.
CL-USER> (defun find&remove (list obj &key (key #'identity) (test #'eql))
(loop with last = nil
for cons on list
when (funcall test obj (funcall key (first cons))) do
(progn (setf (rest last) (rest cons))
(return (first cons)))
do (setf last cons)))
CL-USER> (defvar test-list (list (list 1 2 3)
(list 3 4 5)
(list 5 6 7)
(list 8 9 10)))
CL-USER> (find&remove test-list 5 :key #'third)
(3 4 5)
CL-USER> test-list
((1 2 3) (5 6 7) (8 9 10))
CL-USER> (find&remove test-list 7 :key #'third)
(5 6 7)
CL-USER> test-list
((1 2 3) (8 9 10))
The key is to traverse the list by cons cell rather than by item (loop for ... on rather than loop for ... in) and keep a pointer to the parts of the list we've already looked at (last). Then, when we find what we're looking for, we connect the cdr of what we'd already seen to the next cons (so now the list omits the "hit") and finally return the result.

Adding two or more list based on it's pair in a list

I am not too proficient with functional style and I don't want to use any set functions, so I have a problem. I am really struggling whether I should do recursively or in a different manner.
I have a collection of pairs in a list, like so:
((4 2) (3 1) (3 2) (2 4) etc...)
In this pair '(4 2), the second element '2' tells me which other pairs it matches to, in this case '(3 2).
So, I add these two pairs together using their first element, in this case, it's '4' and '3'.
The new pair is now '(7 2). And so on for other pairs in the list too.
Finally, it should return:
((7 2) (3 1) (2 4))
I would care less about the order.
.
I already have a working function that add two different pairs. The only assumption with this function is that the pairs are matching.
Consequently, what I want to do is manipulated this list of pairs to return a list in these manners.
Examples:
take the list ((4 2) (3 1) (3 2) (2 4))
matching-pairs: '(4 2) and '(3 2)
and then return --> ((7 2) (3 1) (2 4))
take the list ((2 1) (3 2) (1 2) (5 1) (6 3))
matching-pairs: '(2 1) and '(5 1)
'(3 2) and '(1 2)
and then return --> ((7 1) (4 2) (6 3))
Thank you for your time and efforts.
Iterate over your list and store each pair's car into a list in an assoc that looks like this:
original: ((2 . 1) (3 . 2) (1 . 2) (5 . 1) (6 . 3))
new: ((1 . (2 5))
(2 . (3 1))
(3 . (6))
Then sum together all the cdrs and flip each pair to get this:
((7 . 1) (4 . 2) (6 . 3))
(defun get-pairs (alist index)
(cond
(alist
(if (= (nth 1 (car alist)) index)
(append (list (caar alist)) (get-pairs (cdr alist) index))
(get-pairs (cdr alist) index)))
((not alist)
'nil)))
(defun get-iterator (alist)
(labels
((f (alist res)
(cond
(alist
(if (member (nth 1 (car alist)) res)
(f (cdr alist) res)
(f (cdr alist) (append (cdar alist) res))))
((not alist)
res))))
(f alist 'nil)))
(defun get-value (alist)
(loop for i in (get-iterator alist)
collect (get-pairs alist i)))
(defun list-sum (alist)
(loop for i in (get-value alist)
collect (apply #'+ i)))
(defun match-value (alist)
(loop for i in (get-iterator alist)
for j in (list-sum alist)
collect (append (list j) (list i))))
(defparameter *my-list* '((2 1) (3 1) (4 2) (5 2) (8 1) (9 2) (1 3) (0 3)))
(print (match-value *my-list*))
Sorry for the messy code but that should do the trick if I understood the problem right.

Common Lisp: Why not the array literal evaluate arguments?

Why is it that the Common Lisp array syntax is not evaluating its arguments:
(let ((a 1)) #2A((a 2) (3 4)))
=> #2A((A 2) (3 4))
I would have guessed it was #2A((1 2) (3 4)). Is this because A is not available at reader time?
In short, yes.
#2A((A 2) (3 4)) is not an abbreviation ("syntactic sugar") for (make-array '(2 2) :initial-contents (list (list a 2) (list 3 4))). If anything, it could be rationalized as (make-array '(2 2) :initial-contents (quote ((A 2) (3 4)))), but this would be a bit misleading as the array construction already happens at read-time.