I've been looking for an efficient way of removing consecutive duplicates in a list of points.
My original thinking was to loop through the elements of the list making a comparison with the (n-1)th element and removing it if its equal. But then it is not trivial to remove an element in a list and using another function would make it inefficient.
I am aware of Lee Mac's RemoveOnce function but I don't know how to modify it to make a comparison between consecutive elements of a list.
The goal as an example would be the following:
List = (p1 p2 p3 p3 p3 p2 p2 p4)
List_without_consecutive_duplicates = (p1 p2 p3 p2 p4)
Thanks!
Here's an iterative method:
(defun remcondupes ( l / r )
(while l
(if (not (equal (car l) (cadr l) 1e-8))
(setq r (cons (car l) r))
)
(setq l (cdr l))
)
(reverse r)
)
And here's a recursive method:
(defun remcondupes ( l )
(if l
(if (equal (car l) (cadr l) 1e-8)
(remcondupes (cdr l))
(cons (car l) (remcondupes (cdr l)))
)
)
)
In both of the above, the first element in the list is compared to the second using the equal function with a tolerance of 1e-8 (since we're comparing points), with the first element discarded if this test is validated.
Testing:
_$ (setq p1 '(1.2 2.3) p2 '(3.4 4.5) p3 '(5.6 6.7) p4 '(7.8 8.9))
(7.8 8.9)
_$ (setq lst (list p1 p2 p3 p3 p3 p2 p2 p4))
((1.2 2.3) (3.4 4.5) (5.6 6.7) (5.6 6.7) (5.6 6.7) (3.4 4.5) (3.4 4.5) (7.8 8.9))
_$ (remcondupes lst)
((1.2 2.3) (3.4 4.5) (5.6 6.7) (3.4 4.5) (7.8 8.9))
EDIT:
Alternatively, to account for consecutive points each successively within the comparison tolerance (per Will's comments below), you might consider the following variations:
(defun remcondupes ( l / r )
(while l
(if (equal (car l) (cadr l) 1e-8)
(setq l (cons (car l) (cddr l)))
(setq r (cons (car l) r)
l (cdr l)
)
)
)
(reverse r)
)
(defun remcondupes ( l )
(if l
(if (equal (car l) (cadr l) 1e-8)
(remcondupes (cons (car l) (cddr l)))
(cons (car l) (remcondupes (cdr l)))
)
)
)
Here is one way which I think is legal AutoLISP:
(defun remove-successive-duplicates (l / results current)
(cond
((null l)
l)
(t
(setq current (car l)
results (list current))
(foreach e (cdr l)
(cond
((not (eq e current))
(setq current e
results (cons e results)))))
(reverse results))))
You can do better than this if there are destructive functions on lists which it looks like there are not, or if there are list filtering functions which it also looks like there are not.
Here is another way which is much prettier but will cause stack overflows with long lists:
(defun remove-successive-duplicates (l)
(cond
((or (null l) (null (cdr l)))
l)
(t
(cons (car l) (remove-current-duplicates-loop (cdr l) (car l))))))
(defun remove-successive-duplicates-loop (l current)
(cond
((null (cdr l))
(cond
((eq (car l) current)
'())
(t
l)))
((eq (car l) current)
(remove-successive-duplicates-loop (cdr l) current))
(t
(cons (car l) (remove-successive-duplicates-loop (cdr l) (car l))))))
Related
Hi so I have question that I am having some difficulty solving see below
Use the function SPLIT-LIST and MERGE-LISTS to define a recursive
Lisp function MSORT such that if L is a list of real numbers then (MSORT L) is a list consisting of the elements of L in ascending order. In the definition of MSORT you may call SPLIT-LIST,
MSORT itself, MERGE-LISTS, CAR, CDR, CADR and ENDP, but you should not call any
other function. Be sure to use LET or LET*, so that MSORT only calls SPLIT-LIST once.
So far I was able to write the SPLIT-LIST and MERGE-LISTS functions correctly but for M-SORT I am having difficulty writing the function. See below all three definitions so far. Any help on how to write the MSORT function correctly by following the guidelines in the question would be appreciated.
(defun SPLIT-LIST (L)
(if (endp L)
'(nil nil)
(let ((X (split-list (cdr L))))
(list (cons (car L)(cadr X)) (car X) ))))
(defun MERGE-LISTS (L1 L2)
(cond
((and(endp L1 )(endp L2)) nil )
((endp L1) (cons (CAR L2) (MERGE-LISTS nil (CDR L2))))
((endp L2) (cons (CAR L1) (MERGE-LISTS (CDR L1) NIL)))
((< (CAR L1) (CAR L2)) (cons (CAR L1) (MERGE-LISTS (CDR L1) L2 )))
((>= (CAR L1) (CAR L2)) (cons (CAR L2) (MERGE-LISTS L1 (CDR L2)) ))))
(defun MSORT (L)
(cond ((endp L ) nil)
( (equal (Length L) 1) L)
(T
(let* (
(S (SPLIT-LIST L ))
(L1 (CAR S))
(L2 (CADR S))
(X (MSORT (cdr L1)))
(Y (MSORT (cdr L2)))
)
(MERGE-LISTS
(if (and (numberp (car L1)) (numberp (car X))(<= (car L1 ) (car X)))
(list (car L1) (car X))
(list (car X) (car L1) )
)
(Cons (car L2) Y))
)))
)
You're overcomplicating it. You don't need to sort the CDRs of the sub-lists returned by SPLIT-LIST, just sort the whole lists, and merge them.
(defun MSORT (L)
(cond ((endp L) nil)
((endp (cdr L)) L)
(t
(let* ((S (SPLIT-LIST L ))
(L1 (car S))
(L2 (cadr S))
(X (MSORT L1))
(Y (MSORT L2)))
(MERGE-LISTS X Y)))))
I am trying to check if a list has a mountain aspect or not in lisp.
e.g:1,5,9,6,4,3
l is my list and aux is 0-the ascending part of l or 1-the descending part of the list.
muntemain just call munte starting with aux=0,the ascending part
my error is :
Badly formed lambda: (AND (< (CAR L) (CAR (CDR L))) (EQ AUX 0))
and I can't see the problem.Can someone help please?
(defun munte (l aux)
(cond
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
((and (< (car l) (car(cdr l))) (eq aux 0)) (munte(cdr l) 0))
((and (or (> (car l) (cadr l)) (= (car l) (cadr l))) (eq aux 0))(munte(cdr l) 1))
( and (> (car l) (cadr l)) (eq aux 1)) (munte(cdr l) 1))
(T NIL)
)
)
(defun muntemain (l)
(cond
((> (car l) (cadr l)) NIL)
((< (length l) 2) NIL)
(T (munte l 0))
)
)
Formatting
As noted by Barmar, you really need to use an editor to help you with the parenthesis. There are many tutorials for installing Emacs+Slime. Take some time to install proper tools.
Don't use EQ for numbers and characters
An implementation is permitted to make "copies" of characters and
numbers at any time. The effect is that Common Lisp makes no guarantee
that eq is true even when both its arguments are "the same thing" if
that thing is a character or number.
Factorize tests
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
From the definition of atom, NIL is an atom, so you don't need (null L). The different cases for aux can be grouped too. The clause below is sufficient to account for all the above ones:
((atom L) (eql aux 1))
But I don't understand why aux is not a boolean in the first place if you always bind it to 0 or 1. Just use t and nil and return aux in the above clause.
Use meaningful functions
(< (car l) (car(cdr l)))
Of course, (car(cdr ..)) is known as (cadr ..), but also as second. The above test is equivalent to:
(< (first L) (second L))
And what if your list has no second element? You will compare a number against nil and signal an error (not what you want). You need more tests. In muntemain, you seem to have a special case for when length is below 2, but the test is done only if the previous returns nil, which won't happen if an error is signaled.
An iterative alternative
Here is a completely different way to attack the problem, just to give you ideas.
(lambda (list)
(loop
;; memories
for px = nil then x
for pdx = nil then dx
;; current element
for x in list
;; first and second "derivatives" (signs only)
for dx = 1 then (signum (- x px))
for ddx = 0 then (signum (- dx pdx))
;; checks
sum ddx into total
always (and (<= dx 0) (<= -1 total 0))
finally (return (= total -1))))
Hello why do i get *** - EVAL/APPLY: too many arguments given to F on function call with nested lists parameter. I cannot figure it out, since I passed a simple nested list.
(defun f (L)
(cond
((NULL l) nil)
((listp (car L))
(append (F(car L))) (F(cdr L) (car (F (car L)))))
(T (list(car L)))
)
)
(setq A '((1) 2 3))
(f A)
This better formatting should make it easy to spot the error:
(defun f (l)
(cond ((null l) nil)
((listp (car l))
(append (f (car l)))
(f (cdr l)
(car (f (car l)))))
(t (list (car l)))))
If that does not help, use SBCL to compile the function. It will give you a very clear error message.
(defun rep(list)
(format t"~a~%" list)
(cond
((null list) nil)
((atom (car list)) (cons (car list) (rep (cdr list))))
((listp (car list)) (cons (car (reverse (car list))) (cdr list)))
(t (rep list))
)
)
Write a function to replace each sublist of a list with its last element.
A sublist is an element from the first level, which is a list.
Example:
(a (b c) (d (e (f)))) ==> (a c (e (f))) ==> (a c (f)) ==> (a c f)
(a (b c) (d ((e) f))) ==> (a c ((e) f)) ==> (a c f)
I have the above problem to solve. Got it till one point but I'm stuck.
Apparently it doesn't go to the next elements in the list and I don't know why. Any ideas?
I would break it down like this:
(defun last-element (lst)
(if (listp lst)
(last-element (car (last lst)))
lst))
(defun rep (lst)
(when lst
(cons (last-element (car lst)) (rep (cdr lst)))))
then
(rep '(a (b c) (d (e (f)))))
=> '(A C F)
Did it without using map functions
(defun rep(list)
(cond
((null list) nil)
((listp (car list)) (rep (cons (car (reverse (car list))) (rep (cdr list)))))
(t (cons (car list) (rep (cdr list))))
)
)
I ran over an example of a problem which should determine the list of all non-numeric atoms at any level in a non-linear list.
(Defun Lis(L)
(Cond
((Null L) Nil)
((Not (Numberp (Car L))) (Cons (Car L) (Lis (Cdr L))))
((Atom (Car L)) (Lis (Cdr L)))
(T (Append (Lis (Car L)) (Lis (Cdr L))))
))
I took an example, (Lis '(1 A ((B) 6) (2 (C 3)) D 4)) which should return (A B C D)
Now I don't understand how can the list be created when the 3rd element of the list is evaluated ((B) 6).It will enter on the 2nd branch and do the cons?But that isn't constructing the new list with ((B) 6)?When will it enter on the last branch? I'm a little confused of how this algorithm works,can somebody make it clear for me?
The code works fine if you "invert" the 2 middle tests:
(defun lis(L)
(cond
((null L) nil)
((numberp (car L)) (lis (cdr L)))
((atom (car L)) (cons (car L) (lis (cdr L))))
(t (append (lis (car L)) (lis (cdr L))))))
because (not (numberp (car L))) is also true for lists so in the initial version the code never recurses down into a sublist.
I would write it as:
(defun tree-keep-if (predicate tree)
"Returns the list of all non-numeric atoms at any level in a cons tree."
(mapcan (lambda (item)
(cond ((consp item) (tree-keep-if predicate item))
((funcall predicate item) (list item))
((atom item) nil)))
tree))
Using it:
CL-USER > (tree-keep-if (complement #'numberp) '(1 A ((B) 6) (2 (C 3)) D 4))
(A B C D)
A more sophisticated version might remove the recursion to not be limited by stack size.