(Assignment help, go easy on me) (I have to do this without using destructive functions (setf))
With common lisp, as part of some code I need to be able to:
Take a list of lists,
compare the cdr of 2 elements,
If equal disregard the first element,
If not equal then try and compare the first element with the next unchecked element in the list.
Some examples to clarify:
((1 1 1) (2 1 1) (3 1 1)) -> ((3 1 1))
((2 2 0) (4 1 1) (1 2 0) (3 0 1) (8 1 1)) -> ((1 2 0) (3 0 1) (8 1 1))
(defun simplify2 (vari)
;If last term: stop
(if (equal (cdr vari) nil) vari
;If cdr of first and second term are equal...
(if (equal (cdar vari) (cdr (cadr vari)))
;Ignore the first term and continue with the rest of the list
(simplify2 (cdr vari))
;Otherwise (this is the line which isn't working)
(cons (car vari) (simplify2 (cdr vari))))))
At the moment the code will only work properly when all 'like' terms are placed next to each other in the list.
Le Petit Prince's suggestion in the comments to use remove-duplicates is probably what you want here. remove-duplicates is non-destructive (cf. delete-duplicates which can be destructive), and it's specified to a return a new list in which all but the last instance of an element are omitted (emphasis added):
remove-duplicates
remove-duplicates returns a modified copy of sequence from which any
element that matches another element occurring in sequence has been
removed. … The elements of sequence are compared pairwise, and
if any two match, then the one occurring earlier in sequence is
discarded, unless from-end is true, in which case the one later in
sequence is discarded.
You'll need to specify the a key argument to indicate that what should actually be compared is the cdr of the elements, and a test argument to indicate that they should be compared with equal. Thus:
(remove-duplicates '((1 1 1) (2 1 1) (3 1 1))
:test 'equal
:key 'cdr)
;=> ((3 1 1))
(remove-duplicates '((2 2 0) (4 1 1) (1 2 0) (3 0 1) (8 1 1))
:test 'equal
:key 'cdr)
;=> ((1 2 0) (3 0 1) (8 1 1))
Related
The background here is that I have a non-destructive version of a function that I want to make destructive for performance reasons. However, writing unit tests gets challenging because lisp considers all quoted lists in the source code to be constants and changing those leads to undefined behaviour.
I'm using parachute as the unit testing framework
e.g.,
(define-test suite-1
(let ((start '((1 2) (3 4) (5 6)))
(end '((7 1 2) (3 4) (5 6))))
(is #'equal end (push 7 (car start))))
(let ((start '((1 2) (3 4) (5 6)))
(end '((8 1 2) (3 4) (5 6))))
(is #'equal end (push 8 (car start)))))
This kinda fails because we end up pushing 8 onto the constant list (1 2) which eventually causes (push 8 (car start)) to result in (8 7 1 2) instead of the expected (8 1 2)
This isn't a problem with testing non-destructive functions because they don't modify constants. This is also not a problem outside of unit tests because I know that the original structure will no longer be needed.
I could replace the above with this ugly thing :-
(let ((start (list (list 1 2) (list 3 4) (list 5 6))) ...
which then creates a proper non-constant list but it sure does make the code unreadable...
Any suggestions on how other people approach this?
Use COPY-TREE to make a deep copy of the quoted list structure.
(let ((start (copy-tree '((1 2) (3 4) (5 6)))))
...
)
Your example has several mistakes.
(define-test suite-1
(let ((start '((1 2) (3 4) (5 6)))
(end '((7 1 2) (3 4) (5 6))))
(is #'equal end (push 7 (car start))))
(let ((start '((1 2) (3 4) (5 6)))
(end '((8 1 2) (3 4) (5 6))))
(is #'equal end (push 8 (car start)))))
These are two independent let expressions. Meaning,
the start in the first expression - no matter what destructive function you apply on it - can't affect the start in the second expression.
Since inbetween, it got newly created using the same quoted list expression.
Second, (push 7 (car start)) doesn't return the entire start content, thus just it returns only the modified car of start.
Therefore, you can't compare it with end but you should compare it to (car end) for equality.
If you do that, your code should run through.
I tested it by:
(defun test ()
(let ((start '((1 2) (3 4) (5 6)))
(end '((7 1 2) (3 4) (5 6))))
(assert (equal (car end) (push 7 (car start)))))
(let ((start '((1 2) (3 4) (5 6)))
(end '((8 1 2) (3 4) (5 6))))
(assert (equal (car end) (push 8 (car start)))))
(print "successfully run through."))
;; and then run:
(test)
;;
;; "successfully run through."
'' "successfully run through."
So the asserts were fulfilled.
SBCL warns about applying destructive function on constant data. But the constant data applies only wihin the let expression you are using. But outside of it, in a new let expression, a '((1 2) (3 4) (5 6)) would produce the same list always.
I couldn't believe when I saw your example that - if you would use (car end) to test for equality, that it would give in the second expression anything else than T.
The start in the first let's scope has nothing to do with the start in the second let's scope
You can easily prove it by:
(eq '((1 2) (3 4)) '((1 2) (3 4)))
;; => NIL
So with every redefinition of a literal object, you create a new entity in a new place. Thus mutations of the first start can't affect the second start which is freshly defined in a new scope (let expression).
This is why I criticize your example - which would only make sense if the same literal refers to the same place.
So I was wrong
#adabsurdum in the comments gave even the link to a discussion about this behavior that some implementations even collapse literal objects into one - according to CLtL. Thank you for being patient and explaining this all to me!!
(define is1?
(lambda (tuple)
(if (and (= 2 (length tuple))
(= 1 (- (cadr tuple) (car tuple)))
(list? tuple))
#t
#f)))
(define greenlist?
(lambda (x) (andmap is1? x)))
(greenlist? '((2 4 6) (5 6) (1 2)))
(greenlist? '(3 4 5 6))
The second command: (greenlist? '(3 4 5 6)) returns an error when it should return false.
Instead I get this error:
length: contract violation
expected: list?
given: 3
What should I change in my code so it returns false instead of an error?
Here is the definition of a greenlist:
A greenlist is a non-empty list of pairs of integers where a pair of
integers is a list of exactly two integers and where each pair '( x y) has the property that y – x = 1.
Example: '((5 6) (3 4) (2 3) (-5 -4)) is a greenlist.
The problem is that the order of the conditions matters: in an and expression the conditions are evaluated in left-to-right order, if one condition is false then the other conditions are skipped (short-circuit evaluation).
Your input is a list of lists, so you should test first if the current element is an actual list - otherwise you'll attempt to take the length of an object which isn't a list (the number 3 in your example), which is an error.
By the way: it's possible to simplify the code, you don't actually need to use an if, just return the value of the condition:
(define is1?
(lambda (tuple)
(and (list? tuple) ; you must ask this first!
(= 2 (length tuple))
(= 1 (- (cadr tuple) (car tuple))))))
I have written a function called my_rotate that takes a number from a user and creates a list up to five numbers. my_rotate then, pops off the first element of the list and adds it to the end of the list. Any advice on how I could write my_rotate to take in another number n and rotate the list based on the number n, in which the user entered.
Example:
> (my_rotate 1 2)
Outputs:
(3 4 5 1 2)
This is what I have so far:
(defun my_rotate (y)
(append (loop for i from (+ 1 y) to (+ 4 y) collect i)
(list y)))
Here the function.
I create two lists and then concatenate them.
(defun my-rotate (length shift)
"Return a list of given LENGTH, rotated by SHIFT."
(nconc
(loop for i from (1+ shift) to (- length shift -2) collect i)
(loop for i from 1 to shift collect i)))
(my-rotate 7 2)
==> (3 4 5 6 7 1 2)
Note that since both loops produce fresh lists, I use nconc instead of append.
If, however, you want to rotate an existing list, you will need to do something else:
(defun rotate-list (list shift)
"Rotate the given LIST by the specified SHIFT."
(let ((len (length list)))
(setq shift (mod shift len)) ; handle circular shifts
(append (nthcdr (- len shift) list)
(butlast list shift))))
(rotate-list '(1 2 3 4 5 6) 2)
==> (5 6 1 2 3 4)
(rotate-list '(1 2 3 4 5 6) 20)
==> (5 6 1 2 3 4) ; same because 20 = 2 mod 6
(rotate-list '(1 2 3 4 5 6) 0)
==> (1 2 3 4 5 6) ; unchanged
Note that nthcdr points inside the original list, so we have to use append to avoid modifying the argument.
Note also that we scan the list argument twice (once in nthcdr and once in butlast).
If your lists are huge, and profiling shows that this function is the bottleneck, you might want to re-write this using a loop (this is scenario is so unlikely, that I already regret having wasted my time writing this note).
I've been getting a strange behavior when invoking a destructive definition receiving as argument a local variable whose type is a list created with a quote.
Destructive function:
(defun insert-at-pos (pos list elem)
(if (= pos 0)
(cons elem list)
(let ((aux-list (nthcdr (1- pos) list)))
(setf (rest aux-list) (cons elem (rest aux-list)))
list)))
WRONG: Local variable is a list created with the special operator quote.
(defun test ()
(let ((l '(1 2 3)))
(print l)
(insert-at-pos 2 l 4)
(print l)))
> (test)
(1 2 3)
(1 2 4 3)
(1 2 4 3)
> (test)
(1 2 4 3)
(1 2 4 4 3)
(1 2 4 4 3)
> (test)
(1 2 4 4 3)
(1 2 4 4 4 3)
(1 2 4 4 4 3)
CORRECT: Local variable is a list created with function list.
(defun test2 ()
(let ((l (list 1 2 3)))
(print l)
(insert-at-pos 2 l 4)
(print l)))
or
(defun test2 ()
(let ((l '(1 2 3)))
(print l)
(setf l (cons (first l) (cons (second l) (cons 4 (nthcdr 2 l)))))
(print l)))
> (test2)
(1 2 3)
(1 2 4 3)
(1 2 4 3)
> (test2)
(1 2 3)
(1 2 4 3)
(1 2 4 3)
> (test2)
(1 2 3)
(1 2 4 3)
(1 2 4 3)
Does someone know the reason of this strange behaviour?
If you quote data in a function, then it is literal data. The effects of destructively modifying such literal data are undefined in the Common Lisp standard. In your example all function invocations share the same literal data and the implementation does not warn you that you are changing it. That's what most implementations do. But it would also possible to imagine an implementation which puts all code (and its literal data) into a read-only part of the memory.
You can get funky effects with this.
If you want to destructively modify a list without running into potential problems, then you need to create a fresh copy at runtime. For example by calling LIST or COPY-LIST. LIST will return a fresh consed list.
There are similar pitfalls. For example imagine a file with these definitions:
(defvar *foo* '(1 2 3 4 5 6 ... 10000))
(defvar *foo* '(0 1 2 3 4 5 6 ... 10000))
If you compile such a file with the file compiler, the compiler is allowed to create a compiled file, where the two variables share literal data - saving space. If you would change an element in either list, both might be changed.
I'm trying to write a function that works like remove-duplicates, but it instead takes two lists as input, the first specifying characters for which duplication is not allowed, and the second being a list of various atoms which is to be pruned.
Currently I have this:
(defun like-remove-duplicates (lst1 lst2)
(if(member (first lst1) lst2)
(remove-if #'(lambda (a b)
(equals a b))lst1 lst2)))
I know it's not anywhere near right, but I can't figure out what I need to do to perform this function. I know I essentially need to check if the first item in list1 is in list2, and if so, remove its duplicates (but leave one) and then move onto the next item in the first list. I envisioned recursion, but it didn't turn out well. I've tried researching, but to no avail.
Any help?
CL-USER> (defun remove-duplicates-from-list (forbidden-list list)
(reduce (lambda (x y)
(let ((start (position y x)))
(if start
(remove y x :start (1+ start))
x)))
forbidden-list
:initial-value list))
REMOVE-DUPLICATES-FROM-LIST
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2))
(1 2 3)
CL-USER> (remove-duplicates-from-list '(1 2) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(1 2 1 3 2 4))
(1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 1 2 1 3 2 4))
(0 1 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 3 2 4))
(0 2 3 4)
CL-USER> (remove-duplicates-from-list '(2 1) '(0 2 2 3 4))
(0 2 3 4)
Recursion is performed by reduce (because here we have the most common recursion pattern: feed the result of previous iteration to the next) and removeing is done with the help of :start parameter, that is the offset after the first encounter (found by position) of the value being removed currently.
It's also important to account the case, when the value isn't found and position returns nil.
Something like this should work and have acceptable time-complexity (at the cost of soem space-complexity).
(defun like-remove-duplicates (only-once list)
"Remove all bar the first occurence of the elements in only-once from list."
(let ((only-once-table (make-hash-table))
(seen (make-hash-table)))
(loop for element in only-once
do (setf (gethash element only-once-table) t))
(loop for element in list
append (if (gethash element only-once-table)
(unless (gethash element seen)
(setf (gethash element seen) t)
(list element))
(list element)))))
This uses two state tables, both bounded by the size of the list of elements to include only once and should be roughly linear in the sum of the length of the two lists.
(defun remove-listed-dups (a b)
(reduce (lambda (x y) (if (and (find y a) (find y x)) x (cons y x)))
b :initial-value ()))