Count of atoms on the each level, Scheme - lisp

Please, help me with one simple exercise on the Scheme.
Write function, that return count of atoms on the each level in the
list. For example:
(a (b (c (d e (f) k 1 5) e))) –> ((1 1) (2 1) (3 2) (4 5) (5 1))
My Solution:
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (count L)
(cond ((null? L) 0)
((pair? (car L))
(count (cdr L)))
(else
(+ 1 (count (cdr L))))))
(define (fun L level)
(cons
(list level (count L))
(ololo L level)))
(define (ololo L level)
(if (null? L)
'()
(if (atom? (car L))
(ololo (cdr L) level)
(fun (car L) (+ level 1)))))
(fun '(a (b (c (d e (f) k 1 5) e))) 1)
It's work fine, but give not correctly answer for this list:
(a (b (c (d e (f) (k) 1 5) e)))
is:
((1 1) (2 1) (3 2) (4 4) (5 1))
But we assume that 'f' and 'k' on the one level, and answer must be:
((1 1) (2 1) (3 2) (4 4) (5 2))
How should I edit the code to make it work right?
UPD (29.10.12):
My final solution:
(define A '(a (b (c (d e (f) k 1 5) e))))
(define (atom? x)
(and (not (pair? x)) (not (null? x))))
(define (unite L res)
(if (null? L) (reverse res)
(unite (cdr L) (cons (car L) res))))
(define (count-atoms L answ)
(cond ((null? L) answ)
((pair? (car L))
(count-atoms (cdr L) answ))
(else
(count-atoms (cdr L) (+ answ 1)))))
(define (del-atoms L answ)
(cond ((null? L) answ)
((list? (car L))
(begin
(del-atoms (cdr L) (unite (car L) answ))))
(else
(del-atoms (cdr L) answ))))
(define (count L)
(define (countme L level answ)
(if (null? L) (reverse answ)
(countme (del-atoms L '()) (+ level 1) (cons (cons level (cons (count-atoms L 0) '())) answ))))
(countme L 1 '()))
(count A)
What can you say about this?

Do you know what you get if you run this?
(fun '(a (b (c (d e (f) k 1 5) e)) (a (b (c)))) 1)
You get this:
((1 1) (2 1) (3 2) (4 5) (5 1))
The whole extra nested structure that I added on the right has been ignored. Here is why...
Each recursion of your function does two things:
Count all the atoms at the current "level"
Move down the level till you find an s-expression that is a pair (well, not an atom)
Once it finds a nested pair, it calls itself on that. And so on
What happens in oLoLo when fun returns from the first nested pair? Why, it returns! It does not keep going down the list to find another.
Your function will never find more than the first list at any level. And if it did, what would you to do add the count from the first list at that level to the second? You need to think carefully about how you recur completely through a list containing multiple nested lists and about how you could preserve information at each level. There's more than one way to do it, but you haven't hit on any of them yet.

Note that depending on your implementation, the library used here may need to be imported in some other way. It might be painstakingly difficult to find the way it has to be imported and what are the exact names of the functions you want to use. Some would have it as filter and reduce-left instead. require-extension may or may not be Guile-specific, I don't really know.
(require-extension (srfi 1))
(define (count-atoms source-list)
(define (%atom? x) (not (or (pair? x) (null? x))))
(define (%count-atoms source-list level)
(if (not (null? source-list))
(cons (list level (count %atom? source-list))
(%count-atoms (reduce append '()
(filter-map
(lambda (x) (if (%atom? x) '() x))
source-list)) (1+ level))) '()))
(%count-atoms source-list 1))
And, of course, as I mentioned before, it would be best to do this with hash-tables. Doing it with lists may have some didactic effect. But I have a very strong opposition to didactic effects that make you write essentially bad code.

Related

Repeating elements in scheme [duplicate]

This code in Scheme is used to output a list in which the element of the input lists are repeated n times. I do not understand what is happening in the code.
(define (echo-lots lst n)
(define (helper lst1 n1)
(if (= n1 0)
'()
(cons lst1 (helper lst1 (- n1 1)))))
(if (null? lst)
'()
(append (helper (car lst) n) (echo-lots (cdr lst) n)))
First, note that helper does not use any of the parameters of echo-lots.
That means that you can move the definition outside and figure it out in isolation:
(define (helper lst1 n1)
(if (= n1 0)
'()
(cons lst1 (helper lst1 (- n1 1)))))
> (helper 1 3)
'(1 1 1)
> (helper #f 4)
'(#f #f #f #f)
> (helper '(a b c) 2)
'((a b c) (a b c))
It makes a list whose elements are the first parameter repeated the number of times given by the second parameter.
(It's not difficult to prove this formally, if you're in the mood for that.)
Note also that the first parameter's name is misleading - it does not have to be a list.
Let's improve the naming:
(define (repeat item n)
(if (= n 0)
'()
(cons item (repeat item (- n 1)))))
Now echo-lots is clearer:
(define (echo-lots lst n)
(if (null? lst)
'()
(append (repeat (car lst) n)
(echo-lots (cdr lst) n))))
and it's easier to see that it makes a list of n copies of the first element of lst - (repeat (car lst) n) - and appends that to a list consisting of n copies of each of the remaining elements - (echo-lots (cdr lst) n).

I want to merge and sort two sorted lists with Common Lisp

I want to merge and sort two sorted association lists with Common Lisp.
I made code. But result is not same with my thought.
(defun MERGEALIST (K L)
(cond ((and (eq nil K) (eq nil L)) nil)
((eq nil K) L)
((eq nil L) K)
((<= (car (car K)) (car (car L)))
(cons K (MERGEALIST (cdr K) L)))
((> (car (car K)) (car (car L)))
(cons L (MERGEALIST K (cdr L))))))
Function's input K and L is sorted association lists.
For example,
K is ((1 . a) (3 . c) (5 . e))
L is ((2 . b) (4 . d)).
I expected that result is ((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)).
But result is completely different.
Why this result is come out?
thanks.
You can simplify it a bit. The main change is like in the comment from jkiiski.
CL-USER 5 > (defun MERGEALIST (K L)
(cond ((and (null K) (null L)) nil)
((null K) L)
((null L) K)
((<= (caar K) (caar L))
(cons (car K) (MERGEALIST (cdr K) L)))
((> (caar K) (caar L))
(cons (car L) (MERGEALIST K (cdr L))))))
MERGEALIST
CL-USER 6 > (mergealist '((1 . a) (3 . c) (5 . e)) '((2 . b) (4 . d)))
((1 . A) (2 . B) (3 . C) (4 . D) (5 . E))
The built-in function merge does it:
CL-USER 9 > (merge 'list
'((1 . a) (3 . c) (5 . e))
'((2 . b) (4 . d))
#'<
:key #'car)
((1 . A) (2 . B) (3 . C) (4 . D) (5 . E))
(cons K (MERGEALIST (cdr K) L))
Here you put the complete list K in front of the "rest" of your computation. You only want the first element of it (that you just tested to "come before" the first element of L):
(cons (car K) (MERGEALIST (cdr K) L))
Though note that you could simplify that a lot:
(defun merge-alists (k l)
(cond
;; Common case first, if both alists are not empty, then select
;; the first element of that alist, whose car is less. Then, recurse.
((and (consp k) (consp l))
(if (<= (caar k) (caar l))
(cons (car k) (merge-alists (cdr k) l))
(cons (car l) (merge-alists k (cdr l)))))
;; One of the alists is empty, use either the not-empty one or ...
((consp k) k)
;; ... just the other (when k is empty or both are empty)
(t l)))
(The last two cond clauses could be simplified to (t (or k l)) ... but that could be a bit too concise to be clearly understandable.)
Or, as already pointed out, use merge.

How do I find the index of an element in a list in Racket?

This is trivial implement of course, but I feel there is certainly something built in to Racket that does this. Am I correct in that intuition, and if so, what is the function?
Strangely, there isn't a built-in procedure in Racket for finding the 0-based index of an element in a list (the opposite procedure does exist, it's called list-ref). However, it's not hard to implement efficiently:
(define (index-of lst ele)
(let loop ((lst lst)
(idx 0))
(cond ((empty? lst) #f)
((equal? (first lst) ele) idx)
(else (loop (rest lst) (add1 idx))))))
But there is a similar procedure in srfi/1, it's called list-index and you can get the desired effect by passing the right parameters:
(require srfi/1)
(list-index (curry equal? 3) '(1 2 3 4 5))
=> 2
(list-index (curry equal? 6) '(1 2 3 4 5))
=> #f
UPDATE
As of Racket 6.7, index-of is now part of the standard library. Enjoy!
Here's a very simple implementation:
(define (index-of l x)
(for/or ([y l] [i (in-naturals)] #:when (equal? x y)) i))
And yes, something like this should be added to the standard library, but it's just a little tricky to do so nobody got there yet.
Note, however, that it's a feature that is very rarely useful -- since lists are usually taken as a sequence that is deconstructed using only the first/rest idiom rather than directly accessing elements. More than that, if you have a use for it and you're a newbie, then my first guess will be that you're misusing lists. Given that, the addition of such a function is likely to trip such newbies by making it more accessible. (But it will still be added, eventually.)
One can also use a built-in function 'member' which gives a sublist starting with the required item or #f if item does not exist in the list. Following compares the lengths of original list and the sublist returned by member:
(define (indexof n l)
(define sl (member n l))
(if sl
(- (length l)
(length sl))
#f))
For many situations, one may want indexes of all occurrences of item in the list. One can get a list of all indexes as follows:
(define (indexes_of1 x l)
(let loop ((l l)
(ol '())
(idx 0))
(cond
[(empty? l) (reverse ol)]
[(equal? (first l) x)
(loop (rest l)
(cons idx ol)
(add1 idx))]
[else
(loop (rest l)
ol
(add1 idx))])))
For/list can also be used for this:
(define (indexes_of2 x l)
(for/list ((i l)
(n (in-naturals))
#:when (equal? i x))
n))
Testing:
(indexes_of1 'a '(a b c a d e a f g))
(indexes_of2 'a '(a b c a d e a f g))
Output:
'(0 3 6)
'(0 3 6)

Finding the maximum number of child nodes in a tree

First, I should make it clear that this is required for an academic project. I am trying to find the maximum number of child nodes for any node in a tree, using Common Lisp.
My current code is shown below - I'm not 100% on the logic of it, but I feel it should work, however it isn't giving me the required result.
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element)))
))) list)
l)
(defun max-breadth(list)
(breadth list (length list))
)
As an example, running
(max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
should return 4.
Edit:
Trace results and actual return values, forgot these:
CG-USER(13): (max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
0[6]: (BREADTH (A ((B (C D)) E) (F G (H I) J)) 3)
1[6]: (BREADTH ((B (C D)) E) 2)
2[6]: (BREADTH (B (C D)) 2)
3[6]: (BREADTH (C D) 2)
3[6]: returned 2
2[6]: returned 2
1[6]: returned 2
1[6]: (BREADTH (F G (H I) J) 4)
2[6]: (BREADTH (H I) 2)
2[6]: returned 2
1[6]: returned 2
0[6]: returned 2
2
Does anyone have any ideas where I'm going wrong? I suspect it's related to the second conditional, but I'm not sure.
First, standard formatting:
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l)
(defun max-breadth (list)
(breadth list (length list)))
Your problem is the (setf l y), which should give you a warning about l being undefined. Setf should not be used on unbound variables. Use let to make a lexical scope:
(defun breadth (list y)
(let ((l y))
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l))
Then, instead of two nested when, use a single one and and:
(when (and (listp element)
(> (breadth element (length element)) 1))
(setf l (breadth element (length element))))
I find dolist more concise here:
(dolist (element list)
(when (and (listp element)
(> (breadth element (length element)) l))
(setf l (breadth element (length element)))))
The parameter y is always the length of the parameter list, so this call can be simplified. You also do not need to alias y:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (and (listp element)
(> (breadth element) y))
(setf y (breadth element))))
y)
You could eliminate the double recursive call through a let, but we can use max here:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (listp element)
(setf y (max y (breadth element)))))
y)
You could also use reduce for this:
(defun breadth (l)
(if (listp l)
(reduce #'max l
:key #'breadth
:initial-value (length l))
0))
L is not a local variable, so the function will return the last value assigned to it (ie, the breadth of the last subtree).
Use LET to declare a local variable:
(LET ((l y))
...
)
Isn't the correct answer 6? Since e and j in your example are also technically child nodes? If that's how you're defining your problem, the following solution should get you there:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+ (max-breadth (car lst)) (max-breadth (cdr lst))))))
version 2:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+
(max-breadth (car lst))
(max-breadth (remove-if-not #'consp (cdr lst)))))))

How do I take a slice of a list (A sublist) in scheme?

Given a list, how would I select a new list, containing a slice of the original list (Given offset and number of elements) ?
EDIT:
Good suggestions so far. Isn't there something specified in one of the SRFI's? This appears to be a very fundamental thing, so I'm surprised that I need to implement it in user-land.
Strangely, slice is not provided with SRFI-1 but you can make it shorter by using SRFI-1's take and drop:
(define (slice l offset n)
(take (drop l offset) n))
I thought that one of the extensions I've used with Scheme, like the PLT Scheme library or Swindle, would have this built-in, but it doesn't seem to be the case. It's not even defined in the new R6RS libraries.
The following code will do what you want:
(define get-n-items
(lambda (lst num)
(if (> num 0)
(cons (car lst) (get-n-items (cdr lst) (- num 1)))
'()))) ;'
(define slice
(lambda (lst start count)
(if (> start 1)
(slice (cdr lst) (- start 1) count)
(get-n-items lst count))))
Example:
> (define l '(2 3 4 5 6 7 8 9)) ;'
()
> l
(2 3 4 5 6 7 8 9)
> (slice l 2 4)
(3 4 5 6)
>
You can try this function:
subseq sequence start &optional end
The start parameter is your offset. The end parameter can be easily turned into the number of elements to grab by simply adding start + number-of-elements.
A small bonus is that subseq works on all sequences, this includes not only lists but also string and vectors.
Edit: It seems that not all lisp implementations have subseq, though it will do the job just fine if you have it.
(define (sublist list start number)
(cond ((> start 0) (sublist (cdr list) (- start 1) number))
((> number 0) (cons (car list)
(sublist (cdr list) 0 (- number 1))))
(else '())))
Try something like this:
(define (slice l offset length)
(if (null? l)
l
(if (> offset 0)
(slice (cdr l) (- offset 1) length)
(if (> length 0)
(cons (car l) (slice (cdr l) 0 (- length 1)))
'()))))
Here's my implementation of slice that uses a proper tail call
(define (slice a b xs (ys null))
(cond ((> a 0) (slice (- a 1) b (cdr xs) ys))
((> b 0) (slice a (- b 1) (cdr xs) (cons (car xs) ys)))
(else (reverse ys))))
(slice 0 3 '(A B C D E F G)) ;=> '(A B C)
(slice 2 4 '(A B C D E F G)) ;=> '(C D E F)