I want to write a function in LISP that will completely remove all NILS in a list. The list may be nested, meaning it can contain other lists inside. For example the list '((state L L L L) NIL (state L L R L) NIL) should be tranformed into '((STATE L L L L) (STATE L L R L)).
(defun remove-nil-recursively (x)
(if (listp x)
(mapcar #'remove-nil-recursively
(remove nil x))
x))
Works for your example:
[1]> (remove-nil-recursively '((state L L L L) NIL (state L L R L) NIL))
((STATE L L L L) (STATE L L R L))
And with nested lists:
[2]> (remove-nil-recursively '(NIL (state L L nil R L) NIL))
((STATE L L R L))
But watch out:
[3]> (remove-nil-recursively '(NIL (state L L (nil) R L) NIL))
((STATE L L NIL R L))
Paul Graham calls this function (recurring into sublists remove-if) "prune" in On Lisp, p. 49. It is one of the utility functions.
(defun prune (test tree)
(labels ((rec (tree acc)
(cond
((null tree) (nreverse acc))
((consp (car tree))
(rec (cdr tree)
(cons (rec (car tree) nil) acc)))
(t (rec (cdr tree)
(if (funcall test (car tree))
acc
(cons (car tree) acc)))))))
(rec tree nil)))
(prune #'evenp '(1 2 (3 (4 5) 6) 7 8 (9)))
(1 (3 (5)) 7 (9))
A generic function in the style of remove-if:
(defun remove-all (predic seq &optional res)
(if (null seq)
(reverse res)
(cond ((and (not (null (car seq))) (listp (car seq)))
(remove-all predic (cdr seq)
(cons (remove-all predic (car seq)) res)))
((funcall predic (car seq))
(remove-all predic (cdr seq) res))
(t (remove-all predic (cdr seq) (cons (car seq) res))))))
Examples:
> (remove-all #'null (list 1 2 'nil 3))
=> (1 2 3)
> (remove-all #'null (list 1 2 'nil '(4 5 nil 6) 3))
=> (1 2 (4 5 6) 3)
> (remove-all #'(lambda (x) (oddp x)) '(1 2 (3 4) 5 6 (7 8 (9 10))))
=> (2 (4) 6 (8 (10)))
(defun remove-if-nil (list) (remove-if-not 'identity list))
remove-if-not takes a predicate and a list, and removes all the items in the list that do not satisfy the predicate, that is, that return nil when evaluated in the predicate. identity, as you can guess, returns exactly the same thing it takes, so (remove-if-not 'identity list) removes every element in list that is nil.
Related
I want to create a function in LISP
to count the number of 0 in given arguments
Ex
(count_number_of_0 '(1 0 5 9 0 0 0 7 1 0) )
Output : 5
Here is an implementation in Racket, which is a lisp-family language. It would be quite easy to translate into Common Lisp (but a little more verbose in CL):
(define make-counter
(λ (v same?)
(λ (l)
((λ (c)
(c c 0 l))
(λ (c a t)
(if (null? t)
a
(c c (if (same? (first t) v) (+ a 1) a) (rest t))))))))
(define count-zeros
(make-counter 0 =))
And now
> (count-zeros '(1 2 0 3 4 0))
2
one way is:
(defun count-number-of-0 (lst &optional (cnt 0)) ;counter starts at zero
(if lst
(if (and (numberp (car lst)) ;better verify that element is a number
(= 0 (car lst)))
(progn
(setq cnt (+ cnt 1))
(count-number-of-0 (cdr lst) cnt))
(count-number-of-0 (cdr lst) cnt))
cnt)) ;return counter
This should work in all implementations of common-lisp.
I have my two functions here in my scheme code and I want to display the output check_even and count_even at once after inputting the user given list. Can anyone help me to make it possible? I'm very new to scheme and I really need your help.
Here's my code:
(define (check_even lst) #function for checking even
(cond ((null? lst) '())
((even? (car lst)) (cons (car lst) (check_even (cdr lst))))
(else (check_even (cdr lst)))))
(define (count_even list) #function for counting even
(if (null? list)
0
( + (if (even? (car list )) 1 0)
(count_even (cdr list)))))
How about using values? it'll allow you to return multiple values, like this:
(define (results lst)
(values (count_even lst)
(check_even lst)))
For example:
(results '(1 2 3 4 5 6 7 8 9 10))
=> 5
'(2 4 6 8 10)
I'm a newbie and I didn't understand very well the language. Could anyone please explain to me what this functions do?
First function:
(define (x l)
(cond
((null? l) 0)
((list? (car l))
(+ (x (car l)) (x (cdr l))))
(else (+ 1 (x (cdr l))))
))
Second function:
(define (x l)
(cond
((null? l) 0)
((list? (car l))
(+ (x (car l)) (x (cdr l))))
(else (+ (car l) (x (cdr l)))
))
I do understand the begining but the conditions I didn't understand. Any help?
I will call your second function y.
Writing in pseudocode,
x [] -> 0
x [a . b] -> x a + x b , if list a
x [a . b] -> 1 + x b , else, i.e. if not (list a)
y [] -> 0
y [a . b] -> y a + y b , if list a
y [a . b] -> a + y b , else, i.e. if not (list a)
So for example,
x [2,3] = x [2 . [3]]
= 1 + x [3]
= 1 + x [3 . []]
= 1 + (1 + x [])
= 1 + (1 + 0 )
and
y [2,3] = y [2 . [3]]
= 2 + y [3]
= 2 + y [3 . []]
= 2 + ( 3 + y [])
= 2 + ( 3 + 0 )
See? The first counts something in the argument list, the second sums them up.
Of course both functions could be called with some non-list, but then both would just cause an error trying to get (car l) in the second clause, (list? (car l)).
You might have noticed that the two are almost identical. They both accumulates (fold) over a tree. Both of them will evaluate to 0 on the empty tree and both of them will sum the result of the same procedure on the car and cdr when the car is a list?. The two differ when the car is not a list and in the first it adds 1 for each element in the other it uses the element itself in the addition. It's possible to write the same a little more compact like this:
(define (sum l)
(cond
((null? l) 0) ; null-value
((not (pair? l)) l) ; term
(else (+ (sum (car l)) (sum (cdr l)))))) ; combine
Here is a generalisation:
(define (accumulate-tree tree term combiner null-value)
(let rec ((tree tree))
(cond ((null? tree) null-value)
((not (pair? tree)) (term tree))
(else (combiner (rec (car tree))
(rec (cdr tree)))))))
You can make both of your procedures in terms of accumulate-tree:
(define (count tree)
(accumulate-tree tree (lambda (x) 1) + 0))
(define (sum tree)
(accumulate-tree tree (lambda (x) x) + 0))
Of course you can make a lot more than this with accumulate-tree. It doesn't have to turn into an atomic value.
(define (double tree)
(accumulate-tree tree (lambda (x) (* 2 x)) cons '()))
(double '(1 2 ((3 4) 2 3) 4 5)) ; ==> (2 4 ((6 8) 4 6) 8 10)
I must create a function - (search-last x list), i made this:
(define (search-last o lst)
(let loop ((lst lst))
(if (eqv? (caar lst) o)
(cdar lst)
(if (pair? (cdr lst))
(loop (cdr lst))
o))))
but for ex.
(define l '((1 . 2) (2 . 5) (3 . 5) (2 . 1)))
should be 1 but
my output is 5 i know where i made mistake but i dont know how can i improve it.
I cant use expression with "!" and vector, for, while, set, sort, reverse, list-ref, list-tail, append, length.
A tail recursive solution using named let
(define (search-last o lst)
(let loop ((lst lst) (match #f)) ; when not found match is #f
(cond ((null? lst) match) ; return last match at the end
((eqv? (caar lst) o) ; when found
(loop (cdr lst) (cdar lst))) ; we recurse with new match
(else (loop (cdr lst) match))))); or we keep the old match
You could have created your own reverse function and reverse the list in your named let loop. But my understanding is that this is not the point of the exercise.
This will work:
(define (search-last o lst)
(or
(let loop ((lst lst))
(cond
((null? lst) #f)
((eqv? (caar lst) o) (or (loop (cdr lst)) (cdar lst)))
(else (loop (cdr lst)))))
o))
The trick is that if you find a pair with the required first element, the or clause will search the rest of the list. If it returns #f, i.e. if there is no other such pair in the remaining list, then the clause will return (cdar lst). Otherwise it will return the result of the recursive search-last call. The outer or does the same with the final result, i.e. replacing #f with the argument o.
Testing:
> (search-last 1 '((1 . 2) (2 . 5) (3 . 5) (2 . 1)))
2
> (search-last 2 '((1 . 2) (2 . 5) (3 . 5) (2 . 1)))
1
> (search-last 3 '((1 . 2) (2 . 5) (3 . 5) (2 . 1)))
5
> (search-last 4 '((1 . 2) (2 . 5) (3 . 5) (2 . 1)))
4
FWIW, here's a tail-recursive version:
(define (search-last o lst)
(let loop ((lst lst) (res o))
(cond
((null? lst) res)
((eqv? (caar lst) o) (loop (cdr lst) (cdar lst)))
(else (loop (cdr lst) res)))))
I'm trying to implement an algorithm to multiply two bit-lists of 1s and 0s as a simulation to binary multiplication. It should return a like list, but I am having a hard time building on what I already have. Some help would be appreciated...
;;Function designed to accept two bit-list binary numbers (reverse order) and produce their product, a bitlist in reverse order.
;;Example: (multiply '(0 1 1 0 1) '(1 0 1)) should produce '(0 1 1 1 0 1 1)
(define (multiply x y)
(cond
;[(= null? y) 0]
[(zero? y) 0]
(#t (let ((z (multiply x (rest y )))) (cond
[(num_even? y) (cons 0 z)]
(#t (addWithCarry x (cons 0 z) 1)))))))
;This is to check if the current value of parameter x is the number 0
(define (zero? x)
(cond
((null? x) #t)
((=(first x) 1) #f)
(#t (zero? (rest x)))))
;This is to check if the current parameter x is 0 (even) or not.
(define (num_even? x)
(cond
[(null? x) #t]
[(=(first x) 0)#t]
[#t (num_even? (rest x))]))
;To add two binary numbers
(define(addWithCarry x y carry)
(cond
((and (null? x) (null? y)) (if (= carry 0) '( ) '(1)))
((null? x) (addWithCarry '(0) y carry))
((null? y) (addWithCarry x '(0) carry))
(#t (let ((bit1 (first x))
(bit2 (first y)))
(cond
((=(+ bit1 bit2 carry) 0) (cons 0 (addWithCarry (rest x)(rest y) 0)))
((=(+ bit1 bit2 carry) 1) (cons 1 (addWithCarry (rest x)(rest y) 0)))
((=(+ bit1 bit2 carry) 2) (cons 0 (addWithCarry (rest x)(rest y) 1)))
(#t (cons 1 (addWithCarry (rest x) (rest y) 1))))))))
Based on my previous answer for a base-10 multiplication, here's a solution that works for binary numbers (in the correct order):
(define base 2)
(define (car0 lst)
(if (empty? lst)
0
(car lst)))
(define (cdr0 lst)
(if (empty? lst)
empty
(cdr lst)))
(define (apa-add l1 l2) ; apa-add (see https://stackoverflow.com/a/19597007/1193075)
(let loop ((l1 (reverse l1))
(l2 (reverse l2))
(carry 0)
(res '()))
(if (and (null? l1) (null? l2) (= 0 carry))
res
(let* ((d1 (car0 l1))
(d2 (car0 l2))
(ad (+ d1 d2 carry))
(dn (modulo ad base)))
(loop (cdr0 l1)
(cdr0 l2)
(quotient (- ad dn) base)
(cons dn res))))))
(define (mult1 n lst) ; multiply a list by one digit
(let loop ((lst (reverse lst))
(carry 0)
(res '()))
(if (and (null? lst) (= 0 carry))
res
(let* ((c (car0 lst))
(m (+ (* n c) carry))
(m0 (modulo m base)))
(loop (cdr0 lst)
(quotient (- m m0) base)
(cons m0 res))))))
(define (apa-multi l1 l2) ; full multiplication
(let loop ((l2 (reverse l2))
(app '())
(res '()))
(if (null? l2)
res
(let* ((d2 (car l2))
(m (mult1 d2 l1))
(r (append m app)))
(loop (cdr l2)
(cons '0 app)
(apa-add r res))))))
so that
(apa-multi '(1 0 1 1 0) '(1 0 1))
=> '(1 1 0 1 1 1 0)