Scheme Function that can select nth term of a list - lisp

So here i have a couple of defined list that i would like to use:
(DEFINE list0 (LIST 'j 'k 'l 'm 'n 'o 'j) )
(DEFINE list1 (LIST 'a 'b 'c 'd 'e 'f 'g) )
(DEFINE list2 (LIST 's 't 'u 'v 'w 'x 'y 'z) )
(DEFINE list3 (LIST 'j 'k 'l 'm 'l 'k 'j) )
(DEFINE list4 (LIST 'n 'o 'p 'q 'q 'p 'o 'n) )
(DEFINE list5 '( (a b) c (d e d) c (a b) ) )
(DEFINE list6 '( (h i) (j k) l (m n) ) )
(DEFINE list7 (f (a b) c (d e d) (b a) f) )
what i would like to do is create a recursive function for a 'middle' function that would do as such:
MIDDLE:
(middle 1st) should return a one-element list consisting of just the middle element of the 1st [or return the empty list if there were an even number of elements in 1st]. That is,
(middle '(a b c d e f g) )
should/would return:
(d)
(middle '(s t u v w x y z) )
should/would return the empty string.
(middle '( (a b) c (d e d) c (b a) ) )
should/would return:
( (d e d) )
Note that ( (d e d) ) is a list containing the thing that was in the middle, which happened to itself be a list.
I think that i have to break it into two problems.
First is that i need a function that can select the nth term of a list. which i little knowledge on creating it.
Second you need a functions to determine the position of the middle term and if there exists a middle term. (which also i have minimum knowledge on how to create it.
Then
(define middle
(lambda (L)
(if (middle? L)
(nth-term (middle L) L)
'())))
Here is my evens function that i would like to know if there might be an easier way to go about it:
(define evens
(lambda (L)
(if (or (NULL? (cddr L)))
'()
(cons (cadr L) (evens (cddr L))))))

The easiest way to do this is to use the length function to get the length of the list, then make sure the length is an not an even number (and if it is, to return an empty list). Once we know that the length is odd, return the element of the list that is half the length of the list minus one. The result is the middle of the list. Here is what the code actually looks like:
(define (middle lis)
(let ((list-length (length lis)))
(if (even? list-length)
'()
(list (list-ref lis (/ (- list-length 1) 2))))))
To answer the question in your subject line, you get the nth item of a list with the list-ref procedure, like so:
> (list-ref '(a b c d) 2)
'c
If there's anything you are still confused about, let me know and I'll do my best to clarify.

The answer can be improved a bit as follows:
(define (middle lst)
(let ((len (length lst)))
(if (even? len)
'()
(list (list-ref lst (quotient len 2))))))
Notice that there was a simpler way to obtain the index of the middle element.

The obvious method (compute the length; divide by two; seek through the list) requires two passes through the list.
Here is an alternative that requires only one pass:
(define (middle lst)
(letrec
((middle-odd
(lambda (x y) (if (null? x) (list (car y)) (middle-even (cdr x) (cdr y)))))
(middle-even
(lambda (x y) (if (null? x) '() (middle-odd (cdr x) y)))))
(middle-even lst lst)))

Related

LISP function to make all possible pairs from a list?

I'm trying to create a LISP function that creates from a list all possible pairs.
Example of what I'm trying to achieve: (a b c d) --> ((a b) (a c) (a d) (b c) (b d) (c d))
Any advice please? I'm not sure how to approach this problem
Here is a simple solution:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(loop for y in l collect (list x y)))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(loop for (x . y) on l nconc (make-couples x y)))
A recursive solution is:
(defun make-couples (x l)
"makes a list of couples whose first element is x and the second is each element of l in turn"
(if (null l)
nil
(cons (cons x (first l)) (make-couples x (rest l)))))
(defun all-pairs (l)
"makes a list of all the possible pairs of elements of list l"
(if (null l)
nil
(nconc (make-couples (first l) (rest l))
(all-pairs (rest l)))))
Here is a version (this is quite closely related to Gwang-Jin Kim's) which has two nice properties:
it is tail recursive;
it walks no list more than once;
it allocates no storage that it does not use (so there are no calls to append and so on);
it uses no destructive operations.
It does this by noticing that there's a stage in the process where you want to say 'prepend a list of pairs of this element with the elements of this list to this other list' and that this can be done without using append or anything like that.
It does return the results in 'reversed' order, which I believe is inevitable given the above constraints.
(defun all-pairs (l)
(all-pairs-loop l '()))
(defun all-pairs-loop (l results)
(if (null (rest l))
results
(all-pairs-loop (rest l)
(prepend-pairs-to (first l) (rest l) results))))
(defun prepend-pairs-to (e them results)
(if (null them)
results
(prepend-pairs-to e (rest them) (cons (list e (first them))
results))))
the simplest tail recursive variant without explicit loops / mapcar could also look like this:
(defun pairs (data)
(labels ((rec (ls a bs res)
(cond
((null ls) (nreverse res))
((null bs) (rec
(cdr ls)
(car ls)
(cdr ls)
res))
(t (rec
ls
a
(cdr bs)
(cons (cons a (car bs)) res))))))
(rec data nil nil nil)))
CL-USER> (pairs (list 1 2 3 4))
;; ((1 . 2) (1 . 3) (1 . 4) (2 . 3) (2 . 4) (3 . 4))
Tail call recursive solution:
(defun pairs (lst &key (acc '()))
(if (null (cdr lst))
(nreverse acc)
(pairs (cdr lst)
:acc (append (nreverse
(mapcar #'(lambda (el)
(list (car lst) el))
(cdr lst)))
acc))))
Both nreverses are there just for aesthetics (for a nicer looking output). They can be left out.
Try it with:
(pairs '(a b c d))
;; => ((A B) (A C) (A D) (B C) (B D) (C D))
General Combinations
(defun pair (el lst)
"Pair el with each element of lst."
(mapcar (lambda (x) (cons el x)) lst))
(defun dedup (lst &key (test #'eql))
"Deduplicate a list of lists by ignoring order
and comparing the elements by test function."
(remove-duplicates lst :test (lambda (x y) (null (set-difference x y :test test)))))
(defun comb (lst &key (k 3) (acc '()) (test #'eql))
"Return all unique k-mer combinations of the elements in lst."
(labels ((%comb (lst &key (k k) (acc '()) (test #'eql) (total lst))
(let ((total (if total total lst)))
(cond ((or (null (cdr lst)) (zerop k)) (nreverse acc))
((= k 1) (mapcar #'list lst))
(t (let* ((el (car lst))
(rst (remove-if (lambda (x) (funcall test x el)) total)))
(dedup (%comb (cdr lst)
:k k
:total total
:test test
:acc (append (pair el (comb rst :k (1- k) :test test))
acc)))))))))
(%comb lst :k k :acc acc :test test :total lst)))
The number of combinations are calculatable with the combinations formula:
(defun fac (n &key (acc 1) (stop 1))
"n!/stop!"
(if (or (= n stop) (zerop n))
acc
(fac (1- n) :acc (* acc n) :stop stop)))
(defun cnr (n r)
"Number of all r-mer combinations given n elements.
nCr with n and r given"
(/ (fac n :stop r) (fac (- n r))))
We can test and count:
(comb '(a b c d) :k 2)
;; => ((A D) (B D) (B A) (C D) (C B) (C A))
(comb '(a b c d e f) :k 3)
;; => ((B A F) (C B A) (C B F) (C A F) (D C A) (D C B)
;; => (D C F) (D B A) (D B F) (D A F) (E D A) (E D B)
;; => (E D C) (E D F) (E C A) (E C B) (E C F) (E B A)
;; => (E B F) (E A F))
(= (length (comb '(a b c d e f) :k 3)) (cnr 6 3)) ;; => T
(= (length (comb '(a b c d e f g h i) :k 6)) (cnr 9 6)) ;; => T

A list with their position via for loop in racket

(define ( addposition x )
(cond
[(empty? x) "empty list"]
[#t (for/list ([i x])
(list i (add1 (index-of x i))))]
))
(addposition (list 'a 'b 'c ))
it returns me '((a 1) (b 2) (c 3)), but I need the list like '(a 1 b 2 c 3)
As a bare minimum to get what you want you can throw that nested list to a (flatten) call:
> (flatten '((a 1) (b 2) (c 3)))
'(a 1 b 2 c 3)
But overall the idea to build mini lists with index-of and then flattening it is not the most performant. Nor will it be correct if your list contains duplicate values.
If we keep our own record of the next index, and using recursion instead of the otherwise handy for/list structure, we can build our list this way:
(define (add-positions xs [ind 0])
(if (null? xs)
xs
(append (list (first xs) ind)
(add-positions (rest xs) (add1 ind))
)))
(add-positions '(a b c d))
;=> '(a 0 b 1 c 2 d 3)
This can be expressed pretty naturally using map and flatten:
;;; Using map and flatten:
(define (list-pos xs (start 0))
(flatten (map (lambda (x y) (list x y))
xs
(range start (+ start (length xs))))))
Here map creates a list of lists, each containing one value from the input list and one value from a range list starting from start, and flatten flattens the result.
This seems more natural to me than the equivalent using for/list, but tastes may differ:
;;; Using for/list:
(define (list-pos xs (start 0))
(flatten (for/list ((x xs)
(p (range start (+ start (length xs)))))
(list x p))))
There are a lot of ways that you could write this, but I would avoid using append in loops. This is an expensive function, and calling append repeatedly in a loop is just creating unnecessary overhead. You could do this:
;;; Using Racket default arguments and add1:
(define (list-pos xs (pos 0))
(if (null? xs)
xs
(cons (car xs)
(cons pos (list-pos (cdr xs) (add1 pos))))))
Here the first element of the list and a position counter are added onto the front of the result with every recursive call. This isn't tail recursive, so you might want to add an accumulator:
;;; Tail-recursive version using inner define:
(define (list-pos xs (start 0))
(define (loop xs pos acc)
(if (null? xs)
(reverse acc)
(loop (cdr xs)
(add1 pos)
(cons pos
(cons (car xs) acc)))))
(loop xs start '()))
Because the intermediate results are collected in an accumulator, reverse is needed to get the final result in the right order.
You could (and I would) replace the inner define with a named let. Named let should work in Racket or Scheme; here is a Scheme version. Note that Scheme does not have default arguments, so an optional argument is used for start:
;;; Tail-recursive Scheme version using named let:
(define (list-pos xs . start)
(let loop ((xs xs)
(pos (if (null? start) 0 (car start)))
(acc '()))
(if (null? xs)
(reverse acc)
(loop (cdr xs)
(add1 pos)
(cons pos
(cons (car xs) acc))))))
All of the above versions have the same behavior:
list-pos.rkt> (list-pos '(a b c))
'(a 0 b 1 c 2)
list-pos.rkt> (list-pos '(a b c) 1)
'(a 1 b 2 c 3)
Here is a simple solution using for/fold
(define (addposition l)
(for/fold ([accum empty]) ([elem l])
(append accum elem)))
I love the for loops in Racket 😌
Note: As pointed out by ad absurdum, append is expensive here. So we can simply reverse first and then use cons to accumulate
(define (addposition l)
(for/fold ([accum empty]) ([elem (reverse l)])
(cons (first elem) (cons (second elem) accum))))
As others have pointed out, you can start by making a list of lists. Let's use a list comprehension:
> (for/list ([x '(a b c)]
[pos (in-naturals 1)])
(list x pos))
'((a 1) (b 2) (c 3))
Here, we iterate in parallel over two sets of data:
The list '(a b c)
The stream (in-naturals 1), which produces 1, 2, 3, ....
We combine them into lists with list, giving this structure:
'((a 1) (b 2) (c 3))
This is called "zipping", and using list comprehensions is a convenient way to do it in Racket.
Next, we want to flatten our list, so it ends up looking like this:
'(a 1 b 2 c 3)
However, you shouldn't use flatten for this, as it flattens not just the outermost list, but any sub-lists as well. Imagine if we had data like this, with a nested list in the middle:
> (flatten
(for/list ([x '(a (b c d) e)]
[pos (in-naturals 1)])
(list x pos)))
'(a 1 b c d 2 e 3)
The nested list structure got clobbered! We don't want that. Unless we have a good reason, we should preserve the internal structure of each element in the list we're given. We'll do this by using append* instead, which flattens only the outermost list:
> (append*
(for/list ([x '(a (b c d) e)]
[pos (in-naturals 1)])
(list x pos)))
'(a 1 (b c d) 2 e 3)
Now that we've got it working, let's put it into a function:
> (define (addposition xs)
(append*
(for/list ([x xs]
[pos (in-naturals 1)])
(list x pos))))
> (addposition '(a b c))
'(a 1 b 2 c 3)
> (addposition '(a (b c d) e))
'(a 1 (b c d) 2 e 3)
Looks good!

Difference between '(()) and (cons null null)

I am confused about the difference between '(()) and (cons null null) in scheme.
The code below show that b and c are completely the same thing.
(define (dup2 x)
(let ((d '(())))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup2 a))
(define c (dup2 a))
(set-car! b 2)
> c ;; --> (2 2)
However, when I used dup instead of dup2:
(define (dup x)
(let ((d (cons null null)))
(set-car! d (car x))
(set-cdr! d (cdr x))
d))
(define a '(1 2))
(define b (dup a))
(define c (dup a))
(set-car! b 2)
> c ;; --> (1 2)
Variable b and c are different. I have done some experiments, but I haven't understand yet.
The value of d in the first implementation is literal data, and is modified with undefined consequences. To highlight what's happening, consider the following code:
(define (incorrect-list-null-and-x x)
(let ((l '(()))) ; a list of the form (() . ())
(set-cdr! l (cons x (cdr l))) ; (cdr l) is (), so (cons x (cdr l)) should be (x . ()) == (x), right?
; and now l should be (() . (x . ())) == (() x), right?
l))
The expected result is that (incorrect-list-null-and-x n) should return a list of the form (() n), and it does the first time, but successive calls are still accessing the same data:
(incorrect-list-null-and-x 1) ;=> (() 1)
(incorrect-list-null-and-x 2) ;=> (() 2 1)
(incorrect-list-null-and-x 3) ;=> (() 3 2 1)
(incorrect-list-null-and-x 4) ;=> (() 4 3 2 1)
The same problem manifests itself a bit differently in your dup2. Every value returned from dup2 is actually the same pair:
(let* ((x (dup2 (cons 1 2)))
(y (dup2 (cons 3 4))))
(display x)
(display y))
outputs:
(3 . 4)(3 . 4)
because the call (dup2 (cons 3 4)) modifies the same structure that was previously returned by (dup2 (cons 1 2)).
Data literals, like '(()), are meant to be read-only, and modifying it using set-car! or set-cdr! has undefined behaviour. For predictable behaviour, use the (cons '() '()) version if you want to use set-car! or set-cdr! on it.
In particular, cons creates a new cons cell, whereas a data literal usually won't.
Still, for the purposes of implementing dup, why are you using set-car! and set-cdr! anyway? Just use cons directly:
(define (dup x)
(cons (car x) (cdr x)))
In your first code snippet you use (d '(())) which ends up binding a literal to d. You then modify the literal which is generally undefined. In your second code snippet you use (d (cons null null)) which binds d to a newly created 'cons cell' which you then modify. There is no problem modifying that.
Note: you've not defined null. Perhaps you meant '()?

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)

Count of atoms on the each level, Scheme

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.