Combine Two Heaps Given a First Order Relation - data-structures

What I have to do:
Define a SCHEME procedure, named (combine f Ha Hb), which accepts three arguments, f, a firstorder relation which is used to order the elements in the heap, and two heap structures, Ha and Hb,
which have been constructed using the same first-order relation.
Example of a test case:
( define Ha ( heap-insert-list > ( list 9 5 7 3) ( list )))
( define Hb ( heap-insert-list > ( list 2 8 4 6) ( list )))
( combine > Ha Hb )
(9 (7 () (5 () (3 () ()))) (8 (4 () ()) (6 () (2 () ()))))
My code:
(define (create-heap v H1 H2)
(list v H1 H2))
(define (h-min H) (car H))
(define (left heap)
(cadr heap))
(define (right heap)
(caddr heap))
(define (combine f Ha Hb)
(cond ((null? Ha) Hb)
((null? Hb) Ha)
((< (h-min Ha) (h-min Hb))
(create-heap (h-min Ha)
Hb
(combine (left Ha) (right Ha))))
(else
(create-heap (h-min Hb)
Ha
(combine (left Hb) (right Hb)) Ha))))
My code is doing something right as I am getting 50% on my test cases, but it is not completely passing them.

Well, for starters you're not using the f procedure! This:
((< (h-min Ha) (h-min Hb))
... Most likely should look like this:
((f (h-min Ha) (h-min Hb))
Also, you forgot to pass the f parameter when calling the recursion:
(combine f (left Ha) (right Ha))

Related

Quicksort in Scheme using a partition

I have a partition for a quicksort:
(define (partition pivot lst)
((lambda (s) (s s lst list))
(lambda (s l* c)
(if (null? l*)
(c '() '())
(let ((x (car l*)))
(s s (cdr l*)
(lambda (a b)
(if (< x pivot)
(c (cons x a) b)
(c a (cons x b))))))))))
partition code source
Testing:
=>(partition '5 '(1 3 5 7 9 8 6 4 2))
;Value: ((1 3 4 2) (5 7 9 8 6))
How can I implement this partition in a quicksort? I've tried this so far:
(define (quicksort lst)
(if (null? lst) '()
(let* ((y (car lst))
(pn (partition y (cdr lst))))
(append (quicksort (car pn))
(list y)
(quicksort (cdr pn))))))
First, your code is trivially fixed by changing one cdr to cadr:
(define (partition pivot lst)
((lambda (s) (s s lst list))
......)) ; ^^^^ `list` the top continuation
(define (quicksort lst)
(if (null? lst) '()
(let* ((y (car lst))
(pn (partition y (cdr lst))))
(append
(quicksort (car pn))
(list y)
(quicksort (cadr pn))))))
;; ^^^^ cdr --> cadr
because the top continuation used in partition is list, and so the call
(partition pivot lst)
is equivalent to the call
(list { x IN lst SUCH THAT x < pivot }
{ x IN lst SUCH THAT x >= pivot } )
(the parts in {...} are pseudocode, where we don't care about the implementation, just the results)
And so to access the two parts of that list built by partition you need to use car and cadr.
Or you could keep the cdr in the accessing part of your code in quicksort if you'd change that top continuation to cons:
(define (partition pivot lst)
((lambda (s) (s s lst cons))
......)) ; ^^^^ `cons` the top continuation
(define (quicksort lst)
(if (null? lst)
'()
(let* ((y (car lst))
(pn (partition y (cdr lst))))
(append
(quicksort (car pn))
(list y)
(quicksort (cdr pn))))))
;; ^^^^ `cdr` works fine with `cons`
This because of the general principle in programming, where the functions used to build our data dictate which functions are to be used to access that data:
(list <A> <B> )
car cadr
(cons <A> <B> )
car cdr
( this particular correspondence is because (list <A> <B>) is the same as (cons <A> (cons <B> '())) and (cadr <C>) is the same as (car (cdr <C>)): )
(list <A> <B> )
=
(cons <A> (cons <B> '()))
car cdr
car
And conversely, the functions we use to access our data dictate the implementation of the function which must be used to build that data.
Of course that way of coding in your question is considered unnecessarily convoluted by modern standards since it emulates recursion through argument passing and reuse, -- just like in the famous Y combinator, -- but any Scheme worthy of its name already supports recursion.
So this partition would normally be written as the fully equivalent yet more readable code using the "named let" construct,
(define (partition pivot lst)
(let s ( (l* lst) ; first `l*` is `lst`
(c cons) ) ; top `c` is `cons`
(if (null? l*)
(c '() '())
(let ((x (car l*)))
(s (cdr l*)
(lambda (a b)
(if (< x pivot)
(c (cons x a) b)
(c a (cons x b)))))))))
except the name loop is conventionally used in place of s here (which itself most probably is intended as the shortening of "self").
But the true trouble with your quicksort/partition pair is algorithmic.
Yes I say pair (in non-cons sense of course) since the two go together -- just as with the data access/creation functions which must work together too.
Implementation of one dictates the implementation of the other -- in both directions, too. partition's code dictates quicksort's, or if we'd written quicksort first, we'd need to implement the partition in the corresponding way -- so that the two work together. Which means quicksort indeed producing the correct results, turning any input list into a sorted one:
(quicksort lst) --->
{ xs SUCH THAT
FOR ANY splitting xs = { ..., x, ...ys }
AND ANY splitting ys = { ..., y, ... }
IT HOLDS THAT x <= y
AND ALSO xs is a permutation of lst
(which implies (length lst) == (length xs))
}
So then, what is that trouble? It is that the true quicksort does no work whatsoever after the partitioning. None:
(define (quicksort! lst)
(if (null? lst)
'()
(let* ((y (car lst))
(pn (partition! y lst)))
(quicksort! (car pn)) ; no `append`, NB!
(quicksort! (cdr pn))))) ; no (list y) either
How is that even possible? What kind of partition! implementation would make that work? Well, most certainly not a functional one.
Instead it must be changing (i.e. mutating) the very lst itself somehow:
{ a, b, c, ....., k, l, m, ..... }
-->
{ d, e, ...., p, n, o, ..... }
~~~~~~~~~~~ ~~~~~~~~~~~
where we denote with p the partition point -- so that indeed all that's left to do after this kind of partitioning "in-place" is to sort the first part, and then to sort the second part, -- and then there's nothing more left to be done, after that! Which was the key insight in the original Tony Hoare's formulation of it:
TO SORT
{ a, b, c, ....., k, l, m, ..... } DO:
PARTITION it into
{ d, e, ...., p, n, o, ..... } AND THEN:
~~~~~~~~~~~ ~~~~~~~~~~~
SORT! SORT!
DONE.
This partitioning is usually implemented with swap! which actually swaps two elements in the underlying data structure. Most usually that data structure is an array with its facilities to change the value stored in it at any given index.
But it can also be a list, where the change i.e. mutation can be done with the set-car! primitive.
Looks like we'd need to build a list of cdrs out of the input list, and another one in reverse, -- to be able to iterate over them in both directions, back and forth, -- to make that happen.
I'll leave that for another day, for now.
Once you have the partition, there is still a small step to do.
Take care, you need to be sure partition splits the input in smaller sets all the time. In other word, partition not to return some empty set. The pivot can go in any of the sets and use this fact to check that you do not return an empty set, in case your comparison operator does not really decrease the size of the input. This is why I inserted the equality operator -- to be able to check if I insert the pivot in the first returned set or in the second one.
(define (partition pivot lst ret)
((lambda (s)
(s s lst
(lambda (a b p*)
(if (and (null? a) (null? b))
(ret (list pivot) (cdr p*))
(if (null? a)
(ret p* b)
(if (null? b)
(ret a p*)
(if (< (car b) pivot)
(ret a (append p* b))
(if (< (car a) pivot)
(ret (append a p*) b)
(error "never here")))))))))
(lambda (s l* c)
(if (null? l*)
(c '() '() '())
(let ((x (car l*)))
(s s (cdr l*)
(lambda (a b p*)
(if (= x pivot)
(c a b (cons pivot p*))
(if (< x pivot)
(c (cons x a) b p*)
(c a (cons x b) p*))))))))))
(define choose-pivot car)
In a real implementation, you will all the time use vectors and this is why the append will not be present, as, sorting on the place, at the end of partition, both sides will be sorted relatively one to the other. Here, we need to reassemble the 2 sides using append:
(define (quicksort lst)
(if (null? lst) '()
(if (null? (cdr lst))
lst
(let* ((pivot (choose-pivot lst)))
(partition pivot lst
(lambda (p< p>)
(append
(quicksort p<)
(quicksort p>))))))))
A test:
1 ]=> (quicksort '(1 3 5 7 9 8 6 4 2))
;Value: (1 2 3 4 5 6 7 8 9)
1 ]=> (quicksort '(1 9 3 8 5 7 7 6 9 5 8 4 6 3 4 2 2 1))
;Value: (1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9)
I used as pivot the first element of the input to split, but you can redefine the choose-pivot to select other element.
In practice, this algorithm is used in combination with other sorts -- when the input has fewer than 4-8 elements, the quicksort is not recurred any more, but other sorting is used for the lowest cases of recurrence relation.
I used directly < in the code -- you can insert it as a parameter in case you prefer a more generic procedure... In any case, the operator that you use needs to simulate the equality and different of in the same time.
UPDATE I have updated the partition, such that to consider duplicated elements. In my first version, it ignored duplicated elements.

How do I write the test case for this code?

I've just started learning about trees and heaps and I'm unsure about how to go about writing the test case. These codes are from my lesson slides. Although they give codes, they sadly don't provide test cases of said codes, so I am confused on how I would call it.
I've tried test cases such as any regular integers like 5, and I've also tried going about it with lists, but I run into errors and it just doesn't seem right as I know from diagrams that heaps are like trees with its roots being the smallest value and with its subheaps.
(define (value H)
(car H))
(define (weight H)
(cdr H))
(define (create-heap vw-pair left-child right-child)
(list vw-pair left-child right-child))
(define (h-min heap)
(car heap))
(define (left heap)
(cadr heap))
(define (right heap)
(caddr heap))
(define (insert vw-pair heap)
(cond ((null? heap) (create-heap vw-pair '() '()))
((< (weight vw-pair) (weight (h-min heap)))
(create-heap vw-pair (right heap) (insert (h-min heap) (left heap))))
(else
(create-heap (h-min heap) (right heap) (insert vw-pair (left heap))))))
(define (insert-list-of-pairs vw-pair-list heap)
(if (null? vw-pair-list)
heap
(insert-list-of-pairs (cdr vw-pair-list) (insert (car vw-pair-list) heap))))
(define (remove-min heap)
(define (combine-heaps h1 h2)
(cond ((null? h1) h2)
((null? h2) h1)
((< (cdr (h-min h1)) (cdr (h-min h2)))
(create-heap (h-min h1) h2 (combine-heaps (left h1) (right h1))))
(else
(create-heap (h-min h2)
h1
(combine-heaps (left h2) (right h2))))))
(combine-heaps (left heap) (right heap)))
Your test cases should explain exactly what you want to do.
They are the way to explain, using code, the intended use for the functions you write.
For your specific case, I obviously can't help you because that's exactly what's missing from your code: the meaning it should have.
But I can still explain how to write unit tests in Racket:
;; This is a function you would write.
;; It does something, but it's not completely obvious
;; how to use it.
(define (find type basket)
(let ([obj (assq type basket)])
(and obj
(cadr obj))))
;; By creating a test module, you add code that describes
;; how to use the functions in this file.
(module+ test
(require rackunit)
;; This is some sample data.
;; It's useful to understand what kind of data
;; your functions are expected to process.
(define basket '((bread baguette)
(fruit ananas)
(fruit banana)
(vegetable carrot)
(misc fork&knife)))
;; Here we call the function and show the expected result.
;; It's now clear how to use it.
(check-equal? (find 'fruit basket) 'ananas)
(check-equal? (find 'vegetable basket) 'carrot)
(check-false (find 'fruit '()))
)
You can run those tests by using raco:
> raco test myfile.rkt
raco test: (submod "myfile.rkt" test)
3 tests passed

filter function using tail recursion

Currently I have
(define filter
(λ (f xs)
(letrec [(filter-tail
(λ (f xs x)
(if (empty? xs)
x
(filter-tail f (rest xs)
(if (f (first xs))
(cons (first xs) x)
'()
)))))]
(filter-tail f xs '() ))))
It should be have as a filter function
However it outputs as
(filter positive? '(-1 2 3))
>> (3 2)
but correct return should be (2 3)
I was wondering if the code is correctly done using tail-recursion, if so then I should use a reverse to change the answer?
I was wondering if the code is correctly done using tail-recursion.
Yes, it is using a proper tail call. You have
(define (filter-tail f xs x) ...)
Which, internally is recursively applied to
(filter-tail f
(some-change-to xs)
(some-other-change-to x))
And, externally it's applied to
(filter-tail f xs '())
Both of these applications are in tail position
I should use a reverse to change the answer?
Yep, there's no way around it unless you're mutating the tail of the list (instead of prepending a head) as you build it. One of the comments you received alluded to this using set-cdr! (see also: Getting rid of set-car! and set-cdr!). There may be other techniques, but I'm unaware of them. I'd love to hear them.
This is tail recursive, requires the output to be reversed. This one uses a named let.
(define (filter f xs)
(let loop ([ys '()]
[xs xs])
(cond [(empty? xs) (reverse ys)]
[(f (car xs)) (loop (cons (car xs) ys) (cdr xs))]
[else (loop ys (cdr xs))])))
(filter positive? '(-1 2 3)) ;=> '(2 3)
Here's another one using a left fold. The output still has to be reversed.
(define (filter f xs)
(reverse (foldl (λ (x ys) (if (f x) (cons x ys) ys))
'()
xs)))
(filter positive? '(-1 2 3)) ;=> '(2 3)
With the "difference-lists" technique and curried functions, we can have
(define (fold c z xs)
(cond ((null? xs) z)
(else (fold c (c (car xs) z) (cdr xs)))))
(define (comp f g) (lambda (x) ; ((comp f g) x)
(f (g x))))
(define (cons1 x) (lambda (y) ; ((cons1 x) y)
(cons x y)))
(define (filter p xs)
((fold (lambda (x k)
(if (p x)
(comp k (cons1 x)) ; nesting's on the left
k))
(lambda (x) x) ; the initial continuation, IC
xs)
'()))
(display (filter (lambda (x) (not (zero? (remainder x 2)))) (list 1 2 3 4 5)))
This builds
comp
/ \
comp cons1 5
/ \
comp cons1 3
/ \
IC cons1 1
and applies '() to it, constructing the result list in the efficient right-to-left order, so there's no need to reverse it.
First, fold builds the difference-list representation of the result list in a tail recursive manner by composing the consing functions one-by-one; then the resulting function is applied to '() and is reduced, again, in tail-recursive manner, by virtues of the comp function-composition definition, because the composed functions are nested on the left, as fold is a left fold, processing the list left-to-right:
( (((IC+k1)+k3)+k5) '() ) ; writing `+` for `comp`
=> ( ((IC+k1)+k3) (k5 '()) ) ; and `kI` for the result of `(cons1 I)`
<= ( ((IC+k1)+k3) l5 ) ; l5 = (list 5)
=> ( (IC+k1) (k3 l5) )
<= ( (IC+k1) l3 ) ; l3 = (cons 3 l5)
=> ( IC (k1 l3) )
<= ( IC l1 ) ; l1 = (cons 1 l3)
<= l1
The size of the function built by fold is O(n), just like the interim list would have, with the reversal.

Recursion on deep list scheme

I have created a function that takes a list as input and returns either a list or a atom. I want to apply this function to a deep list, starting with the inner lists, then finish once the function has been run on the outer list.
Can somebody give me some direction on this?
A sample input would be (a b (c (d e))) z) the function should compute on (d e) first with a result of say f. then the function should compute on (c f) with a result of say g then similarly on (a b g z) to produce an output of h.
An example function could be:
(define sum
(lambda (l)
(if (not (pair? l))
0
(+ (car l) (sum (cdr l))))))
Where input would be (1 2 (3 4) 5) > 15
Assuming your example transformation, expressed as a Scheme procedure:
(define (transform lst)
(case lst
(((d e)) 'f)
(((c f)) 'g)
(((a b g z)) 'h)
(else (error (~a "wot? " lst)))))
then what you are looking for seems to be
(define (f lst)
(transform
(map (lambda (e)
(if (list? e) (f e) e))
lst)))
Testing:
> (f '(a b (c (d e)) z))
'h
Here is an example:
(define product
(lambda (l)
(cond
[(number? l) l]
[(pair? l) (* (product (car l)) (product (cdr l)))]
[else 1])))
> (product '(1 2 (3 4) 5))
120

Scheme Error, Return Binary Search Tree as Ordered List (R5RS)

I am a noob at Scheme. I have a binary search tree. The format of a node is a list of three elements, the first being the value at the node, the second being the left child node, and the third being the right child node. The "make" function creates an empty tree that looks like this: ( () () () ). I am able to create the tree, insert values, and find if a certain value exists in the tree. My problem comes when I try to write a function that returns the tree as an ordered list. Insert and Make functions:
;Inserts a number into the tree
(define (insert t x)
(cond ((null? (car t))
(list x (make) (make)))
((< x (car t))
(list (car t) (insert (cadr t) x) (caddr t)))
((> x (car t))
(list (car t) (cadr t) (insert (caddr t) x) ))
)
)
;Makes a new empty tree
(define (make)
(list (list) (list) (list))
)
Those works fine. Here is my as-list:
;Gives list of all numbers
(define (as-list t)
(cond
(
(null? (car t) )
(list)
)
(
#t
(append (as-list (cadr t)) (as-list (car t)) (as-list (caddr t)))
)
)
)
Running this, I get a contract violation, saying it expected "mpair?". I do not believe this is a logic error on my part, but it may be. Is this another parentheses problem?
Thank you for your time!
Your recursion should be
(append (as-list (cadr t)) (list (car t)) (as-list (caddr t)))
You only want to call as-list on trees, and the car of your t is not a tree.

Resources