Print adjacent duplicates of a list (scheme) - scheme

I'm trying to create a function that returns the adjacent duplicates of a list, for example (dups '(1 2 1 1 1 4 4) should return the list (1 4).
This is the code I came up with so far:
(define (dups lst)
(if (equal? (car lst)(car(cdr lst)))
(cons(cdr lst) '())
(dups(cdr lst))))
This function doesn't return all the adjacent duplicates, it only returns the first adjacent duplicates!
How can I fix it so that it returns all the adjacent duplicates of a list?
Thank you.

Once your code finds a duplicate, it stops processing the rest of the list: when the if test is true, it yields (cons (cdr lst) '()). Whether or not it finds a duplicate, it should still be calling dups to process the rest of the list.
Also: if your list has no duplicates, it it going to run into trouble.
Here's a simpler solution than the others posted:
(define (dups lst)
(if (< (length lst) 2)
; No room for duplicates
'()
; Check for duplicate at start
(if (equal? (car lst) (cadr lst))
; Starts w/ a duplicate
(if (or (null? (cddr lst)) ; end of list
(not (equal? (car lst) (caddr lst)))) ; non-matching symbol next
; End of run of duplicates; add to front of what we find next
(cons (car lst) (dups (cdr lst)))
; Othersise keep looking
(dups (cdr lst)))
; No duplicate at start; keep looking
(dups (cdr lst)))))

Basically this boils down to only keeping the elements which are the same as the previous one, but different from the next.
Here's an example implementation using a named let.
(define (adj-dups lst)
(let loop ((lst (reverse (cons (gensym) lst)))
(e-2 (gensym))
(e-1 (gensym))
(acc '()))
(if (null? lst)
acc
(let ((e-0 (car lst)))
(loop (cdr lst)
e-1
e-0
(if (and (eqv? e-2 e-1) (not (eqv? e-1 e-0)))
(cons e-1 acc)
acc))))))
(gensym) comes in handy here because it's a convenient way to initialise the working variables with something that's different from everything else, and filling up the initial list with a dummy element that needs to be added so that we don't miss the last element.
Testing:
> (adj-dups '())
'()
> (adj-dups '(1 1 4 4 1 1))
'(1 4 1)
> (adj-dups '(1 1 1 1 1))
'(1)
> (adj-dups '(1 2 1 1 1 4 4))
'(1 4)
> (adj-dups '(2 3 3 4 4 4 5))
'(3 4)

The most straightforward way I can think of to tackle this is with an internal procedure with an extra variable to keep track what the prior element was and a boolean to track if the element was repeated. You can then do a mutual recurstion between the helper and main function to build the answer one duplicate element at a time.
(define (dups lst)
(define (dups-helper x repeat? L)
(cond ((null? L)
(if repeat?
(list x)
'()))
((equal? x (car L))
(dups-helper x #t (cdr L)))
(else
(if repeat?
(cons x (dups L))
(dups L)))))
(if (null? lst)
'()
(dups-helper (car lst) #f (cdr lst))))
(dups (list 1 1 4 4 5 6 3 3 1))
;Value 43: (1 4 3)

Related

How to find if a list consists of ordered perfect squares in scheme?

I want to return true if the list is a square list, that is, true if the list is of the type '(0 1 4 9 16).
This is what I have (below) but it does check if the list is ordered. That is, my code will return true if a list is '(4 0 1 9 16). How can I modify my code?
(define (squares? lst)
(cond
((null? lst) #t)
((not( integer? (sqrt(car lst)))) #f)
(else (squares? (cdr lst)))))
for a list of the type '(4 0 1 9 16) I am going to obtain true with the above code, but the answer should be false, because my list is not '(0 1 4 9 16). Thanks in advance.
In the true spirit of functional programming, you should attempt to split the problem in smaller parts, and to reuse and combine existing procedures.
Assuming that the list doesn't need to be "complete", we just need to create and invoke one extra procedure that checks if the list is sorted:
(define (square? lst)
(and (all-squares? lst)
(sorted? lst)))
(define (all-squares? lst)
(cond
((null? lst) #t)
((not (integer? (sqrt (car lst)))) #f)
(else (all-squares? (cdr lst)))))
(define (sorted? lst)
(apply <= lst))
Just for fun, we can also rewrite all-squares? taking advantage of existing procedures:
(define (square? lst)
(and (andmap (compose integer? sqrt) lst)
(apply <= lst)))
Anyway, it'll work as expected with either implementation:
(square? '(0 1 4 9 16))
=> #t
(square? '(4 0 1 9 16))
=> #f
You could pass additionally last checked number
(define (squares? lst last-n)
and then check if (car lst) is bigger than last-n
((not (< last-n (car lst)) #f)
Oh, and also, don't forget to pass new last-n to squares?
(else (squares? (cdr lst) (car lst)))
You can define last-n as optional parameter, ie (define (squares? lst . last-n)) but then you have to access value by (car last-n), because all optional parameters are passed joined together as a list.

Splitting a list recursively in Scheme

What I want to do is define a list such as (define lst '(1 2 3 4 5 6)) and then call (split lst) which will return '((1 3 5) (2 4 6)).
Some examples:
When lst is '(1 2 3 4 5 6) it should return '((1 3 5) (2 4 6))
When lst is '(1 2 3 4 5 6 7) it should return '((1 3 5 7) (2 4 6))
When lst is '("a" "little" "bit" "of" "that" "to" "spice" "things" "up") it should return '(("a" "bit" "that" "spice" "up") ("little" "of" "to" "things"))
It should alternate when building the two lists. So the first index should go in the first list, second index in the second list, third index in the first list, etc.
Here is my current script.
(define (split lst)
(cond ((null? lst) lst)
((null? (cdr lst)) lst)
((cons (cons (car lst) (split (cddr lst))) (cons (cadr lst) (split (cddr lst)))))))
Currently, this is what outputs when I split the list '(1 2 3 4 5 6)
((1 (3 (5) 6) 4 (5) 6) 2 (3 (5) 6) 4 (5) 6)
Lets fix your code step by step:
(define (split lst)
(cond ((null? lst) lst)
((null? (cdr lst)) lst)
((cons (cons (car lst) (split (cddr lst))) (cons (cadr lst) (split (cddr lst)))))))
The first thing I notice is the lack of an else in the last case of the cond. Conds are supposed to look like:
(cond (question-1 answer-1)
(question-2 answer-2)
...
(else else-answer))
With an else inserted your code looks like this:
(define (split lst)
(cond ((null? lst) lst)
((null? (cdr lst)) lst)
(else
(cons (cons (car lst) (split (cddr lst))) (cons (cadr lst) (split (cddr lst)))))))
The next thing is the first base case, or the answer to the (null? lst) cond question. On an empty list what should it return?
It seems like no matter how long the list is, it should always return a list of exactly two inner lists. So when lst is empty the logical answer would be (list '() '()).
(define (split lst)
(cond ((null? lst)
(list '() '()))
((null? (cdr lst)) lst)
(else
(cons (cons (car lst) (split (cddr lst))) (cons (cadr lst) (split (cddr lst)))))))
Next is the second base case, the answer to the (null? (cdr lst)) cond question. Again it should return a list of exactly two inner lists:
(list ??? ???)
The the first index should go in the first list, and then there's nothing to go in the second list.
(list (list (car lst)) '())
In the context of your code:
(define (split lst)
(cond ((null? lst)
(list '() '()))
((null? (cdr lst))
(list (list (car lst)) '()))
(else
(cons (cons (car lst) (split (cddr lst))) (cons (cadr lst) (split (cddr lst)))))))
Now, what is the behavior of this function?
> (split '(1 2 3 4 5 6))
'((1 (3 (5 () ()) 6 () ()) 4 (5 () ()) 6 () ()) 2 (3 (5 () ()) 6 () ()) 4 (5 () ()) 6 () ())
Still not what you want. So what is the last case, recursive case, supposed to do?
Consider what you're "given" and what you need to "produce".
Given:
(car lst) the first element
(cadr lst) the second element
(split (cddr lst)) a list of exactly two inner lists
You should produce:
(list ??? ???)
Where the first ??? hole contains the first element and the first of the two inner lists, and the second ??? hole contains the second element and the second of the two inner lists.
This suggests code like this:
(list (cons (car lst) (first (split (cddr lst))))
(cons (cadr lst) (second (split (cddr lst)))))
Or, since car gets the first and cadr gets the second:
(list (cons (car lst) (car (split (cddr lst))))
(cons (cadr lst) (cadr (split (cddr lst)))))
In the context of your code:
(define (split lst)
(cond ((null? lst)
(list '() '()))
((null? (cdr lst))
(list (list (car lst)) '()))
(else
(list (cons (car lst) (car (split (cddr lst))))
(cons (cadr lst) (cadr (split (cddr lst))))))))
Using it produces what you want:
> (split '(1 2 3 4 5 6))
'((1 3 5) (2 4 6))
> (split '(1 2 3 4 5 6 7))
'((1 3 5 7) (2 4 6))
> (split '("a" "little" "bit" "of" "that" "to" "spice" "things" "up"))
'(("a" "bit" "that" "spice" "up") ("little" "of" "to" "things"))
Now what was the difference between this and what you had before?
Your code before:
(cons (cons (car lst) (split (cddr lst)))
(cons (cadr lst) (split (cddr lst))))
The fixed version:
(list (cons (car lst) (car (split (cddr lst))))
(cons (cadr lst) (cadr (split (cddr lst)))))
The first difference is that your original version uses cons on the outside, while the fixed version uses list instead. This is because (list ??? ???) always returns a list of exactly two elements, while (cons ??? ???) can return a list of any size greater than 1, which has the first thing merged onto an existing second list. (list ??? ???) is what you want here because you specified that it should return a list of exactly two inner lists.
The second difference is in how you use the recursive call (split (cddr lst)).
This has to do with how you interpreted the "given" part of the recursive case. You had assumed that the first call to split would give you the first "inner" list, and the second call to split would give you the second "inner" list. In fact it gives you a list of both of those both times. So for the first one you have to get the "first" or car of it, and for the second one you have get the "second" or cadr of it.
Looks like this might be what you're looking for:
(define (split lst)
(define (loop lst do-odd odds evens)
(if (null? lst)
(list (reverse odds) (reverse evens))
(loop (cdr lst) (not do-odd)
(if do-odd (cons (car lst) odds) odds)
(if (not do-odd) (cons (car lst) evens) evens))))
(loop lst #t '() '()))
In use:
1 ]=> (split '(1 2 3 4 5 6))
;Value 2: ((1 3 5) (2 4 6))
1 ]=> (split '(1 2 3 4 5 6 7))
;Value 3: ((1 3 5 7) (2 4 6))
This uses the variable do-odd in the inner loop function (which is tail-recursive, by the way, so it is fast!) to figure out which list it should add the (car lst) to.
Downsides to this function: the call to reverse in the base case can be expensive if your lists are very long. This may or may not be a problem. Profiling your code will tell you if it's a bottleneck.
UPDATE: You can also use the function reverse!, which destructively modifies the array in question. I did some informal profiling, and it didn't seem to make that much of a difference speed-wise. You will have to test this under your specific circumstances.
Now, if this isn't intended to be performant, use whatever you want! :)
My shortest solution
(define (split l)
(cond ((null? l) '(() ()))
((null? (cdr l)) (list (list (car l)) '()))
(else (map cons (list (car l) (cadr l))
(split (cddr l))))))
Similar but wordier solution
Ensure that split always returns a list of two lists.
Then you can define it quite compactly:
(define (split l)
(cond ((null? l) '(() ()))
((null? (cdr l)) (list (list (car l)) '()))
(else (double-cons (list (car l) (cadr l))
(split (cddr l))))))
with double-cons being:
(define (double-cons l lol)
(list (cons (car l) (car lol))
(cons (cadr l) (cadr lol))))
double-cons:
(double-cons '(a 1) '((b c) (2 3)))
; => '((a b c) (1 2 3))
Other double-cons definitions
This takes more lines but makes it easier to read:
(define (double-cons l lol)
(let ((e1 (car l))
(e2 (cadr l))
(l1 (car lol))
(l2 (cadr lol)))
(list (cons e1 l1) (cons e2 l2))))
Or a double-cons which conses even more elements and lists in parallel:
(define (parallel-cons l lol)
(map cons l lol))
; it is `variadic` and conses as many elements with their lists
; as you want:
(parallel-cons '(1 a A '(a)) '((2 3) (b c d e) (B C) ((b) (c))))
; '((1 2 3) (a b c d e) (A B C) ('(a) (b) (c)))
; this combination of `map` and `cons` is used in the shortest solution above.

How to work around cdr not understanding the empty list?

My problem is the butSecondLastAtom algorithm. It doesn't work because cdr doesn't comprehend an empty list. But I see no other way of writing the algorithm. It's at the end of the page. Everything works but when the last element of a list is a list.
http://lpaste.net/110959
The problem is in the recursive call of (cdr (cdr l)) but more in the 3rd condition. Idk what to do. I'm just going to stop tonight and start fresh in the morning.
((and (isAtom (second_last_element l)) (notAtom (last_element l)))
(cons
(car l)
(butSecondLastAtom (last_element l))))
I think the main problem in your code is the use of null? or cdr on the cdr of a list, both in flatten and in butLast. Don't do this; always use the procedures and predicates on the list itself.
I'd suggest the following:
Flattening the list
Most Schemes have a version of flatten build-in, which takes care of nested lists and improper lists. The version you implemented is not entirely correct (try (flatten '())), use this one:
(define (flatten lst)
(let loop ((lst lst) (res null))
(cond
((null? lst) res)
((pair? lst) (loop (car lst) (loop (cdr lst) res)))
(else (cons lst res)))))
> (flatten '(1 2 (3 (4 5 6))))
'(1 2 3 4 5 6)
> (flatten '(1 2 (3 (4 5 (6)))))
'(1 2 3 4 5 6)
> (flatten '())
'()
Dropping the second last element
So this becomes much easier now, looping through a simple flat proper list while keeping track of the last (n-1) and second-last (n-2) element. An example implementation is:
(define (butSecondLastAtom lst)
(define flst (flatten lst))
(if (< (length flst) 2)
flst
(let loop ((flst (cddr flst)) (n-2 (car flst)) (n-1 (cadr flst)) (res null))
(if (null? flst)
(reverse (cons n-1 res)) ; here we drop the second-last element
(loop (cdr flst) n-1 (car flst) (cons n-2 res))))))
If you want to avoid going through the list twice (once for length, once for the loop), you can also keep track of the length yourself:
(define (butSecondLastAtom lst)
(define flst (flatten lst))
(let loop ((lst flst) (len 0) (n-2 #f) (n-1 #f) (res null))
(if (null? lst)
(if (< len 2)
flst
(reverse (cons n-1 res))) ; here we drop the second-last element
(loop (cdr lst) (add1 len) n-1 (car lst) (if (< len 2) null (cons n-2 res))))))
Testing
> (butSecondLastAtom '(1 2 (3 (4 5 6))))
'(1 2 3 4 6)
> (butSecondLastAtom '(1 2 (3 (4 5 (6)))))
'(1 2 3 4 6)
> (butSecondLastAtom '(((a))))
'(a)
> (butSecondLastAtom '())
'()

Bubble Sorting with Scheme

I'm working on implementing a bubble sorting algorithm in Scheme, and I must say that the functional way of programming is a strange concept and I am struggling a bit to grasp it.
I've successfully created a function that will bubble up the first largest value we come across, but that's about all it does.
(bubbleH '(5 10 9 8 7))
(5 9 8 7 10)
I am struggling with the helper function that is required to completely loop through the list until no swaps have been made.
Here's where I am at so far, obviously it is not correct but I think I am on the right track. I know that I could pass in the number of elements in the list myself, but I am looking for a solution different from that.
(define bubbaS
(lambda (lst)
(cond (( = (length lst) 1) (bubba-help lst))
(else (bubbaS (bubba-help lst))))))
Using the bubble-up and bubble-sort-aux implementations in the possible-duplicate SO question I referenced...
(define (bubble-up L)
(if (null? (cdr L))
L
(if (< (car L) (cadr L))
(cons (car L) (bubble-up (cdr L)))
(cons (cadr L) (bubble-up (cons (car L) (cddr L)))))))
(define (bubble-sort-aux N L)
(cond ((= N 1) (bubble-up L))
(else (bubble-sort-aux (- N 1) (bubble-up L)))))
..., this is simple syntactic sugar:
(define (bubbleH L)
(bubble-sort-aux (length L) L))
With the final bit of syntactic sugar added, you should get exactly what you specified in your question:
(bubbleH '(5 10 9 8 7))
=> (5 7 8 9 10)
You can tinker with everything above in a repl.it session I saved & shared.
Here's my own tail-recursive version.
The inner function will bubble up the largest number just like your bubbleH procedure. But instead of returning a complete list, it will return 2 values:
the unsorted 'rest' list
the largest value that has bubbled up
such as:
> (bsort-inner '(5 1 4 2 8))
'(5 2 4 1)
8
> (bsort-inner '(1 5 4 2 8))
'(5 2 4 1)
8
> (bsort-inner '(4 8 2 5))
'(5 2 4)
8
Now the outer loop just has to cons the second value returned, and iterate on the remaining list.
Code:
(define (bsort-inner lst)
(let loop ((lst lst) (res null))
(let ((ca1 (car lst)) (cd1 (cdr lst)))
(if (null? cd1)
(values res ca1)
(let ((ca2 (car cd1)) (cd2 (cdr cd1)))
(if (<= ca1 ca2)
(loop cd1 (cons ca1 res))
(loop (cons ca1 cd2) (cons ca2 res))))))))
(define (bsort lst)
(let loop ((lst lst) (res null))
(if (null? lst)
res
(let-values (((ls mx) (bsort-inner lst)))
(loop ls (cons mx res))))))
For a recursive version, I prefer one where the smallest value bubbles in front:
(define (bsort-inner lst)
; after one pass, smallest element is in front
(let ((ca1 (car lst)) (cd1 (cdr lst)))
(if (null? cd1)
lst ; just one element => sorted
(let ((cd (bsort-inner cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(define (bsort lst)
(if (null? lst)
null
(let ((s (bsort-inner lst)))
(cons (car s) (bsort (cdr s))))))

Scheme write a function that returns number of odd numbers in a list

I'm having trouble writing a function in Scheme that returns the number of odd numbers in a list without using any assignment statements. I'm trying to use the predicate odd? as well. Any help/tips would be appreciated.
Ex: (odds '(1 2 3 4 5) // returns 3
Also, the list is of integers
Well, if no assignment statements can be used, you can still use the built-in procedures for this. In particular, count will work nicely in Racket:
(define (odds lst)
(count odd? lst))
... But I'm guessing that you're supposed to implement the solution from scratch. Some hints for finding the solution on your own, fill-in the blanks:
(define (odds lst)
(cond (<???> ; if the list is empty
<???>) ; then how many odd numbers are in it?
((odd? <???>) ; if the first element is odd
(<???> (odds <???>))) ; then add one and advance recursion
(else ; otherwise
(odds <???>)))) ; just advance the recursion
Anyway, it works as expected:
(odds '(1 2 3 4 5))
=> 3
Regardless if you use (R6RS?) Scheme or Racket, this will work for both:
(define (odds lst)
(length (filter odd? lst)))
(define l '(1 2 3 4 5 6 7 8 9 10))
(odds l)
As low level as I can get it :
(define odds
(lambda (lst)
(cond ((empty? lst) 0)
((not (= 0 (modulo (car lst) 2))) (+ 1 (odds (rest lst))))
(else (odds (cdr lst))))))
Here's another one-liner
(define (odds L)
(reduce + 0 (map (lambda (x) (if (odd? x) 1 0)) L)))
Here is a function that returns a function that counts anything based on a predicate:
(define (counter-for predicate)
(define (counting list)
(if (null? list)
0
(+ (if (predicate (car list)) 1 0)
(counting (cdr list)))))
counting))
which is used like:
(define odds (counter-for odd?))
[MORE OPTIONS] Here is a nice recursive solution
(define (odds list)
(if (null? list)
0
(+ (if (odd? (car list)) 1 0)
(odds (cdr list)))))
here is a tail recursive solution:
(define (odds list)
(let odding ((list list) (count 0)))
(if (null? list)
count
(odding (cdr list)
(+ count (if (odd? (car list)) 1 0))))))
Here is a routine that counts anything based on a predicate:
(define (count-if predicate list)
(if (null? list)
0
(+ (if (predicate (car list)) 1 0)
(count-if predicate (cdr list)))))

Resources