List of lists to normal list in scheme - scheme

I'm trying to make a scheme function that returns a 'normal' list from a pair made by lists of lists.
I'm trying to change something like this:
((((((() 1) 2) 3) 4) (12 13 14)) ((((() 8) 9) 10) 11) (5 6 7))
into something like this:
(1 2 3 4 12 13 14 8 9 10 11 5 6 7)
I've tried using tail recursion, but my code just returns the same initial pair.
Then I did this, but it also doesn't work and kind of shuffles the list:
(define (tolist l1 lista)
(if (empty? (cdr lista))
null
(if (empty? (car lista))
(append l1 (cdr lista))
(tolist (append l1 (car lista)) (list (cdr lista)) ))))
What can I do?

Oscar Lopez has given you a good answer, although I would test l1 with list? rather than pair?, as with his code (flatten '(1 . 2)) would produce (1 2), which is probably not your desired result.
With that correction his code can be turned into a fold:
(define (flatten seq)
(letrec ((flatten-with-append
(lambda (elt acc) ;; args as for SRFI-1 fold
(if (list? elt)
(fold flatten-with-append acc elt)
(append acc (list elt))))))
(flatten-with-append seq '())))
One problem with this way of doing it is that it appends, which is not very efficient. It is usually better to cons into the accumulator and then reverse. This would be likely to be more optimal:
(define (flatten seq)
(letrec ((flatten-with-cons
(lambda (elt acc) ;; args as for SRFI-1 fold
(if (list? elt)
(fold flatten-with-cons acc elt)
(cons elt acc)))))
(reverse (flatten-with-cons seq '()))))

Related

Scheme: Split list into list of two sublists of even and odd positions

I'm trying to use direct recursion to sort a list into a list of sublists of even and odd positions.
So (split '(1 2 3 4 5 6)) returns ((1 3 5) (2 4 6))
and (split '(a 2 b 3)) returns ((a b) (2 3))
So far, I have the following code:
(define split
(lambda (ls)
(if (or (null? ls) (null? (cdr ls)))
(values ls '())
(call-with-values
(lambda () (split (cddr ls)))
(lambda (odds evens)
(values (cons (car ls) odds)
(cons (cadr ls) evens)))))))
However, now I'm stumped on how to store multiple outputs into a single list.
I know that calling it like this:
(call-with-values (lambda () (split '(a b c d e f))) list)
returns a list of sublists, however I would like the function itself to return a list of sublists. Is there a better way to do this that doesn't involve the use of values and call-with-values?
Sure. Here's an adapted version of your code:
(define (split ls)
(if (or (null? ls) (null? (cdr ls)))
(list ls '())
(let ((next (split (cddr ls))))
(list (cons (car ls) (car next))
(cons (cadr ls) (cadr next))))))
One thing that I like about the code in the question is that it uses odds and evens in a way that reflects the specification.
The objectives of this solution are:
Readability.
To reflect the language of the specification in the code.
To use O(n) space during execution.
It uses an internal function with accumulators and a trampoline.
#lang racket
;; List(Any) -> List(List(Any) List(Any))
(define (split list-of-x)
(define end-of-list (length list-of-x))
;; List(Any) List(Any) List(Any) Integer -> List(List(Any) List(Any))
(define (looper working-list odds evens index)
(cond [(> index end-of-list)
(list (reverse odds)
(reverse evens))]
[(odd? index)
(looper (rest working-list)
(cons (car working-list) odds)
evens
(add1 index))]
[(even? index)
(looper (rest working-list)
odds
(cons (car working-list) evens)
(add1 index))]
[else
(error "split: unhandled index condition")]))
(looper list-of-x null null 1))
Here's an answer that should be clear if you are familiar with match syntax. It is identical in form and function to Chris Jester-Young's answer, but uses match to clarify list manipulation.
#lang racket
(define (split ls)
(match ls
[`(,first ,second ,rest ...)
(match (split rest)
[`(,evens ,odds) (list (cons first evens)
(cons second odds))])]
[_ (list ls '())]))
(: split ((list-of natural) -> (list-of (list-of natural))))
(define split
(lambda (xs)
(list (filter even? xs) (filter odd? xs))))
(: filter ((%a -> boolean) (list-of %a) -> (list-of %a)))
(define filter
(lambda (p xs)
(fold empty (lambda (first result)
(if (p first)
(make-pair first result)
result)) xs)))
(check-expect (split (list 1 2 3 4 5 6)) (list (list 2 4 6) (list 1 3 5)))
i think this one is also really easy to understand..

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 '())
'()

how to write scheme function that takes two lists and return one list like this

how to implement this function
if get two list (a b c), (d e)
and return list (a+d b+d c+d a+e b+e c+e)
list element is all integer and result list's element order is free
I tried this like
(define (addlist L1 L2)
(define l1 (length L1))
(define l2 (length L2))
(let ((result '()))
(for ((i (in-range l1)))
(for ((j (in-range l2)))
(append result (list (+ (list-ref L1 i) (list-ref L2 j))))))))
but it return error because result is '()
I don't know how to solve this problem please help me
A data-transformational approach:
(a b c ...) (x y ...)
1. ==> ( ((a x) (b x) (c x) ...) ((a y) (b y) (c y) ...) ...)
2. ==> ( (a x) (b x) (c x) ... (a y) (b y) (c y) ... ...)
3. ==> ( (a+x) (b+x) ... )
(define (addlist L1 L2)
(map (lambda (r) (apply + r)) ; 3. sum the pairs up
(reduce append '() ; 2. concatenate the lists
(map (lambda (e2) ; 1. pair-up the elements
(map (lambda (e1)
(list e1 e2)) ; combine two elements with `list`
L1))
L2))))
testing (in MIT-Scheme):
(addlist '(1 2 3) '(10 20))
;Value 23: (11 12 13 21 22 23)
Can you simplify this so there's no separate step #3?
We can further separate out the different bits and pieces in play here, as
(define (bind L f) (join (map f L)))
(define (join L) (reduce append '() L))
(define yield list)
then,
(bind '(1 2 3) (lambda (x) (bind '(10 20) (lambda (y) (yield (+ x y))))))
;Value 13: (11 21 12 22 13 23)
(bind '(10 20) (lambda (x) (bind '(1 2 3) (lambda (y) (yield (+ x y))))))
;Value 14: (11 12 13 21 22 23)
Here you go:
(define (addlist L1 L2)
(for*/list ((i (in-list L1)) (j (in-list L2)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 21 12 22 13 23)
The trick is to use for/list (or for*/list in case of nested fors) , which will automatically do the append for you. Also, note that you can just iterate over the lists, no need to work with indexes.
To get the result "the other way round", invert L1 and L2:
(define (addlist L1 L2)
(for*/list ((i (in-list L2)) (j (in-list L1)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 12 13 21 22 23)
In scheme, it's not recommended using function like set! or append!.
because it cause data changed or Variable, not as Funcitonal Programming Style.
should like this:
(define (add-one-list val lst)
(if (null? lst) '()
(cons (list val (car lst)) (add-one-list val (cdr lst)))))
(define (add-list lst0 lst1)
(if (null? lst0) '()
(append (add-one-list (car lst0) lst1)
(add-list (cdr lst0) lst1))))
first understanding function add-one-list, it recursively call itself, and every time build val and fist element of lst to a list, and CONS/accumulate it as final answer.
add-list function just like add-one-list.
(define (addlist L1 L2)
(flatmap (lambda (x) (map (lambda (y) (+ x y)) L1)) L2))
(define (flatmap f L)
(if (null? L)
'()
(append (f (car L)) (flatmap f (cdr L)))))
1 ]=> (addlist '(1 2 3) '(10 20))
;Value 2: (11 12 13 21 22 23)
Going with Will and Procras on this one. If you're going to use scheme, might as well use idiomatic scheme.
Using for to build a list is a bit weird to me. (list comprehensions would fit better) For is usually used to induce sequential side effects. That and RSR5 does not define a for/list or for*/list.
Flatmap is a fairly common functional paradigm where you use append instead of cons to build a list to avoid nested and empty sublists
It doesn't work because functions like append don't mutate the containers. You could fix your problem with a mutating function like append!. Usually functions that mutate have a ! in their name like set! etc.
But it's possible to achieve that without doing mutation. You'd have to change your algorithm to send the result to your next iteration. Like this:
(let loop ((result '()))
(loop (append result '(1)))
As you can see, when loop will get called, result will be:
'()
'(1)
'(1 1)
'(1 1 1)
....
Following this logic you should be able to change your algorithm to use this method instead of for loop. You'll have to pass some more parameters to know when you have to exit and return result.
I'll try to add a more complete answer later today.
Here's an implementation of append! I just wrote:
(define (append! lst1 lst2)
(if (null? (cdr lst1))
(set-cdr! lst1 lst2)
(append! (cdr lst1) lst2)))

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))))))

reverse list - scheme

I'm trying to reverse a list, here's my code:
(define (reverse list)
(if (null? list)
list
(list (reverse (cdr list)) (car list))))
so if i enter (reverse '(1 2 3 4)), I want it to come out as (4 3 2 1), but right now it's not giving me that. What am I doing wrong and how can I fix it?
The natural way to recur over a list is not the best way to solve this problem. Using append, as suggested in the accepted answer pointed by #lancery, is not a good idea either - and anyway if you're learning your way in Scheme it's best if you try to implement the solution yourself, I'll show you what to do, but first a tip - don't use list as a parameter name, that's a built-in procedure and you'd be overwriting it. Use other name, say, lst.
It's simpler to reverse a list by means of a helper procedure that accumulates the result of consing each element at the head of the result, this will have the effect of reversing the list - incidentally, the helper procedure is tail-recursive. Here's the general idea, fill-in the blanks:
(define (reverse lst)
(<???> lst '())) ; call the helper procedure
(define (reverse-aux lst acc)
(if <???> ; if the list is empty
<???> ; return the accumulator
(reverse-aux <???> ; advance the recursion over the list
(cons <???> <???>)))) ; cons current element with accumulator
Of course, in real-life you wouldn't implement reverse from scratch, there's a built-in procedure for that.
Here is a recursive procedure that describes an iterative process (tail recursive) of reversing a list in Scheme
(define (reverse lst)
(define (go lst tail)
(if (null? lst) tail
(go (cdr lst) (cons (car lst) tail))))
(go lst ())))
Using substitution model for (reverse (list 1 2 3 4))
;; (reverse (list 1 2 3 4))
;; (go (list 1 2 3 4) ())
;; (go (list 2 3 4) (list 1))
;; (go (list 3 4) (list 2 1))
;; (go (list 4) (list 3 2 1))
;; (go () (list 4 3 2 1))
;; (list 4 3 2 1)
Here is a recursive procedure that describes a recursive process (not tail recursive) of reversing a list in Scheme
(define (reverse2 lst)
(if (null? lst) ()
(append (reverse2 (cdr lst)) (list (car lst)))))
(define (append l1 l2)
(if (null? l1) l2
(cons (car l1) (append (cdr l1) l2))))
Using substitution model for (reverse2 (list 1 2 3 4))
;; (reverse2 (list 1 2 3 4))
;; (append (reverse2 (list 2 3 4)) (list 1))
;; (append (append (reverse2 (list 3 4)) (list 2)) (list 1))
;; (append (append (append (reverse2 (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append (reverse2 ()) (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (append () (list 4)) (list 3)) (list 2)) (list 1))
;; (append (append (append (list 4) (list 3)) (list 2)) (list 1))
;; (append (append (list 4 3) (list 2)) (list 1))
;; (append (list 4 3 2) (list 1))
;; (list 4 3 2 1)
Tail recursive approach using a named let:
(define (reverse lst)
(let loop ([lst lst] [lst-reversed '()])
(if (empty? lst)
lst-reversed
(loop (rest lst) (cons (first lst) lst-reversed)))))
This is basically the same approach as having a helper function with an accumulator argument as in Oscar's answer, where the loop binding after let makes the let into an inner function you can call.
Here's a solution using build-list procedure:
(define reverse
(lambda (l)
(let ((len (length l)))
(build-list len
(lambda (i)
(list-ref l (- len i 1)))))))
This one works but it is not a tail recursive procedure:
(define (rev lst)
(if (null? lst)
'()
(append (rev (cdr lst)) (car lst))))
Tail recursive solution:
(define (reverse oldlist)
(define (t-reverse oldlist newlist)
(if (null? oldlist)
newlist
(t-reverse (cdr oldlist) (cons (car oldlist) newest))))
(t-reverse oldlist '()))
Just left fold the list using cons:
(define (reverse list) (foldl cons null list))
This is also efficient because foldl is tail recursive and there is no need for append. This can also be done point-free (using curry from racket):
(define reverse (curry foldl cons null))
(define reverse?
(lambda (l)
(define reverse-aux?
(lambda (l col)
(cond
((null? l) (col ))
(else
(reverse-aux? (cdr l)
(lambda ()
(cons (car l) (col))))))))
(reverse-aux? l (lambda () (quote ())))))
(reverse? '(1 2 3 4) )
One more answer similar to Oscar's. I have just started learning scheme, so excuse me in case you find issues :).
There's actually no need for appending or filling the body with a bunch of lambdas.
(define (reverse items)
(if (null? items)
'()
(cons (reverse (cdr items)) (car items))))
I think it would be better to use append instead of cons
(define (myrev l)
(if (null? l)
'()
(append (myrev (cdr l)) (list (car l)))
)
)
this another version with tail recursion
(define (myrev2 l)
(define (loop l acc)
(if (null? l)
acc
(loop (cdr l) (append (list (car l)) acc ))
)
)
(loop l '())
)

Resources