How do I write a function in DrRacket ISL/Lambda that moves occurrences of certain items to the end of the list? - scheme

I'm trying to learn how to do this, and I know it involves stacks, but I can't wrap my head around it unless I see a function in action. We've been given this example of a function to create and I need some help. Here it is:
;leafpile takes a list and returns the result of pushing all
;occurrences of the symbol 'leaf to the end of the list
> (leafpile '(rock grass leaf leaf acorn leaf))
(list 'rock 'grass 'acorn 'leaf 'leaf 'leaf)
We can use a helper function but the function needs to be written in a way to minimize recursive passes
update (heres what I got so far)
(define (leafpile/help ls pile)
(local
[
(define (helper 2ls leafpile)
(cond
[(empty? 2ls) (filter ls 'leaf)]
[(equal? (first 2ls) 'leaf)
(cons (first 2ls) (helper (rest 2ls) leafpile))]
[else (helper (rest 2ls) leafpile)]))]
(helper ls pile)))
OK snow I have this:
(define (helper lsh)
(cond
[(empty? lsh) '()]
[(not(equal? (first lsh) 'leaf))
(cons (first lsh) (helper (rest lsh)))]
[else (helper (rest lsh))]))
(define (count-leaf ls)
(cond
[(empty? ls) 0]
[(not (equal? 'leaf (first ls))) (count-leaf (rest ls))]
[else (add1 (count-leaf (rest ls)))]))
(define (leafpile ls)
(append (helper ls) (make-list (count-leaf ls) 'leaf)))
but I need it in one simple function with the least recursive passes possible.

Here is the solution I came up with:
(define (leafpile lst)
(for/fold ([pile (filter (lambda (leaf?) (not (equal? leaf? 'leaf))) lst)])
([i (build-list (for/fold ([leaves 0])
([leaf? lst])
(if (equal? leaf? 'leaf)
(add1 leaves)
leaves)) values)])
(append pile '(leaf))))
How it works:
The main for/fold loop iterates over a list with a length of the number of leaves there are, and the 'collection value' is a list of all the elements in lst that aren't the symbol 'leaf (achieved by filter).
Sample input/output:
> (leaf-pile '(rock grass leaf leaf acorn leaf))
'(rock grass acorn leaf leaf leaf)

Really simple way to do this:
(define (leaf? v)
(eq? v 'leaf))
(define (leafpile lst)
(append (filter (compose not leaf?) lst)
(filter leaf? lst)))
It really doesn't need to be more to it unless you experience performance issues and I usually don't for small lists. I tend to think of lists with fewer than a million elements as small. The obvious recursive one that might not be faster:
(define (leafpile lst)
(local [(define (leafpile lst n) ; screaming for a named let here!
(cond
((null? lst) (make-list n 'leaf))
((leaf? (car lst)) (leafpile (cdr lst) (add1 n)))
(else (cons (car lst) (leafpile (cdr lst) n)))))]
(leafpile lst 0)))
A tail recursive one that accumulates non leaf values, counts leaf values and uses srfi/1 append-reverse! to produce the end result:
(require srfi/1)
(define (leafpile lst)
(local [(define (leafpile lst acc n) ; I'm still screaming
(cond
((null? lst) (append-reverse! acc (make-list n 'leaf)))
((leaf? (car lst)) (leafpile (cdr lst) acc (add1 n)))
(else (leafpile (cdr lst) (cons (car lst) acc) n))))]
(leafpile lst '() 0)))

Related

Buidling BST in racket from a list

I introduce today is to make a BST tree using a list. This is a list with sorted version, and strictly increasing, with no duplicates. like (list 100 200 300 400)..
Ialready write alot of code. It is here. but nothing is works..Can some one change it to fix?
Thank you
(define (bst-tree lst)
(cond
[(empty? lst) empty]
[else
(local [(define (pivot lst)
(cond
[(= 1 (length lst)) (first lst)]
[(= 2 (length lst)) (first lst)]
[else (pivot (rest (foldl cons empty (rest (foldl cons empty lst)))))]))
(define less (filter (lambda (x) (< x (pivot lst))) lst))
(define greater (filter (lambda (x) (> x (pivot lst))) lst))]
(append (make-node pivot (bst-tree less) (bst-tree greater))))]))
Here is the fix: (append (make-node(pivot lst)(bst-tree less) (bst-tree greater)))
pivot refers to the function, and therefore evaluates to a procedure applying it on the list gets the numeric value.

Inserting word beside another word starting from the end of list

I have code which is inserting new word on the right side of choosen word
(define insertR
(lambda (new old lst)
(cond
((null? lst) (lst))
(else (cond
((eq? (car lst) old)
(cons old
(cons new (cdr lst))))
(else (cons (car lst)
(insertR new old
(cdr lst)))))))))
i need to make it insert that word beside first appearance of word starting from the end of list. Tried to work with reverse but could not get that to work.
There are two strategies you can take to add it next to the last occurence.
The first is to use a helper and start off with the reverse list. This is very simple and my preferred solution.
(define (insert-by-last-match insert find lst)
(let loop ((lst (reverse lst)) (acc '()))
(if (null? lst)
acc
(let ((a (car lst)))
(if (equal? a find)
(append (reverse (cdr lst))
(list* find insert acc))
(loop (cdr lst) (cons a acc)))))))
The other one is kind of obscure. Whenever you find the element you replace last-match with a callback that replaces the computation since it was made and until it gets called with the replacement and the rest of the list, which of course is the correct result. The work done until the end of the list is simply discarded since it is not used, but we do it since we are not sure if we are going to find a later one and then all the work uptil that is of course included in the result.
(define (insert-by-last-match insert find lst)
(define (helper lst last-match)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)))
(cons a
(if (equal? a find)
(let/cc k
(helper d (lambda () (k (cons insert d)))))
(helper d last-match))))))
(helper lst (lambda () lst)))
call/cc (or its variant let/cc) is often described as time travel or advanced goto. It is not very intuitive. Here is a CPS version:
(define (insert-by-last-match insert find lst)
(define (helper lst last-match k)
(if (null? lst)
(last-match)
(let* ((a (car lst)) (d (cdr lst)) (k2 (lambda (v) (k (cons a v)))))
(if (equal? a find)
(helper d (lambda () (k2 (cons insert d))) k2)
(helper d last-match k2)))))
(helper lst (lambda () lst) (lambda (v) v)))
Basically this is the same as the previous only that here I have written the CPS code and with the let/cc version the implementation does it for me and I get to use k exactly where I need it. In this version you see there is no magic or time travel but the execution that should happen later is simply replaced at a point.
Write in a similar way insertL and apply it to the reversed list.
And reverse the result. Then you will have an insertion beside first appearance of word starting from the end of list
(define insertL
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons new lst))
(else (cons (car lst) (insertL new old (cdr lst)))))))
(define last-insertR
(lambda (new old lst)
(let* ((rlst (reverse lst))
(result (insertL new old rlst)))
(reverse result))))
test:
(last-insertR 'aa 'a '(b c d a h i a g))
;; '(b c d a h i a aa g)
By the way, the beauty of cond is that you can put the conditions always at the beginning - listed one under the other.
So one can write your insertR nicer as:
(define insertR
(lambda (new old lst)
(cond ((null? lst) '())
((eq? (car lst) old) (cons old (cons new (cdr lst))))
(else (cons (car lst) (insertR new old (cdr lst)))))))

Scheme quick-sort with filter

I need to write the function (quick-sort pred lst)
lst is the list of numbers to be sorted
pred is the predicate by which the list is ordered, the signature of this predicate is: (lambda (x y) …)
- (quick-sort < lst) will sort ascending (small to large)
- (quick-sort > lst) will sort descending (large to small)
- (quick-sort (lambda (x y) (< (car x) (car y))) lst) will sort a list
with inner lists according to the first element of the inner list, ascending.
I started with regular quick-sort:
(define (quick-sort lst)
(cond
((null? lst) '())
((= (length lst) 1) lst)
(else (append (quick-sort (filter (lambda (n) (< n (car lst))) lst))
(list (car lst))
(quick-sort (filter (lambda (n) (> n (car lst))) lst))))))
And now I'm trying to do this with pred:
(define (quick-sort pred lst)
(define (quick-sort-help lst)
(cond ((null? lst) ())
((= (length lst) 1) lst)
(else
(append (quick-sort-help (filter (lambda (n) (pred n (car lst))) lst))
(list (car lst))
(quick-sort-help (filter (lambda (n) (not(pred n (car lst)))) lst)))))) (quick-sort-help lst))
And I get an infinite recursion or something.
Can you help me solve this problem please?
Thanks!
First of you don't need the helper function quick-sort-help.
It recurs infinitely because you apply your helper function to lst instead cdr lst. In your regular quicksort you have (filter (lambda (n) (< n (car lst))) and (filter (lambda (n) (> n (car lst))). But then in the one with the predicate you have the problem that (not (pred ...) would cover the cases for <= and not < if the predicate is > and vice versa. So it gets stuck because the first element in the list is always equal with itself.
Here a correct quicksort:
(define (qsort f lst)
(if (null? lst)
null
(let ([pivot (car lst)])
(append (qsort f (filter (λ (n) (f n pivot)) (cdr lst)))
(list pivot)
(qsort f (filter (λ (n) (not (f n pivot))) (cdr lst)))))))

Racket Append Undesired Reversal of List

I wrote a small function that takes a list and returns a list composed of only positive numbers. This all works fine, but for some reason, it is reversing the order. More information below on that. Could someone please tell me if this is normal, or if I miss-wrote something? Thank you in advance.
(define (positive-nums-only lst)
(if (empty? lst)
'()
(append (positive-nums-only (cdr lst))
(if (>= (car lst) 0)
(list (car lst))
'()))))
(positive-nums-only '(1 2 -4 90 -4))
The above test case returns '(90 2 1)
You did not make a mistake, the program is making what you asked.
See, the program finishes the recursion calls first, before going into resolving the if statement. This causes the (list ... ) to start listing from the last element that is positive, in this example it will be 90.
Changing the code order will produce the result you want.
(define (positive-nums-only lst)
(if (empty? lst) '()
(append (if (>= (car lst) 0 )
(list (car lst))
'())
(positive-nums-only (cdr lst)))
)
)
On the other hand, this kind of recursion could be expensive to the computer. I'd use tail recursion, like this:
(define positive-nums-only-tail
(λ (lst r)
(cond ((empty? lst) (reverse r))
((positive? (car lst))
(positive-nums-only-tail (cdr lst)
(cons (car lst) r)))
(else (positive-nums-only-tail (cdr lst) r))
)
)
)
Have you tried reversing the append?
(define (positive-nums-only lst)
(if (empty? lst)
'()
(append (if (>= (car lst) 0) (list (car lst)) '())
(positive-nums-only (cdr lst)))))
Personally I find it more natural to write it like this:
(define (positive-nums-only lst)
(if (empty? lst)
'()
(let ((rest (positive-nums-only (cdr lst))))
(if (>= (car lst) 0)
(cons (car lst) rest)
rest))))

How to sort disorder list of numbers in scheme

What it the proper way to sort a list with values in Scheme? For example I have the values which are not ordered:
x1, x5, x32 .... xn
or
3, 4, 1, 3, 4, .. 9
First I want to for them by increase number and display them in this order:
x1, xn, x2, xn-1
or
1, 6, 2, 5, 3, 4
Any help will be valuable.
This is the same question you posted before, but with a small twist. As I told you in the comments of my answer, you just have to sort the list before rearranging it. Here's a Racket solution:
(define (interleave l1 l2)
(cond ((empty? l1) l2)
((empty? l2) l1)
(else (cons (first l1)
(interleave l2 (rest l1))))))
(define (zippy lst)
(let-values (((head tail) (split-at
(sort lst <) ; this is the new part
(quotient (length lst) 2))))
(interleave head (reverse tail))))
It works as expected:
(zippy '(4 2 6 3 5 1))
=> '(1 6 2 5 3 4)
This R6RS solution does what Chris Jester-Young proposes and it really is how to do it the bad way. BTW Chris' and Óscar's solutions on the same question without sorting is superior to this zippy procedure.
#!r6rs
(import (rnrs base)
(rnrs sorting)) ; list-sort
(define (zippy lis)
(let loop ((count-down (- (length lis) 1))
(count-up 0))
(cond ((> count-up count-down) '())
((= count-up count-down) (cons (list-ref lis count-down) '()))
(else (cons (list-ref lis count-down)
(cons (list-ref lis count-up)
(loop (- count-down 1)
(+ count-up 1))))))))
(define (sort-rearrange lis)
(zippy (list-sort < lis)))
Here is a simple, tail-recursive approach that uses a 'slow/fast' technique to stop the recursion when half the list is traversed:
(define (interleave l)
(let ((l (list-sort < l)))
(let merging ((slow l) (fast l) (revl (reverse l)) (rslt '()))
(cond ((null? fast)
(reverse rslt))
((null? (cdr fast))
(reverse (cons (car slow) rslt)))
(else
(merging (cdr slow) (cddr fast) (cdr revl)
(cons (car revl) (cons (car slow) rslt))))))))
So, you don't mind slow and just want a selection-based approach, eh? Here we go....
First, we define a select1 function that gets the minimum (or maximum) element, followed by all the other elements. For linked lists, this is probably the simplest approach, easier than trying to implement (say) quickselect.
(define (select1 lst cmp?)
(let loop ((seen '())
(rest lst)
(ext #f)
(extseen '()))
(cond ((null? rest)
(cons (car ext) (append-reverse (cdr extseen) (cdr ext))))
((or (not ext) (cmp? (car rest) (car ext)))
(let ((newseen (cons (car rest) seen)))
(loop newseen (cdr rest) rest newseen)))
(else
(loop (cons (car rest) seen) (cdr rest) ext extseen)))))
Now actually do the interweaving:
(define (zippy lst)
(let recur ((lst lst)
(left? #t))
(if (null? lst)
'()
(let ((selected (select1 lst (if left? < >))))
(cons (car selected) (recur (cdr selected) (not left?)))))))
This approach is O(n²), whereas the sort-and-interleave approach recommended by everybody else here is O(n log n).

Resources