my task is to count all element within a list, which have duplicates, eg
( 2 2 (3 3) 4 (3)) will result in 2 (because only 2 and 3 have duplicates)
Searchdeep - just returns a nill if WHAT isn't find in list WHERE
Count2 - go through the single elements and sub-lists
If it finds atom he will use SEARCHDEEP to figure out does it have duplicates, then list OUT will be checked (to make sure if this atom was not already counted (e.g. like ( 3 3 3), which should return 1, not 2)
, increase counter and add atom to the OUT list.
However, i don't understand why, but it constantly returns only 1. I think it is some kind of logical mistake or wrong use of function.
My code is:
(SETQ OUT NIL)
(SETQ X (LIST 2 -3 (LIST 4 3 0 2) (LIST 4 -4) (LIST 2 (LIST 2 0 2))-5))
(SETQ count 0)
(DEFUN SEARCHDEEP (WHAT WHERE) (COND
((NULL WHERE) NIL)
(T (OR
(COND
((ATOM (CAR WHERE)) (EQUAL WHAT (CAR WHERE)))
(T (SEARCHDEEP WHAT (CAR WHERE)))
)
(SEARCHDEEP WHAT (CDR WHERE))
)
)
)
)
(DEFUN Count2 ( input)
(print input)
(COND
((NULL input) NIL)
(T
(or
(COND
((ATOM (CAR input))
(COND
(
(and ;if
(SEARCHDEEP (CAR INPUT) (CDR INPUT))
(NOT (SEARCHDEEP (CAR INPUT) OUT))
)
(and ;do
(Setq Count (+ count 1))
(SETQ OUT (append OUT (LIST (CAR INPUT))))
(Count2 (CDR input))
)
)
(t (Count2 (CDR input)))
)
)
(T (Count2 (CAR input)))
)
(Count2 (CDR input))
)
)
)
)
(Count2 x)
(print count)
First, your code has some big style issues. Don't write in uppercase (some, like myself, like to write symbols in uppercase in comments and in text outside of code, but the code itself should be written in lowercase), and don't put parentheses on their own lines. So the SEARCHDEEP function should look more like
(defun search-deep (what where)
(cond ((null where) nil)
(t (or (cond ((atom (car where)) (equal what (car where)))
(t (searchdeep what (car where))))
(searchdeep what (cdr where))))))
You also should not use SETQ to define variables. Use DEFPARAMETER or DEFVAR instead, although in this case you should not use global variables in the first place. You should name global variables with asterisks around the name (*X* instead of x, but use a more descriptive name).
For the problem itself, I would start by writing a function to traverse a tree.
(defun traverse-tree (function tree)
"Traverse TREE, calling FUNCTION on every atom."
(typecase tree
(atom (funcall function tree))
(list (dolist (item tree)
(traverse-tree function item))))
(values))
Notice that TYPECASE is more readable than COND in this case. You should also use the mapping or looping constructs provided by the language instead of writing recursive loops yourself. The (values) at the end says that the function will not return anything.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(traverse-tree (lambda (item)
(format t "~a " item))
tree))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
; No values
If you were traversing trees a lot, you could hide that function behind a DO-TREE macro
(defmacro do-tree ((var tree &optional result) &body body)
`(progn (traverse-tree (lambda (,var)
,#body)
,tree)
,result))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(do-tree (item tree)
(format t "~a " item)))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
;=> NIL
Using this, we can write a function that counts every element in the tree, returning an alist. I'll use a hash table to keep track of the counts. If you're only interested in counting numbers that will stay in a small range, you might want to use a vector instead.
(defun tree-count-elements (tree &key (test 'eql))
"Count each item in TREE. Returns an alist in
form ((item1 . count1) ... (itemn . countn))"
(let ((table (make-hash-table :test test)))
(do-tree (item tree)
(incf (gethash item table 0)))
(loop for value being the hash-value in table using (hash-key key)
collect (cons key value))))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(tree-count-elements tree))
;=> ((2 . 5) (-3 . 1) (4 . 2) (3 . 1) (0 . 2) (-4 . 1) (-5 . 1))
The function takes a keyword argument for the TEST to use with the hash table. For numbers or characters, EQL works.
Now you can use the standard COUNT-IF-function to count the elements that occur more than once.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(count-if (lambda (item)
(> item 1))
(tree-count-elements tree)
:key #'cdr))
;=> 3
Related
I'm trying to write a recursive function to check if the elements of a list are increasing consecutively.
(defun test (lst)
(if (null lst)
1
(if (= (car lst) (1- (test (cdr lst))))
1
0)))
(setq consecutive '(1 2 3 4))
(setq non-consecutive '(2 5 3 6))
The results are:
CL-USER> (test non-consecutive)
0
CL-USER> (test consecutive)
0
(test consecutive) should return 1. How can I write this function correctly?
To check that the numbers in the sequence are consecutive, i.e.,
increasing with step 1, you need this:
(defun list-consecutive-p (list)
(or (null (cdr list))
(and (= 1 (- (second list) (first list)))
(list-consecutive-p (rest list)))))
Then
(list-consecutive-p '(1 2 3 4))
==> T
(list-consecutive-p '(1 4))
==> NIL
(list-consecutive-p '(4 1))
==> NIL
NB. Numbers are a poor substitute for booleans.
PS. I wonder if this is related to How to check if all numbers in a list are steadily increasing?...
I was trying to make a recursive function to split a list into two lists according the number of elements one wants.
Ex:
(split 3 '(1 3 5 7 9)) ((1 3 5) (7 9))
(split 7 '(1 3 5 7 9)) ((1 3 5 7 9) NIL)
(split 0 '(1 3 5 7 9)) (NIL (1 3 5 7 9))
My code is like this:
(defun split (e L)
(cond ((eql e 0) '(() L))
((> e 0) (cons (car L) (car (split (- e 1) (cdr L))))))))
I don't find a way to join the first list elements and return the second list.
Tail recursive solution
(defun split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((>= 0 n) (list (reverse acc-l) l))
(t (split (1- n) (cdr l) (cons (car l) acc-l)))))
Improved version
(in this version, it is ensured that acc-l is at the beginning '()):
(defun split (n l)
(labels ((inner-split (n l &optional (acc-l '()))
(cond ((null l) (list (reverse acc-l) ()))
((= 0 n) (list (reverse acc-l) l))
(t (inner-split (1- n) (cdr l) (cons (car l) acc-l))))))
(inner-split n l)))
Test it:
(split 3 '(1 2 3 4 5 6 7))
;; returns: ((1 2 3) (4 5 6 7))
(split 0 '(1 2 3 4 5 6 7))
;; returns: (NIL (1 2 3 4 5 6 7))
(split 7 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split 9 '(1 2 3 4 5 6 7))
;; returns ((1 2 3 4 5 6 7) NIL)
(split -3 '(1 2 3 4 5 6 7))
;; returns (NIL (1 2 3 4 5 6 7))
In the improved version, the recursive function is placed one level deeper (kind of encapsulation) by using labels (kind of let which allows definition of local functions but in a way that they are allowed to call themselves - so it allows recursive local functions).
How I came to the solution:
Somehow it is clear, that the first list in the result must result from consing one element after another from the beginning of l in successive order. However, consing adds an element to an existing list at its beginning and not its end.
So, successively consing the car of the list will lead to a reversed order.
Thus, it is clear that in the last step, when the first list is returned, it hast to be reversed. The second list is simply (cdr l) of the last step so can be added to the result in the last step, when the result is returned.
So I thought, it is good to accumulate the first list into (acc-l) - the accumulator is mostly the last element in the argument list of tail-recursive functions, the components of the first list. I called it acc-l - accumulator-list.
When writing a recursive function, one begins the cond part with the trivial cases. If the inputs are a number and a list, the most trivial cases - and the last steps of the recursion, are the cases, when
the list is empty (equal l '()) ---> (null l)
and the number is zero ----> (= n 0) - actually (zerop n). But later I changed it to (>= n 0) to catch also the cases that a negative number is given as input.
(Thus very often recursive cond parts have null or zerop in their conditions.)
When the list l is empty, then the two lists have to be returned - while the second list is an empty list and the first list is - unintuitively - the reversed acc-l.
You have to build them with (list ) since the list arguments get evaluated shortly before return (in contrast to quote = '(...) where the result cannot be evaluated to sth in the last step.)
When n is zero (and later: when n is negative) then nothing is to do than to return l as the second list and what have been accumulated for the first list until now - but in reverse order.
In all other cases (t ...), the car of the list l is consed to the list which was accumulated until now (for the first list): (cons (car l) acc-l) and this I give as the accumulator list (acc-l) to split and the rest of the list as the new list in this call (cdr l) and (1- n). This decrementation in the recursive call is very typical for recursive function definitions.
By that, we have covered all possibilities for one step in the recursion.
And that makes recursion so powerful: conquer all possibilities in ONE step - and then you have defined how to handle nearly infinitely many cases.
Non-tail-recursive solution
(inspired by Dan Robertson's solution - Thank you Dan! Especially his solution with destructuring-bind I liked.)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (destructuring-bind (left right) (split (1- n) (cdr l))
(list (cons (car l) left) right)))))
And a solution with only very elementary functions (only null, list, >=, let, t, cons, car, cdr, cadr)
(defun split (n l)
(cond ((null l) (list '() '()))
((>= 0 n) (list '() l))
(t (let ((res (split (1- n) (cdr l))))
(let ((left-list (car res))
(right-list (cadr res)))
(list (cons (car l) left-list) right-list))))))
Remember: split returns a list of two lists.
(defun split (e L)
(cond ((eql e 0)
'(() L)) ; you want to call the function LIST
; so that the value of L is in the list,
; and not the symbol L itself
((> e 0)
; now you want to return a list of two lists.
; thus it probably is a good idea to call the function LIST
; the first sublist is made of the first element of L
; and the first sublist of the result of SPLIT
; the second sublist is made of the second sublist
; of the result of SPLIT
(cons (car L)
(car (split (- e 1)
(cdr L)))))))
Well let’s try to derive the recursion we should be doing.
(split 0 l) = (list () l)
So that’s our base case. Now we know
(split 1 (cons a b)) = (list (list a) b)
But we think a bit and we’re building up the first argument on the left and the way to build up lists that way is with CONS so we write down
(split 1 (cons a b)) = (list (cons a ()) b)
And then we think a bit and we think about what (split 0 l) is and we can write down for n>=1:
(split n+1 (cons a b)) = (list (cons a l1) l2) where (split n b) = (list l1 l2)
So let’s write that down in Lisp:
(defun split (n list)
(ecase (signum n)
(0 (list nil list))
(1 (if (cdr list)
(destructuring-bind (left right) (split (1- n) (cdr list))
(list (cons (car list) left) right))
(list nil nil)))))
The most idiomatic solution would be something like:
(defun split (n list)
(etypecase n
((eql 0) (list nil list))
(unsigned-integer
(loop repeat n for (x . r) on list
collect x into left
finally (return (list left r))))))
So I'm very new to scheme, first day programming in it. I'm trying to make a recursive function that basically takes two arguements numlist, num numlist is a list of numbers, and num is a single number. The function takes the list, goes through each element and compares it to num, if the number is greater then num it replaces it in the list with a 1, otherwise it replaces it with a 0.
Ex: arguments( (1,2,3,4,5,6,7,8,9,10) , 5) transforms the list to (0,0,0,0,0,1,1,1,1,1)
But for some reason my function is not returning anything, it doesn't print anything to my screen, why?
(define (greater-nums-in-list numlist num)
(cond
[(null? numlist) ()]
[(> (car numlist) num) (append 1 (greater-nums-in-list((cdr numlist) num))]
[else (append 0 (greater-nums-in-list((cdr numlist) num)))]
)
)
Any help would be appreciated, this is just personal studying code so I'm in no rush.
The "nothing" that it prints to screen is because of the base-condition at the bottom of the recursion:
[(null? numlist) ()]
This means that when you've done iterating the list, you return () - that's not an empty-list - that applying "nothing", an empty list is '().
There were a couple of brackets-bugs and you cannot append 1 or 0 to a list - you need to wrap them in a list first:
(define (greater-nums-in-list numlist num)
(cond
[(null? numlist) '()]
[(> (car numlist) num) (append '(1) (greater-nums-in-list (cdr numlist) num))]
[else (append '(0) (greater-nums-in-list (cdr numlist) num))]
)
)
Usage
> (greater-nums-in-list '(1 2 3 4) 2)
'(0 0 1 1)
> (greater-nums-in-list '(1 2 3 4 5 6 7 8 9 10) 5)
'(0 0 0 0 0 1 1 1 1 1)
>
I am trying to write a function which takes a list (x) and a number (y) and deletes every occurance of that number in the list. Ex. (deepdeleting '(0 0 1 2 0 3 0) 0) ===> '(1 2 3)
Here's what I have so far:
(define (deepdeleting x y)
(if (pair? x)
(if (eqv? (car x) y)
(begin
(set! x (cdr x))
(deepdeleting x y)
)
(deepdeleting (cdr x) y) ; else
)
x ; else
)
)
The code works, but my problem is I want it to modify the original list, not just return a new list. Right now this is what happens:
> (define list '(0 0 1 2 0 3 0))
> (deepdeleting list 0)
(1 2 3)
> list
(0 0 1 2 0 3 0) ; <<< I want this to be (1 2 3)
This seems strange to me since both the set-car! and set-cdr! functions seem to change the input list, whereas set! does not...
Any insight would be much appreciated!
When you use set! you are redefining the innermost binding:
(define test 10)
(set! test 11) ; changes global test to 11
(define (change-test value)
(set! test value))
(change-test 12) ; changes global test to 12
(define (change-test! value new-value)
(display value)
(set! value new-value) ; changes the local binding value
(display value))
(change-test! test 13) ; changes nothing outside of change-test, prints 12 then 13
Variable bindings are totally different than list structure mutation. Here a binding is used to point to a pair that is altered:
(define lst '(1 2 3))
(define lst2 (cdr lst)) ; lst2 shares structure with lst
(set-cdr! lst2 '(8 7 6 5))
lst2 ; ==> (2 8 7 6 5)
lst ; ==> (1 2 8 7 6 5) the original binding share structure thus is changed too
(set-cdr! lst lst) ; makes a circular never ending list (1 1 1 1 ...)
(eq? lst (cdr lst)) ;==> #t
(set-car! lst 2) ; changes lst to be never ending list (2 2 2 2 ...)
So you can mutate pairs with set-cdr! and set-car! and a binding to the original list will point to the first pair. Thus you need the result to start with the same pair as the first. With that you can make your mutating procedure this way:
#!r6rs
(import (rnrs) (rnrs mutable-pairs))
(define (remove! lst e)
(if (pair? lst)
(let loop ((prev lst)(cur (cdr lst)))
(if (pair? cur)
(if (eqv? (car cur) e)
(begin
(set-cdr! prev (cdr cur))
(loop prev (cdr cur)))
(loop cur (cdr cur)))
(if (eqv? (car lst) e)
(if (pair? (cdr lst))
(begin
(set-car! lst (cadr lst))
(set-cdr! lst (cddr lst)))
(error 'first-pair-error "Not possible to remove the first pair"))
#f)))
#f))
(define test '(0 0 1 2 0 3 0))
(define test2 (cdr test))
test2 ;==> (0 1 2 0 3 0)
(remove! test 0)
test ; ==> (1 2 3)
test2 ; ==> (0 1 2 0 3 0)
(remove! '(0) 0)
; ==> first-pair-error: Not possible to remove the first pair
(remove! '(1 2 3) 2) ; this works too but you have no way of checking
While lst is bound to the list during removal and the same list has one element less there was not binding to it outside of the remove! procedure so the result is forever lost.
EDIT
For R5RS remove the first two lines and add error:
;; won't halt the program but displays the error message
(define (error sym str)
(display str)
(newline))
I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))