My work on https://people.eecs.berkeley.edu/~bh/ssch19/implement-hof.html
This chapter is about writing higher-order procedures.
I compare my work to other people’s solutions some in order to gain perspective on different ways of solving some problems.
I am also consciously trying to “oversolve” procedures from different angles.
Chapter Notes
The chapter contrasts every
and map
:
The key difference is the use of cons
, car
, and cdr
in map
versus se
, first
, and butfirst
in every
.
map
will preserve a structured list whereas every
won’t, because every
uses se
to combine the elements of the result, wheres map
uses cons
:
Regarding accumulate
, the book says you might expect to have to provide the combiner, the values to be combined, and the identity element in order to generalize the pattern involved in accumulate
, but the book folks dropped the need for the identity element by simply returning the remaining element when you’re down to one element. Nice trick.
The book says how robust to make a program in terms of the program behaving politely when given incorrect input is a matter of judgment.
Exercises
β 19.1
What happens if you say the following?
1
2
3
|
(every cdr '((john lennon) (paul mccartney)
(george harrison) (ringo starr)))
|
The cdr
procedure is applied to every element within the list, leading to the output '(lennon mccartney harrison starr)
.
How is this different from using
map
, and why?
With every
the result is “flattened” into a sentence due to the use of sentence
to join results in every
. With map
the sublists remain: '((lennon) (mccartney) (harrison) (starr))
.
How about
cadr
instead ofcdr
?
every cadr
has the same output as every cdr
. To discuss one of the elements in detail, cdr
of '(john lennon)
is '(lennon)
and cadr
of '(john lennon)
is 'lennon
. You might thus expect the values returned by every cadr
to vary from every cdr
, but the results are combined internally in every
using sentence
and so the nested lists are flattened into a single “sentence” list that appears the same regardless of whether the Beatle names being dealt with are words or sentences.
OTOH, map cadr
varies significantly from map cdr
. Because map cadr
deals with the Beatle names as words, there’s no nesting in the resulting list – the output is a single flat list that is the same as in the every
examples.
β 19.2
My Solution 1 – No Combine
Write
keep
. Don’t forget thatkeep
has to return a sentence if its second argument is a sentence, and a word if its second argument is a word.
(Hint: it might be useful to write acombine
procedure that uses eitherword
orsentence
depending on the types of its arguments.)
My answer:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
(define (real-keep2 fn input)
(cond ((empty? input)
input)
((fn (first input))
(if (word? input)
(word (first input) (real-keep2 fn (bf input)))
(se (first input) (real-keep2 fn (bf input)))))
(else (real-keep2 fn (bf input)))))
(define (keep2 fn input)
(if (empty? input)
'(you have provided no input for the second argument)
(real-keep2 fn input)))
|
I did not write a combine
procedure cuz it seemed unnecessary. Instead, I used an if
within the consequent of the second cond
clause.
I did make keep2
a “screener” procedure designed to check for a problematic case (when no input is provided for the second argument). If that check is passed, then the function and input are handed off to real-keep2
.
I gave keep2 the following tests:
1
2
3
4
5
6
7
|
(keep2 even? '(3 4 5 6 7 8))
(keep2 vowel? 'potato)
(keep2 number? 'zonk23hey9)
(every square (keep2 even? '(87 4 7 12 0 5)))
(keep2 odd? '())
(keep2 vowel? 'birthday)
|
and I got the following outputs:
These outputs were as expected.
My Solution 2 – Combine
I then decided to try writing a version with combine
.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
(define (combine arg1 arg2)
(if (sentence? arg2)
(se arg1 arg2)
(word arg1 arg2)
))
(define (real-keep3 fn input)
(cond ((empty? input)
input)
((fn (first input))
(combine (first input) (real-keep3 fn (bf input))))
(else (real-keep3 fn (bf input)))))
(define (keep3 fn input)
(if (empty? input)
'(you have provided no input for the second argument)
(real-keep3 fn input)))
|
We want to look at whether arg2
is a sentence within combine
because, if a sentence is provided as the input, the second arg will always be a sentence, even if an empty one, whereas the first arg might be a word. See (keep3 even? '(3 4 5 6 7 8))
as an example:
real-keep2
worked differently because it checked whether the whole input
to the procedure was a word?
, instead of checking whether first input
(the first element of the word or sentence) was a word.
The keep3
procedure managed to produce the desired output for the tests mentioned earlier.
buntine’s solution
Here’s buntine’s solution:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
|
(define (keep2 pred sent)
(if (word? sent)
(combine pred sent word "")
(combine pred sent se '())))
(define (combine pred sent combiner null-value)
(cond
((empty? sent) null-value)
((pred (first sent))
(combiner (first sent) (combine pred (butfirst sent)
combiner null-value)))
(else (combine pred (butfirst sent)
combiner null-value))))
|
buntine actually made the combiner the thing that did the real work in his procedure, whereas I just used it to combine two arguments at a time.
buntine actually passes in a null-value to his combine
, which is something I managed to avoid doing by returning the actual null value of the input when it became empty.
I looked at how keep
was actually implemented in the scheme variant used in the book, but it was longer than I expected and had some stuff I did not understand.
β 19.3
Write the three-argument version of
accumulate
that we described.
My answer:
1
2
3
4
5
6
|
(define (three-arg-accumulate combiner identity input)
(if (empty? input)
identity
(combiner (first input)
(three-arg-accumulate combiner identity (bf input)))))
|
It produces the correct output for the three cases they give as examples above.
buntine used car
and cdr
instead of first
and butfirst
but his solution is essentially the same.
β 19.4
Our
accumulate
combines elements from right to left. That is,
1
2
|
(accumulate - '(2 3 4 5))
|
computes 2β(3β(4β5)). Write
left-accumulate
, which will compute ((2β3)β4)β5 instead. (The result will be the same for an operation such as+
, for which grouping order doesn’t matter, but will be different for-
.)
for regular acccumulate
the output we get using the above example is -2
. For left-accumulate
we expect -10
.
for left-accumulate
I started with Chapter 19’s version of accumulate
but changed both the order of the arguments to the combiner
and changed the selectors from first
and butfirst
to last
and butlast
:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
(define (left-accumulate combiner stuff)
(cond ((not (empty? stuff))
(real-left-accumulate combiner stuff))
((member combiner (list + * word se append))
(combiner))
(else (error
"Can't accumulate empty input with that combiner"))))
(define (real-left-accumulate combiner stuff)
(if (empty? (bf stuff))
(first stuff)
(combiner (real-left-accumulate combiner (bl stuff))
(last stuff)
)))
|
I didn’t see any need to change the base case, as when you’re only down to one element it doesn’t matter whether you’re checking for the first
or last
element – it’s all the same.
Anyways those changes seemed to do the trick. This trace
result and output
is what I would expect if left-accumulate
was working correctly:
You can see left-accumulate
working its way down to the base case, returning 2
, then performing (2 - 3)
and returning -1
, and so on, till we get the expected -10
.
I tried another test:
And compare this with their accumuate
procedure, which I gave a different name so that I could trace
it:
You can see that the procedures proceed through the same input in exactly the opposite manner.
My answer is almost the same as Meng Zhang’s, a guy with a Simply Scheme github repository I just discovered. He changed the base case selectors to butlast
and last
and didn’t import all the stuff from the book into his main left-accumulate
procedure, but otherwise our solutions are very close.
β 19.5
Rewrite the
true-for-all?
procedure from Exercise 8.10. Do not useevery
,keep
, oraccumulate
.
So my previous answer was:
1
2
3
|
(define (true-for-all? proc sent)
(equal? (count (keep proc sent))(count sent)))
|
And here’s an example of the desired behavior:
Looks pretty straightforward.
My answer:
1
2
3
4
5
6
|
(define (true-for-all? fn input)
(if (empty? (cdr input))
(fn (car input))
(and (fn (car input))
(true-for-all? fn (cdr input)))))
|
I looked at a couple of other answers and mine seemed like the most elegant solution to me π
β 19.6
Write a procedure
true-for-any-pair?
that takes a predicate and a sentence as arguments. The predicate must accept two words as its arguments. Your procedure should return#t
if the argument predicate will return true for any two adjacent words in the sentence:
Hmm this one’s interesting π€
My Solution
My answer:
1
2
3
4
5
6
|
(define (true-for-any-pair? fn input)
(if (empty? (cddr input))
(fn (car input)(cadr input))
(or (fn (car input)(cadr input))
(true-for-any-pair? fn (cdr input)))))
|
I’m really getting a lot of mileage out of that trick they described in Chapter 19 re: accumulate
, where you check if bf stuff
is empty and then return the last element of the list. Here I extended that a bit, and did the list equivalent of checking if (bf (bf stuff))
was empty. That’s what cddr input
is checking for, basically – it’s seeing if there’s a third element in the list. If not, cddr input
will be empty, and so we can run the function fn
on car input
and cadr input
(the first and second elements, respectively, that remain in our list) and get that result and wrap the procedure up.
However, if there is actually a third element, then we invoke or
with a couple of arguments. We use or
here because we want to know if any of the pairs return true for the procedure, whereas in the last problem we wanted to know if the elements were all true for the function, so we used and
. Anyways, the first argument to the or
is the function called with the first two elements of our list. The second argument is a recursive call to true-for-any-pair?
. The arguments to that recursive call are of course fn
and also cdr
. We do cdr
because we need to test each adjacent pair, so even though we might have already tested an element as the second argument to the function, we still need to test it as the first argument to the function.
My procedure assumes that the input sentence has at least two elements. If you give it a one element list or an empty list you will get an error:
The procedure will stop running as soon as it hits a true value:
Meng Zhang’s Solution
Meng Zhang also had an elegant solution:
1
2
3
4
5
|
(define (true-for-any-pair? pred sent)
(cond ((null? (cdr sent)) #f)
((pred (car sent) (cadr sent)) #t)
(else (true-for-any-pair? pred (cdr sent)))))
|
His approach is slightly different. First, he uses a cond
rather than an if
. Also, his base case is a one element list. Therefore, his procedure can handle one element lists and only gives an error on the empty list. Furthermore, he explicitly returns true and false values. There are some other differences. Anyways, I thought it was pretty elegant.
β 19.7
Write a procedure
true-for-all-pairs?
that takes a predicate and a sentence as arguments. The predicate must accept two words as its arguments. Your procedure should return#t
if the argument predicate will return true for every two adjacent words in the sentence:
So this problem was a gimme in light of my solution and discussion of 19.6. For 19.6 we used or
because we wanted to return true if any pair was true. For 19.7 we want to return true only if all the pairs are true, so:
1
2
3
4
5
6
|
(define (true-for-all-pairs? fn input)
(if (empty? (cddr input))
(fn (car input)(cadr input))
(and (fn (car input)(cadr input))
(true-for-all-pairs? fn (cdr input)))))
|
β β 19.8
Technically solved this but didn’t really respect the spirit of how to use the helper function.
Rewrite
true-for-all-pairs?
(Exercise 19.7) usingtrue-for-any-pair?
(Exercise 19.6) as a helper procedure. Don’t use recursion in solving this problem (except for the recursion you’ve already used to writetrue-for-any-pair?
). Hint: You’ll find thenot
procedure helpful.
1
2
3
4
5
6
|
(define (true-for-any-pair? fn input)
(if (empty? (cddr input))
(fn (car input)(cadr input))
(or (fn (car input)(cadr input))
(true-for-any-pair? fn (cdr input)))))
|
Problem requirements:
1) use true-for-any-pair? as a helper procedure in true-for-all-pairs?
2) do not use recursion inΒ true-for-all-pairs?
Cases that need to be addressed:
I) predicate fn is not true for all pairs
II) predicate fn is true for all pairs
Incomplete solution:
1
2
3
|
(define (true-for-all-pairs? fn input)
(cond ((not (true-for-any-pair? fn input)) #f)))
|
the case i addressed in my incomplete solution is only a subset of case I
if i had a true-for-some-but-not-all-pairs? procedure, i could do something like this
1
2
3
4
5
6
7
|
(define (true-for-all-pairs? fn input)
(cond ((or
(true-for-some-but-not-all-pairs? fn input)
(not (true-for-any-pair? fn input)))
#f)
(else #t)))
|
My Solution
This works but I don’t think it’s what they were looking for. However, it does meet the technical requirements of the problem:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
(define (true-for-any-pair? fn input)
(if (empty? (cddr input))
(fn (car input)(cadr input))
(or (fn (car input)(cadr input))
(true-for-any-pair? fn (cdr input)))))
(define (not-empty? input)
(not (empty? input)))
(define (remove-empty lst)
(filter not-empty? lst))
(define (make-pair arg1 arg2)
(if (empty? arg2) '()
(list arg1 arg2)))
(define (true-for-all-pairs? fn input)
(let ((secondlist (append (cdr input) '(()))))
(andmap (lambda (arg) (true-for-any-pair? fn arg))
(remove-empty (map make-pair input secondlist)
))))
|
Some explanation:
1. Within true-for-all-pairs?
, (let ((secondlist (append (cdr input) '(()))))
makes a second that consists of the cdr
of the first list with an empty list appended. So if the first list was (a b c d e)
then secondlist
is (b c d e ())
. The empty list is created so that both lists have the same number of elements, which is a requirement for map
to be invoked on two lists.
2. (map make-pair input secondlist)
returns a list from the the initial input
list. This new list consists of a list of pairs from the input
plus an empty value at the end. So for input
'(a b c d e)
, this line generates ((a b)(b c)(c d)(d e)())
. This is accomplished using the helper procedure make-pair
.
3. remove-empty
removes the empty list from the lists of lists now that we don’t need an empty list placeholder anymore.
4. (lambda (arg) (true-for-any-pair? fn arg)
returns a procedure true-for-any-pair?
with the given fn
.
5. andmap
applies the true-for-any-pair?
from the lambda
to each element in the list of lists we generated, and then “sums up” the resulting truth values from those invocations of true-for-any-pair?
by applying the logical operator and
to them.
The reason I say I don’t think this is what the book was looking for is we’re not really using true-for-any-pair?
in any important way here. we could take this approach to solving true-for-all-pairs?
without needing to use true-for-any-pair?
. Also we didn’t use not
in our main procedure.
Meng Zhang’s Solution
1
2
3
4
|
(define (true-for-all-pairs? pred sent)
(not (true-for-any-pair? (lambda (a b) (not (pred a b)))
sent)))
|
With Zhang’s solution you check whether each pair is NOT true for the predicate. if it’s the case that any pair is NOT true, then true-for-any-pair? would return false, but for the opening not. but then he has the NOT around the whole true-for-any-pair? procedure. so the logic is, if it’s NOT the case that the predicate is NOT true for any pair, that’s the same as saying that the predicate is true for all pairs, so we return true.
β 19.9
Rewrite either of the sort procedures from Chapter 15 to take two arguments, a list and a predicate. It should sort the elements of that list according to the given predicate:
Explanation of Sort
Ok. Here’s the original sort
procedure from chapter 15 with its supporting helper procedures:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
(define (remove-once wd sent)
(cond ((empty? sent) '())
((equal? wd (first sent)) (bf sent))
(else (se (first sent) (remove-once wd (bf sent))))))
(define (earliest-word sent)
(earliest-helper (first sent) (bf sent)))
(define (earliest-helper so-far rest)
(cond ((empty? rest) so-far)
((before? so-far (first rest))
(earliest-helper so-far (bf rest)))
(else (earliest-helper (first rest) (bf rest)))))
(define (sort sent)
(if (empty? sent)
'()
(se (earliest-word sent)
(sort (remove-once (earliest-word sent) sent)))))
|
To recap (and since I didn’t do detailed analysis on this procedure before in Chapter 15 and its coming up again): the purpose of this procedure is to sort words in a sentence alphabetically. This procedure works by the following method: sort
first looks for the earliest-word
in the sentence.
The real action as far as finding the earliest word occurs in earliest-helper
. earliest-helper
takes two arguments: the first word of the sentence (so-far
) and the remaining words in the sentence (rest
). If we “run out” of rest
words in earlier helper – that is, if rest
becomes empty?
– then we know that so-far
is in fact the earliest word and we return that.
While we still have words remaining in rest
, we check – and this is the really key part for my solution to this problem – whether so-far
is before?
the first
value of rest
. before?
is a Scheme primitive. So basically we’re checking if the current candidate (so-far
) for the earliest word in the sentence comes before the first sentence of the remaining candidates for the earliest word in the sentence – (first rest)
. If so-far
does indeed come before (first rest)
, then so-far
retains its status as the current candidate for earliest word in the sentence, and this is reflected in the resulting recursive call we make – (earliest-helper so-far (bf rest)))
. We keep so-far
the same and decide to check it against the next potential candidate. OTOH, if so-far
does not come before (first rest)
, we move to the else
line, which replaces so-far
with (first rest)
as the new so-far
.
Jumping back to the sort
procedure, sort
joins the result of (earliest-word sent)
together in a sentence with a recursive call to itself, but the particular argument used is interesting. sort
takes a sentence as an argument. sort
recursively calls itself with the first instance of the earliest word in the sentence removed from the sentence. In this way, the earliest word can be found.
My Solution (Editing Sort)
So my procedure in solving this problem was pretty straightforward. I decided that before?
was the critical thing that made this procedure an “alphabetical sorter”. If we wanted to generalize the functionality, we’d need to get our function into the earliest-helper
procedure so that it could replace before?
. So I made the necessary adjustments to the arguments (and changed the name to sort2
) and did just that:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
(define (remove-once wd sent)
(cond ((empty? sent) '())
((equal? wd (first sent)) (bf sent))
(else (se (first sent) (remove-once wd (bf sent))))))
(define (earliest-helper so-far rest fn)
(cond ((empty? rest) so-far)
((fn so-far (first rest))
(earliest-helper so-far (bf rest) fn))
(else (earliest-helper (first rest) (bf rest) fn))))
(define (earliest-word sent fn)
(earliest-helper (first sent) (bf sent) fn))
(define (sort2 sent fn)
(if (empty? sent)
'()
(se (earliest-word sent fn)
(sort2 (remove-once (earliest-word sent fn) sent) fn))))
|
With these adjustments, the procedure produced the desired output. We’ve generalized a sorting procedure! π
My Solution (Editing Mergesort)
The same basic method — adding a fn
argument and passing that down the chain of procedures to replace before?
– worked for editing mergesort
:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
<br />(define (other-half sent)
(if (<= (count sent) 1)
'()
(se (first (bf sent)) (other-half (bf (bf sent))))))
(define (one-half sent)
(if (<= (count sent) 1)
sent
(se (first sent) (one-half (bf (bf sent))))))
(define (merge fn left right)
(cond ((empty? left) right)
((empty? right) left)
((fn (first left) (first right))
(se (first left) (merge fn (bf left) right)))
(else (se (first right) (merge fn left (bf right))))))
(define (mergesort sent fn)
(if (<= (count sent) 1)
sent
(merge fn (mergesort (one-half sent) fn)
(mergesort (other-half sent) fn))))
|
β 19.10
Write
tree-map
, analogous to ourdeep-map
, but for trees, using thedatum
andchildren
selectors.
This problem is really underspecified IMHO. They should have at least given an example desired output like they do with lots of problems.
Here’s what they said about deep-map
:
This procedure converts every word in a structured list to Pig Latin. Suppose we have a structure full of numbers and we want to compute all of their squares. We could write a specific procedure
deep-square
, but instead, we’ll write a higher-order procedure:
1
2
3
4
5
|
(define (deep-map f structure)
(cond ((word? structure) (f structure))
((null? structure) '())
(else (cons (deep-map f (car structure))(deep-map f (cdr structure))))))
|
They want a tree-map
. Here’s what I find confusing … deep-map
can navigate a tree, I think? Like datum
just takes the car
of something and children
just takes the cdr
of something. Is this just about trying to get us to respect the data abstraction like they talked about in Chapter 18?
This was my attempt, which seemed kinda lame to me but I couldn’t figure out exactly why:
1
2
3
4
5
6
|
(define (tree-map f structure)
(cond ((not (list? structure)) (f structure))
((null? structure) '())
(else (cons (tree-map f (datum structure))
(tree-map f (children structure))))))
|
This seemed to work. For example, I could run pass a plural
function in and get the country names in the world-tree pluralized. But I was still feeling a bit stuck about what they were even asking for, so I decided to look at some other people’s answers.
Here’s Andrew Buntine’s:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
(define (leaf? node)
(null? (children node)))
(define (tree-map f tree)
(if (leaf? tree)
(make-node (f (datum tree)) '())
(cons (datum tree)
(tree-map-in-forest f (children tree)))))
(define (tree-map-in-forest f tree)
(if (null? tree)
'()
(cons (tree-map f (car tree))
(tree-map-in-forest f (cdr tree)))))
|
This solution uses mutual recursion. It also makes use of make-node
.
When I tried to use plural
on the world-tree with this solution, I got an error:
β 19.11
Write
repeated
. (This is a hard exercise!)
First Attempt (failed)
repeated
was described way back in chapter 8:
Here are some relatively straightforward examples of how it works:
I’ll name my procedure repeated2
.
First I’ll try doing what I want to accomplish in the interactions window. Here’s what I imagine I want my procedure to do for ((repeated2 square 2) 3)
(meaning: square 3 a total of two times):
Here was my first attempt:
1
2
3
4
5
|
(define (repeated2 fn copies) ; first attempt
(if (equal? copies 1)
(lambda (arg) (fn arg))
((lambda (arg) (fn arg)) (repeated2 fn (- copies 1)))))
|
For one copy of a procedure, it works fine:
But for two there’s a problem:
It looks like a procedure is being passed to the procedure I’m using as the fn
in this example, square
, instead of a number being passed to it. Why would that be happening? And why would it only be happening on the recursive call?
What I imagined happening in my mind was that repeated2
would arrive at the base case and then that base case lambda
would “grab” the input value (in this example, “3”), run the square procedure, and then percolate the calculation on up through the chain of recursive calls before arriving at an answer.
I think what is actually happening is that the base case lambda
doesn’t “grab” anything. Instead, it gets evaluated as being a procedure, and then that procedure gets fed in as the arg
for the lambda
one “step” up in the recursive chain, and then square
tries to evaluate that procedure, and then goes “wtf this is not a number! it is a procedure.”
So that’s why this failed.
Second Attempt (success!)
I borrowed some code from my solution to Exercise 9.13 in chapter 9:
1
2
3
4
5
6
7
8
|
(define (compose f g)
(lambda (arg) (f (g arg))))
(define (repeated2 fn copies)
(cond ((= copies 0) (lambda (arg) arg))
((= copies 1) (lambda (arg) (fn arg)))
(else (compose fn (repeated2 fn (- copies 1))))))
|
If the number of copies desired is greater than 1, repeated2
invokes compose
with fn
as the first function and the second function as the result of recursively calling repeated2
with 1 less than the current number of copies. So we build up a chain of compose fn (compose fn ...
until ultimately arriving at one copy, in which case we just invoke the fn on an argument. So for something like ((repeated2 square 3)2)
we get…
1
2
3
|
((compose square (compose square (lambda (arg)
(square arg))))2)
|
When the base case of 1 copy is arrived at, lambda
procedure gets evaluated and a procedure that applies a function fn
to an argument arg
is returned. This unnamed lambda procedure gets composed by the compose
closest to the base case, and compose is, after all, looking for a procedure g
that takes an argument arg
to compose with f
. And then we have a procedure (fn (fn arg))
serving as g
to an instance of compose
“further up” the recursive tree, which in turn gets composed with fn
once again. And since compose
returns a procedure, this last instance actually gets returned and can be applied to the value we want to work on.
So, step by step, when the lambda in the base case gets evaluated, we have a procedure that applies a function to an argument.
1
2
|
(lambda (arg) (fn arg))
|
This function gets passed as the g
to compose
, which is a higher-order procedure, and which outputs another function, which takes a function of a function applied to an argument. With the example we are consider, this procedure takes the square of the square of an argument.
1
2
|
(lambda (arg) (fn (fn arg)))
|
When we get to 3 copies of the procedure, we have the following:
1
2
|
(lambda (arg) (fn (fn (fn arg))))
|
This, I think, is what the recursive invocations of compose
resolve into once the base case is reached and the evaluations begin. And I can see why it works … like the syntax makes sense. In my first attempted solution, the way I structured the procedure was such that I was providing one procedure another procedure as an argument when it expected a value (like a number). But here, we don’t have that. Things are getting the arguments they expect to get.
β 19.12
Write
tree-reduce
. You may assume that the combiner argument can be invoked with no arguments.
I tried this but it’s pretty limited and requires manually specifying identities:
1
2
3
4
5
6
7
8
9
10
11
12
13
|
(define (identity fn)
(cond ((equal? fn +) 0)
((equal? fn word) "")
((member? fn (se sentence)) '())
(else 'idk)))
(define (tree-reduce fn tree)
(cond ((empty? tree) (identity fn))
((not (list? tree)) tree)
(else (fn (tree-reduce fn (car tree))
(tree-reduce fn (cdr tree))))))
|
I tried looking at buntine’s solution:
1
2
3
4
5
6
7
8
9
10
11
12
|
(define (tree-reduce func tree)
(if (null? tree)
#f
(func (datum tree) (tree-reduce-in-forest func (children tree)))))
(define (tree-reduce-in-forest func tree)
(if (null? tree)
(func)
(func (tree-reduce func (car tree))
(tree-reduce-in-forest func (cdr tree)))))
|
It seems to work. What’s going on here?
If the tree is null, tree-reduce
returns false. Otherwise it invokes the function on the datum of the tree and then invokes tree-reduce-in-forest
on the children of the tree.
tree-reduce-in-forest
just calls the func
if the tree is null. I think this addresses the issue I was having with wanting to return the identity. A bunch of procedures return the identity if you invoke them with nothing:
Anyways, if the tree isn’t null, the procedure invokes the argument function on the result of calling tree-reduce
with the car
of tree and tree-reduce-inforest
with the cdr
. This is mutual recursion.
I also checked out Meng Zhang’s solution:
1
2
3
4
5
6
7
8
9
10
11
|
(define (tree-reduce combiner tree)
(if (leaf? tree)
(datum tree)
(combiner (datum tree) (forest-reduce combiner (children tree)))))
(define (forest-reduce combiner forest)
(if (null? (cdr forest))
(tree-reduce combiner (car forest))
(combiner (tree-reduce combiner (car forest))
(forest-reduce combiner (cdr forest)))))
|
I intuitively like this one a bit better.
So if the tree is a leaf, we just return the datum of the tree. Otherwise we invoke the combiner argument function (such as +
) on the result of getting the (datum tree)
and the value returned by the forest-reduce
procedure invoked with the children of tree. We see another mutual recursion pattern here.
Within forest-reduce
, if the cdr forest
is null (in other words, if the node being examined represents a leaf) then the car
of the node is passed back to tree-reduce
, where the datum
will ultimately be returned. Otherwise, we invoke the combiner
on the result of calling tree-reduce
with the car
of the node and forest-reduce
with the cdr
.
β 19.13
Write
deep-reduce
, similar totree-reduce
, but for structured lists:
My Solution
I figured out a couple of variants that seemed to work on the test input the book gives.
First, I imported some procedures from The Little Schemer:
1
2
3
4
5
6
7
8
9
10
11
12
|
(define lat?
(lambda (l)
(cond
((null? l) #t)
((atom? (car l)) (lat? (cdr l)))
(else #f))))
(define atom?
(lambda (x)
(and (not (pair? x))
(not (null? x)))))
|
Here’s my first variant procedure that seems to work:
1
2
3
4
5
6
7
8
9
10
11
12
|
(define (deep-reduce fn lst)
(cond
((atom? lst) lst)
(else (fn (deep-reduce fn (car lst))
(deep-reduce-helper fn (cdr lst))))))
(define (deep-reduce-helper fn lst)
(cond
((lat? lst)(apply fn lst))
(else (fn (deep-reduce fn (car lst))
(deep-reduce-helper fn (cdr lst))))))
|
And here’s the second:
1
2
3
4
5
6
7
8
9
10
11
12
13
|
(define (deep-reduce fn lst)
(cond
((atom? lst) lst))
((lat? lst)(apply fn lst))
(else (fn (deep-reduce fn (car lst))
(deep-reduce-helper fn (cdr lst))))))
(define (deep-reduce-helper fn lst)
(cond
((null? lst)(fn))
(else (fn (deep-reduce fn (car lst))
(deep-reduce-helper fn (cdr lst))))))
|
Both variants return the lst
when it’s an atom, apply the function fn
to the list when it’s a list of atoms, and otherwise dig deeper into the function while invoking the fn
on the results of that digging.
Other Solutions
I compared my answer to some others.
Here’s Meng Zhang’s:
1
2
3
4
5
6
7
8
9
10
11
12
|
(define (deep-reduce combiner structure)
(if (not (empty? structure))
(real-deep-reduce combiner structure)
(combiner)))
(define (real-deep-reduce combiner structure)
(cond ((word? structure) structure)
((null? (cdr structure)) (real-deep-reduce combiner (car structure)))
(else (combiner (real-deep-reduce combiner (car structure))
(real-deep-reduce combiner (cdr structure))))))
|
I wonder about testing for word?
here, since that kind of hardcodes what data type you’re looking for.
You can see that all the real action happens in the real-deep-reduce
procedure. Also his deep-reduce
is kind of a mirror of my deep-reduce-helper
– both check if the structure is empty, and return the identity of the combining function if it is.
Here’s Andrew Buntine’s:
1
2
3
4
5
6
7
8
|
(define (deep-reduce func lst)
(cond ((null? lst) (func))
((list? (car lst))
(func (deep-reduce func (car lst))
(deep-reduce func (cdr lst))))
(else (func (car lst)
(deep-reduce func (cdr lst))))))
|
I’d wondered if it was possible to do everything in one procedure.
So Andrew’s solution uses the calling-the-function-to-return-the-identity-element trick in the null check.
Then if the first element is a list, it calls deep-reduce
on both the car and the cdr of the list.
Otherwise, it applies the function to the car of the list and calls deep-reduce
on the cdr.
I found this procedure easy to follow in terms of figuring out what was going on.