I am using this to find list duplicates:
(defun have-dups (x)
(let ((dups (copy-tree x)))
(if (eq (length (delete-dups dups)) (length x))
nil
t)))
(have-dups (list 1 2 3 3)) ;=> t
(have-dups (list 1 2 3)) ;=> nil
Considering the overhead of copy-tree and delete-dups, probably there is a better way.
Use a hash table, as soon as you find an element which already exists in the hash table, you know you have duplicates:
(defun has-dup (list)
(block nil
(let ((hash (make-hash-table :test 'eql)))
(map ()
(lambda (item)
(if (gethash item hash)
(return t)
(setf (gethash item hash) t)))
list))))
Here is a shorter version of your answer, which uses remove-duplicates instead of delete-dups, to avoid the destructive properties of the latter:
(defun has-dups-p (LIST) ""
(let ((unique1 (remove-duplicates LIST :test #'equal)))
(if (eq LIST unique1)
nil
t)))
(has-dups '(1 2 3 2 1)) ; t
(has-dups '("a" "b" "c")) ; nil
I find this reasonably easy to read and eq should be reasonably efficient as it goes straight to C, particularly where a duplicate occurs early in the list. Both remove-duplicates and delete-dups are passed to cl--delete-duplicates which is rather involved...
A longer solution follows, which returns the elements of LIST which have duplicates and the position of each duplicated element in LIST (remembering that seqs are zero-indexed in elisp). Note that this currently only applies where the elements of LIST are strings, although I'm sure it could be extended further to more general cases:
(defun list-duplicates (LIST) "
Returns `nil' when LIST has no duplicates.
Otherise, returns a `list' of `cons's.
In each list element:
- the `car' is the element of LIST which has duplicates.
- the `cdr' is a list of the positions where the duplicates are found."
(interactive)
;; res1 = result
;; unique1 = LIST with duplicates removed
(let ((unique1 (remove-duplicates LIST :test #'string-equal))
(res1 '()))
(if (eq LIST unique1)
nil
(progn
(dolist (x unique1)
;; i = incrementor
;; pos1 = list of postions of duplicates
(let (y (i 0) (pos1 '()))
(while (member x LIST)
(set 'y (seq-position LIST x))
(when (> i 0)
(push y pos1))
(set 'i (+ 1 i))
(set 'LIST
(substitute (concat x "1") x LIST :test #'string-equal :count 1)))
(push (cons x (nreverse pos1)) res1)))
(nreverse res1)))))
e.g.
(list-duplicates '("a" "b" "c")) ; nil
(list-duplicates '("a" "b" "b" "a" "b" "c" "c")) ; (("a" 3) ("b" 2 4) ("c" 6))
Related
I am trying to write a function that take a list and iterates over each element in the list if the number is even I want that number to be added to the previous number in the list.
I was thinking an accumulator will count up from 0 with each iteration giving a position for each element in the list.
If the number in the list is even I want to add that number to the previous number in the list.
Hence why I am trying to use the accumulator as an index for list-ref. I don't know how to write it to get the accumulator value for the previous iteration (+ i (list-ref a-list(- acc 1)))?
(define loopl (lambda (l)
(for/fold
([acc 0])([i l])
(cond
[(even? i)(+ i (list-ref (- acc 1) l))]
enter image description here
The question is not quite clear about the value to be returned by this function:
this answer assumes that it is a total of even elements together with their previous elements.
The function is developed using the
HtDF (How to Design Functions)
design method with a BSL (Beginning Student language) in DrRacket.
Start with a stub, incorporating signature and purpose, and a minimal "check-expect" example:
(Note: layout differs slightly from HtDF conventions)
(define (sum-evens-with-prev xs) ;; (Listof Integer) -> Integer ; *stub define* ;; *signature*
;; produce total of each even x with its previous element ; *purpose statement*
0) ; *stub body* (a valid result)
(check-expect (sum-evens-with-prev '()) 0) ; *minimal example*
This can be run in DrRacket:
Welcome to DrRacket, version 8.4 [cs].
Language: Beginning Student with List Abbreviations
The test passed!
>
The next steps in HtDF are template and inventory. For a function with one list
argument the "natural recursion" list template is likely to be appropriate;
(define (fn xs) ;; (Listof X) -> Y ; *template*
(cond ;
[(empty? xs) ... ] #|base case|# ;; Y ;
[else (... #|something|# ;; X Y -> Y ;
(first xs) (fn (rest xs))) ])) ;
With this template the function and the next tests become:
(define (sum-evens-with-prev xs) ;; (Listof Number) -> Number
;; produce total of each even x with its previous element (prev of first is 0)
(cond
[(empty? xs) 0 ] #|base case: from minimal example|#
[else (error "with arguments: " #|something: ?|#
(first xs) (sum-evens-with-prev (rest xs))) ]))
(check-expect (sum-evens-with-prev '(1)) 0)
(check-expect (sum-evens-with-prev '(2)) 2)
These tests fail, but the error messages and purpose statement suggest what is required:
the (... #|something|# from the template has to choose whether to add (first xs):
(define (sum-evens-with-prev xs) ;; (Listof Integer) -> Integer
;; produce total of each even x with its previous element (prev of first is 0)
(cond
[(empty? xs) 0 ]
[else
(if (even? (first xs))
(+ (first xs) (sum-evens-with-prev (rest xs)))
(sum-evens-with-prev (rest xs))) ]))
Now all 3 tests pass! Time for more check-expects (note: careful introduction of
check-expects is a way of clarifying ones understanding of the requirements, and
points one to the code to be added):
(check-expect (sum-evens-with-prev '(1 1)) 0)
(check-expect (sum-evens-with-prev '(1 2)) 3)
Ran 5 tests.
1 of the 5 tests failed.
Check failures:
Actual value 2 differs from 3, the expected value.
sum-evens-with-prev needs the prev value to include in the even? case:
make it available by introducing it as an argument (renaming the function), add
the appropriate arguments to the recursive calls, the function now just calls
sum-evens-and-prev:
(define (sum-evens-and-prev xs prev) ;; (Listof Integer) Integer -> Integer
;; produce total of each even x and prev
(cond
[(empty? xs) 0 ]
[else
(if (even? (first xs))
(+ prev (first xs) (sum-evens-and-prev (rest xs) (first xs)))
(sum-evens-and-prev (rest xs) (first xs))) ]))
(define (sum-evens-with-prev xs) ;; (Listof Integer) -> Integer
;; produce total of each even x with its previous element (prev of first is 0)
(sum-evens-and-prev xs 0))
(just add some more tests, and all is well :)
(check-expect (sum-evens-with-prev '(0 2)) 2)
(check-expect (sum-evens-with-prev '(2 1)) 2)
(check-expect (sum-evens-with-prev '(1 3)) 0)
(check-expect (sum-evens-with-prev '(2 2)) 6)
(check-expect (sum-evens-with-prev '(1 2 3 4)) 10)
(check-expect (sum-evens-with-prev '(1 2 3 3 5 6 6)) 26)
Welcome to DrRacket, version 8.4 [cs].
Language: Beginning Student with List Abbreviations.
All 11 tests passed!
>
The (for/fold) form requires a (values) clause, and it is in that which you would put the conditional form.
Assuming you want only the new list as the return value, you would also want a #:result clause following the iteration variables.
(define loopl
(lambda (l)
(for/fold
([index 0]
[acc '()]
#:result acc)
([i l])
(values [+ index 1]
[append acc
(if (and (> index 0)
(even? i))
(list (+ i (list-ref l (- index 1))))
(list i))]))))
This should give the correct answer.
You almost never want to repeatedly call list-ref in a loop: that makes for horrible performance. Remember that (list-ref l i) takes time proportional to i: in your case you're going to be calling list-ref with the index being, potentially 0, 1, ..., and that going to result in quadratic performance, which is bad.
Instead there's a neat trick if you want to iterate over elements of a list offset by a fixed amount (here 1): iterate over two lists: the list itself and its tail.
In addition you need to check that the first element of the list is not even (because there is no previous element in that case, so this is an error).
Finally I'm not entirely sure what you wanted to return from the function: I'm assuming it's the sum.
(define (accum-even-previouses l)
(unless (not (even? (first l)))
;; if the first elt is even this is an error
(error 'accum-even-previouses "even first elt"))
(for/fold ([accum 0])
([this (in-list (rest l))]
[previous (in-list l)])
(+ accum (if (even? this)
(+ this previous)
0))))
this is my first question here! :)
I need a function that checks if there is a list inside a list. It should give false when there is a list inside a list. I tried simple things like:
(define (list-inside-list? ls)
(if (or (list? (first ls)) (list? (rest ls))) false true))
I probably need lambda but I just don't know how?
Would appreciate a lot for help!
There is no list inside the empty list.
Otherwise, there is a list inside a list if
its first element is a list,
or if there is a list inside the rest of the list.
The trick is then to turn this into code, thinking particularly hard about how to express the last case: to do it you might want to write a function which determines if there is a list inside a list ... well, what's the function you're writing do?
a warm welcome to StackOverflow.
I haven't heavily tested, but maybe this approache helps you:
(check-expect (contains-no-sublist? (list )) #true)
(check-expect (contains-no-sublist? (list "red" "green" "blue")) #true)
(check-expect (contains-no-sublist? (list (list "light red" "dark red") "green" "blue")) #false)
;; contains-no-sublist? checks if any element in the list is a list itself and returns #false, if it finds a list in the list (nested list).
(define contains-no-sublist? ;; define a function with the name "contains-no-sublist?"
(lambda [L] ;; define the function as a lambda expression over a given input list L
(cond ;; the function returns either #t or #f
[(empty? L) #true] ;; an empty list doesn't contain a sublist, so #t = #true can be returned
[(cons? L) ;; else still a list is given
(cond
[(list? (first L)) #false] ;; either the first element of the list is a list itself, then return false.
[else (contains-no-sublist? (rest L))] ;; or the first element is not a list itself, then check for the rest of the list if it contains any sublist
)
]
)
)
)
use cond
#lang racket
(define (no-list-inside?-by-cond ls)
(cond
[(empty? ls) #t]
[(list? (first ls))
#f]
[else
(no-list-inside?-by-cond (rest ls))]))
;;; TEST
(no-list-inside?-by-cond '(1 2 3)) ; should be #t
(no-list-inside?-by-cond '(1 2 3 '(3) 4)) ; should be #f
(no-list-inside?-by-cond '(1 2 3 '() 5)) ; should be #f
use andmap
#lang racket
(define (no-list-inside?-by-andmap ls)
(andmap (lambda (x) (not (list? x))) ls))
;;; TEST
(no-list-inside?-by-andmap '(1 2 3 2)) ; should be #t
(no-list-inside?-by-andmap '(1 2 3 '(3) 4)) ; should be #f
(no-list-inside?-by-andmap '(1 2 3 '() 5)) ; should be #f
use filter
#lang racket
(define (no-list-inside?-by-filter lst)
(empty? (filter list? lst)))
;;; TEST
(no-list-inside?-by-filter '(1 2 3)) ; should be #t
(no-list-inside?-by-filter '(1 2 3 '(3) 4)) ; should be #f
(no-list-inside?-by-filter '(1 2 3 '() 5)) ; should be #f
I want to calculate the maximum of every sublist/level/superficial level from a list of number
Ex: (1 2 5 (4 2 7 (4 6) 9) 7 8) => (8 9 6)
What I have now is:
maximum (l) ;;function to compute the maximum number for a simple list, it works
(defun max-superficial (lista acc acc2) ;;main function: lista - my list, acc - my final list
;;of results, acc2 - accumulation list for a sublist
(typecase lista
(null
(typecase acc2
;; if my list is empty and I have nothing accumulated, just return the final list
(null acc)
;;if my list is empty but I have something in my accumulation list, just add the maximum
;;of acc2 to my final list
(t (nconc acc (list (maximum acc2))))))
(cons (destructuring-bind (head . tail) lista
(typecase head
(list
;;if my list isn't empty and the head of the list is a list itself, call
;;the function again for the head with an empty accumulation list and then call it again
;;for the tail
(nconc acc
(list (max-superficial head acc nil))
(max-superficial tail acc acc2)))
;; otherwise just accumulate the head and call the function for the tail
---problem here (t (nconc acc2 (list head))
(print '(wtf))
(print acc)
(print acc2)
(print head)
(max-superficial tail acc acc2)))))))
The problem is that I only wrote this program and I want to test it and on the list "---problem here" it won't add my head to the accumulation list.
For: (max-superficial '(1 2) nil nil) --result should be ==> wtf nil (1) 1 wtf nil (1 2) 2 2
My result: wtf nil nil 1 wtf nil nil 2 nil
I checked separately and (nconc some-list (list 3)) does exactly what it's supposed to... adds the number 3 to the back of the some-list. I don't know why nconc acc2 (list head) doesn't work
Tried replacing nconc with append and it's not working either. Apparently, you can't add an element to an empty list using append/nconc. Then how?
A simpler implementation:
(defun max-superficial/sublists (list)
(loop for num in list
if (listp num) append (max-superficial/sublists num) into sublists
else if (numberp num) maximize num into max
else do (error "Not a number or list: ~a" num)
finally (return (cons max sublists))))
;; If you want the max of each "level" or depth in a tree,
;; then you need to be able to operate on levels. Here are some
;; functions that are analogous to FIRST, REST, and POP:
(defun top-level (tree)
(remove-if-not #'numberp tree))
(defun rest-levels (tree)
(apply #'append (remove-if-not #'listp tree)))
(defmacro pop-level (tree)
`(let ((top (top-level ,tree)))
(setf ,tree (rest-levels ,tree))
top))
(defun max-superficial (tree &key use-sublists)
"It wasn't clear if you wanted the max in each sublist or the max
at each depth, so both are implemented. Use the :use-sublists key
to get the max in each sublist, otherwise the max at each depth
will be computed."
(if use-sublists
(max-superficial/sublists tree)
(loop for top-level = (pop-level tree)
collect (if top-level (reduce #'max top-level)) into result
unless tree do (return result))))
Here's a (not particularly efficient) solution:
(defun max-avoiding-nil (a b)
(cond ((null a) b)
((null b) a)
(t (max a b))))
(defun depth-maximum (a b)
(cond ((null a) b)
((null b) a)
(t
(cons (max-avoiding-nil (car a) (car b))
(depth-maximum (cdr a) (cdr b))))))
(defun tree-max-list (list depth)
(reduce #'depth-maximum tree
:key (lambda (elt) (tree-max elt depth))
:initial-value '()))
(defun tree-max (tree depth)
(if (listp tree)
(tree-max-list tree (1+ depth))
(append (make-list depth 'nil) (list tree))))
(defun tree-maximums (tree)
(tree-max-list tree 0))
(tree-maximums '(1 2 5 (4 2 7 (4 6) 9) 7 8)) => (8 9 6)
(tree-maximums '()) => nil
(tree-maximums '(1)) => (1)
(tree-maximums '((2))) => (nil 2)
(tree-maximums '((2) (3))) => (nil 3)
I want to write a recursive function that checks the list and either returns true if the list is in ascending order or NIL otherwise. If the list is empty it is still true. I am completely new to Lisp, so its still very confusing.
(defun sorted (x)
(if (null x)
T
(if (<= car x (car (cdr x)))
(sorted (cdr x))
nil)))
The recursive version:
(defun sorted (list)
(or (endp list)
(endp (cdr list))
(and (<= (first list) (second list))
(sorted (cdr list)))))
The more idiomatic loop-based predicate accepting a :test argument:
(defun sortedp (list &key (test #'<=))
(loop for (a b) on list
while b
always (funcall test a b)))
The version accepting a :key; we only call the key function once per visited element:
(defun sortedp (list &key (test #'<=) (key #'identity))
(loop for x in list
for old = nil then new
for new = (funcall key x)
for holdp = T then (funcall test old new)
always holdp))
Some tests:
(loop for k in '(()
((1))
((1) (2))
((2) (1))
((1) (2) (3))
((3) (2) (1)))
collect (sortedp k :test #'> :key #'car))
=> (T T NIL T NIL T)
This one also works with other kinds of sequences:
(defun sortedp (sequence &key (test #'<=) (key #'identity))
(reduce (lambda (old x &aux (new (funcall key x)))
(if (or (eq old t)
(funcall test old new))
new
(return-from sortedp nil)))
sequence
:initial-value t))
The above test gives:
(T 1 NIL 1 NIL 1)
... which is a correct result thanks to generalized booleans.
If you are doing your homework (seems so), then the above answers are fine. If you are just learning Lisp, and don't have constraints about recursivity, then the following might give you a glimpse about the power of Lisp:
(defun sorted (l)
(or (null l) (apply #'< l)))
The first problem with your solution is the base case You need to stop not at the end of the list, but when looking at the last to elements, as you need to elements to do the comparison. Also the parens are missing in the call to (car x)
(defun sorted (list)
(if (endp (cddr list))
(<= (car list) (cadr list))
(and (<= (car list) (cadr list))
(sorted (cdr list)))))
Bare in mind that recursive solutions are discouraged in CL
I'm trying to figure out how to obtain the last (non-empty) list from within another list, or return nil if there is no such list (recursively). This is an homework assignment, and as such I am looking for help on the method, not necessarily the code for it. Example:
(lastele '(1 (2 3) 4 5)) ;=> (2 3)
(lastele '(1 (2 3) (4 5)) ;=> (4 5)
(lastele '(1 2 3 4 5)) ;=> NIL
I was trying to run through the list, and if I encountered a sublist, I would check to see if the rest of the list contained any more non-empty sublists, if it did, continue with setting the list to that, and repeating until we had a null list.
(defun lastele2 (L)
(if (null L)
'()
(if (hasMoreLists (rest L))
(lastele2 (rest L))
(first L))))
It seems as if I can't get hasMoreLists to work, though. Returning t or f within is just erroring. Is this the best way to go about this?
First of all, note that you're implicitly assuming that none of the sublists are the empty list; if they could be the empty list, then nil is an ambiguous result, because you can't tell whether your function returned nil because there were no sublists, or because there were, and the last one was empty. E.g.,
(fn '(1 2 3 4 5)) ;=> nil because there are no sublists
(fn '(1 2 3 () 5)) ;=> nil because there are sublists, and the last one is nil
So, under the assumption that there are no non-null sublists in the toplevel list, we can continue.
A non-homework solution using standard functions
You don't need to write this. You can just use find-if with the predicate listp and specify that you want to search from the end by using the keyword argument :from-end t:
CL-USER> (find-if 'listp '(1 (2 3) 4 5) :from-end t)
(2 3)
CL-USER> (find-if 'listp '(1 (2 3) (4 5)) :from-end t)
(4 5)
CL-USER> (find-if 'listp '(1 2 3 4 5) :from-end t)
NIL
Writing your own
If you need to write something like this, your best bet is to use a recursive function that searches a list and keeps track of the most recent list element that you've seen as the result (the starting value would be nil) and when you finally reach the end of the list, you'd return that result. E.g.,
(defun last-list (list)
(labels ((ll (list result) ; ll takes a list and a "current result"
(if (endp list) ; if list is empty
result ; then return the result
(ll (cdr list) ; else continue on the rest of list
(if (listp (car list)) ; but with a "current result" that is
(car list) ; (car list) [if it's a list]
result))))) ; and the same result if it's not
(ll list nil))) ; start with list and nil
The local function ll here is tail recursive, and some implementations will optimize it into a loop, but would be more idiomatic to use a genuine looping construct. E.g., with do, you'd write:
(defun last-list (list)
(do ((result nil (if (listp (car list)) (car list) result))
(list list (cdr list)))
((endp list) result)))
If you don't want to use labels, you can define this as two functions:
(defun ll (list result)
(if (endp list)
result
(ll (cdr list)
(if (listp (car list))
(car list)
result))))
(defun last-list (list)
(ll list nil))
Alternatively, you could make last-list and ll be the same functions by having last-list take the result as an optional parameter:
(defun last-list (list &optional result)
(if (endp list)
result
(last-list (cdr list)
(if (listp (car list))
(car list)
result))))
In all of these cases, the algorithm that you're implementing is essentially iterative. It's
Input: list
result ← nil
while ( list is not empty )
if ( first element of list is a list )
result ← first element of list
end if
list ← rest of list
end while
return result
Something based on the code in the question
We can still find something that's a bit closer to your original approach (which will use more stack space), though. First, your original code with proper indentation (and some newlines, but there's more flexible in coding styles there):
(defun lastele2 (L)
(if (null L)
'()
(if (hasMoreLists (rest L))
(lastele2 (rest L))
(first L))))
The approach it looks like you're trying to use is to define the last sublist of a list L as:
nil, if L is empty;
if (rest L) has some sublists, whatever the last sublist of (rest L) is; and
if (rest L) doesn't have some sublists, then (first L).
That last line isn't quite right, though. It needs to be
if (rest L) doesn't have some sublists, then (first L) if (first L) is a list, and nil otherwise.
Now, you've already got a way to check whether (rest L) has any (non-null) sublists; you just check whether (lastele2 (rest L)) returns you nil or not. If it returns nil, then it didn't contain any (non-null) sublists. Otherwise it returned one of the lists. This means that you can write:
(defun last-list (list)
(if (endp list) ; if list is empty
nil ; then return nil
(let ((result (last-list (rest list)))) ; otherwise, see what (last-list (rest list)) returns
(if (not (null result)) ; if it's not null, then there were more sublists, and
result ; last-list returned the result that you wantso return it
(if (listp (first list)) ; otherwise, if (first list) is a list
(first list) ; return it
nil))))) ; otherwise return nil
This is implementing the an essentially recursive algorithm; the value of the subproblem is returned, and then lastList returns a value after examining it that result:
Function: lastList(list)
if ( list is empty )
return nil
else
result ← lastList(list)
if ( result is not nil )
return result
else if ( first element of list is a list )
return first element of list
else
return nil
end if
end if
No, it's not the best way to go about this. To find whether the rest of list has more lists, you need to search it - and if it has, you restart scanning over the rest of your list.
I.e. you do a lot of back and forth.
Instead, just search along, and update a side variable to point to any list you find along the way.
(defun lastele (lst &aux a) ; a is NIL initially
(dolist (e lst a) ; return a in the end
(if (consp e) (setq a e))))