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))))))
Related
So I have to write a method that takes in a list like (nested '(4 5 2 8)) and returns (4 (5 () 2) 8).
I figured I needed to write 3 supporting methods to accomplish this. The first gets the size of the list:
(define (sizeList L)
(if (null? L) 0
(+ 1 (sizeList (cdr L)))))
input : (sizeList '(1 2 3 4 5 6 7))
output: 7
The second drops elements from the list:
(define (drop n L)
(if (= (- n 1) 0) L
(drop (- n 1) (cdr L))))
input : (drop 5 '(1 2 3 4 5 6 7))
output: (5 6 7)
The third removes the last element of a list:
(define (remLast E)
(if (null? (cdr E)) '()
(cons (car E) (remLast (cdr E)))))
input : (remLast '(1 2 3 4 5 6 7))
output: (1 2 3 4 5 6)
For the nested method I think I need to do the car of the first element, then recurse with the drop, and then remove the last element but for the life of me I can't figure out how to do it or maybe Im just continually messing up the parenthesis? Any ideas?
Various recursive solutions are possible, but the problem is that the more intuitive ones have a very bad performance, since they have a cost that depends on the square of the size of the input list.
Consider for instance this simple solution:
; return a copy of list l without the last element
(define (butlast l)
(cond ((null? l) '())
((null? (cdr l)) '())
(else (cons (car l) (butlast (cdr l))))))
; return the last element of list l
(define (last l)
(cond ((null? l) '())
((null? (cdr l)) (car l))
(else (last (cdr l)))))
; nest a linear list
(define (nested l)
(cond ((null? l) '())
((null? (cdr l)) l)
(else (list (car l) (nested (butlast (cdr l))) (last l)))))
At each recursive call of nested, there is a call to butlast and a call to last: this means that for each element in the first half of the list we must scan twice the list, and this requires a number of operations of order O(n2).
Is it possible to find a recursive solution with a number of operations that grows only linearly with the size of the list? The answer is yes, and the key to this solution is to reverse the list, and work in parallel on both the list and its reverse, through an auxiliary function that gets one element from both the lists and recurs on their cdr, and using at the same time a counter to stop the processing when the first halves of both lists have been considered. Here is a possible implementation of this algorithm:
(define (nested l)
(define (aux l lr n)
(cond ((= n 0) '())
((= n 1) (list (car l)))
(else (list (car l) (aux (cdr l) (cdr lr) (- n 2)) (car lr)))))
(aux l (reverse l) (length l)))
Note that the parameter n starts from (length l) and is decreased by 2 at each recursion: this allows to manage both the cases of a list with an even or odd number of elements. reverse is the primitive function that reverses a list, but if you cannot use this primitive function you can implement it with a recursive algorithm in the following way:
(define (reverse l)
(define (aux first-list second-list)
(if (null? first-list)
second-list
(aux (cdr first-list) (cons (car first-list) second-list))))
(aux l '()))
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)
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 '())
'()
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers:
(In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(()), then I'd rename chunkify and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values, let-values, call-with-values) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
I want to play.
At the core this isn't really anything that's much different from what's
been offered but it does put it in terms of the for/fold loop. I've
grown to like the for loops as I think they make for much
more "viewable" (not necessarily readable) code. However, (IMO --
oops) during the early stages of getting comfortable with
racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.
I'm a newbie at Scheme, so forgive the question: I have a function that calculates the factorials of a list of numbers, but it gives me a period before the last number in the results. Where am I going wrong?
code:
#lang scheme
(define fact
(lambda (n)
(cond
((= n 0) 1)
((= n 1) 1)
(else (* n (fact (- n 1)))))))
(define fact*
(lambda (l)
(cond
((null? (cdr l)) (fact (car l)))
(else
(cons (fact (car l)) (fact* (cdr l)))))))
output:
> (fact* '(3 6 7 2 4 5))
(6 720 5040 2 24 . 120)
What you have done is create an improper list. Try this:
(define fact*
(lambda (l)
(cond
((null? (cdr l)) (list (fact (car l))))
(else
(cons (fact (car l)) (fact* (cdr l)))))))
The addition of the list in the fourth line should make this work as you expect. Better might be the following:
(define fact*
(lambda (l)
(cond
(null? l) '())
(else
(cons (fact (car l)) (fact* (cdr l)))))))
This allows your fact* function to work on the empty list, as well as reducing the number of places where you make a call to fact.
The other answers have pointed out the reason why you get an improper list as a result of your fact* function. I would only like to point out that you could use the higher-order function map:
(define fact*
(lambda (l)
(map fact l))
(fact* '(3 6 7 2 4 5))
map takes a function and a list as arguments and applies the function to every element in the list, producing a new list.
Use append instead of cons. cons is used to construct pairs, which is why you have the "." that is used to separate the elements of a pair. Here's an example:
(define (factorial n)
(if (<= n 1)
1
(* n (factorial (- n 1)))))
(define (factorial-list l)
(if (null? l)
'()
(append (list (factorial (car l)))
(factorial-list (cdr l)))))