I'd like to do this in scheme:
if ((car l) != (car (cdr (order l))) do something
in particular I wrote this:
((eq? (car l) (car (cdr (order l))) )
(cons (count (car (order l)) (order l))
(count_inorder_occurrences (cdr (order l)))))
but it compares (car l) with (car (cdr (order l)) for equality.
I want instead to do something only if eq? is false. How can I do that in my example?
Thanks
You can use not for that.
(cond
((not (eq? (car l) (cadr (order l))))
(cons (count (car (order l)) (order l))
(count-inorder-occurrences (cdr (order l))))
...)
You can use not to negate the value of a predicate.
e.g. in an if statement: (if (not (eq? A B)) <EVAL-IF-NOT-EQ> <EVAL-IF-EQ>)
or in a cond you can do:
(cond ((not (eq? A B))
<EVAL-IF-NOT-EQ>)
.
.
.
(else <DEFAULT-VALUE>))
You don't really need the cond or if if you don't have a list of else cases. when might be what you are looking for. It's basically just the true case of an if.
(when (not (eq? (car l) (cadr (order l))))
(cons
(count (car (order l)) (order l))
(count-inorder-occurrences (cdr (order l)))
)
)
Related
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))))))
I'm trying to teach myself Racket. I'm currently trying to write a function to help understand nested lists. The function takes a nested list and a procedure and applies the procedure to each element to produce a new list. An example:
(map-tree even? '(1 2 3 4)) => '(#f #t #f #t)
Here's what I've got so far:
(define (map-tree proc tree)
(map-tree-aux tree proc '() ))
(define (map-tree-aux tree proc lst)
(if (null? tree)
lst
(if (list? tree)
(if (null? (cdr tree))
(if (number? (car tree))
(map-tree-aux (car tree) proc (append-end (proc (car tree)) lst))
(map-tree-aux (car tree) proc lst))
(if (number? (car tree))
(map-tree-aux (cdr tree) proc (append-end (proc (car tree)) (map-tree-aux (car tree) proc lst)))
(map-tree-aux (cdr tree) proc lst)))
lst)))
(define (append-end elem lst)
(append lst (list elem)))
While this works with the original example I supplied, a more complex example comes out incorrectly:
(map-tree even? '(1 (2 (3 (4))))) should be '(#f (#t (#f (#t)))), but is currently (#f #t #f #t).
I know it's just a matter is "listing" somewhere, but I'm having an issue finding out how to do it.
My first thought was to apply the list procedure to the lst if the tree is null and (car tree) is not a number, but I get the opposite of what I want (the resultant list is nested in the opposite direction). I'd really appreciate your help.
Thanks!
When iterating over list of lists, the general idea for the cases to check is:
if list is empty (null? lst), do something ...
if the first item in list is atomic (not (pair? (car lst))), do something else ...
if the first item in list is a list itself (pair? (car lst)), else ...
Choosing the right construct is also important, ie. instead of nesting if statements, using cond or match etc. is preferred.
Also try and avoid using non-constant time procedures (such as append) in your recursive steps to improve efficiency.
With these in mind, one approach to create the function in question is by simply using cons to build a new list while preserving the structure of the old, as follows:
(define (my-map pred lst)
(cond
((null? lst) '())
((not (pair? (car lst)))
(cons (pred (car lst))
(my-map pred (cdr lst))))
(else
(cons (my-map pred (car lst))
(my-map pred (cdr lst))))))
You can write the same function using match instead of cond:
(define (my-map pred lst)
(match lst
['() '()]
[(cons (? pair?) b)
(cons (my-map pred (car lst))
(my-map pred (cdr lst)))]
[(cons a b)
(cons (pred (car lst))
(my-map pred (cdr lst)))]))
You can also build a tail-recursive function that does this:
(define (my-map pred lst)
(let loop ((lst lst)
(acc '()))
(cond
((null? lst)
(reverse acc))
((not (pair? (car lst)))
(loop (cdr lst) (cons (pred (car lst)) acc)))
(else
(loop (cdr lst) (cons (loop (car lst) '()) acc))))))
Notice that (reverse acc) is returned in the base case because the list being built in the accumulator acc is in reverse order from the original list lst. To avoid this, we can modify this function to accumulate a continuation instead:
(define (my-map pred lst)
(let loop ((lst lst)
(acc identity))
(cond
((null? lst)
(acc '()))
((not (pair? (car lst)))
(loop (cdr lst) (lambda (r)
(acc (cons (pred (car lst)) r)))))
(else
(loop (cdr lst)
(lambda (r)
(acc (cons (loop (car lst) identity) r))))))))
For all cases, you will have:
(my-map even? '(1 2 3 4 5 7))
=> '(#f #t #f #t #f #f)
(my-map even? '(1 (2 (3 (4 (5 (7)))))))
=> '(#f (#t (#f (#t (#f (#f))))))
This is my function that's supposed to implement infix evaluation for * and + operations.
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (cddr l)))
((eql (cadr l) '*) (- (car l) (cddr l)))
)
)
When I run this with the list '(3 + 4) it gives me an error saying "(4) is not a number". Any ideas what the problem might be?
Symbols can be called as functions. Thus your code is just this:
(defun calculate (l)
(funcall (second l) (first l) (third l)))
or
(defun calculate (l)
(destructuring-bind (arg1 op arg2)
l
(funcall op arg1 arg2)))
Example:
CL-USER 77 > (calculate '(20 + 30))
50
The part with (cddr l) should be (caddr l). You have to access the first element of the list, not the list. The code should be then:
(defun calculate(l)
(cond
((eql (cadr l) '+) (+ (car l) (caddr l)))
((eql (cadr l) '*) (- (car l) (caddr l)))
)
)
(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.