tag:blogger.com,1999:blog-168891652024-03-07T10:24:13.383+05:30Mentioned In DispatchesManoj Govindan's BlogManoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.comBlogger69125tag:blogger.com,1999:blog-16889165.post-7141417721879845422013-09-12T18:06:00.000+05:302013-09-12T18:06:13.418+05:30Eating "nachos" in BangaloreWikipedia defines <a href="http://en.wikipedia.org/wiki/Nachos">Nachos</a> as "a popular food based on nixtamalized corn, of Mexican origin". I've had nachos before, in India as well as outside it. The one thing common to all my experiences was corn. No matter where I ate, nachos always meant corn (chips). Then came <a href="http://www.californiaburrito.in/">California Burrito</a> (specifically the one in <a href="http://www.zomato.com/bangalore/california-burrito-koramangala">Koramangala, Bangalore</a>). I had lunch there today and made the mistake of ordering nachos. They served "nachos" made of <a href="http://en.wikipedia.org/wiki/Maida_flour">maida</a>! For those not in the know, maida is "is a finely milled and refined and bleached wheat flour". If you have ever had <a href="http://en.wikipedia.org/wiki/Samosa">samosas</a>, you probably have tasted maida. Samosa shells are most commonly made of maida. <br />
<br />
The "nachos" were unappetizing to say the least. Imagine eating samosa shells with guacamole and sour cream! Someone (not me) asked about the maida and was told that everything they served had been "adapted for India". What rubbish! If you <i>must</i> "Indianize" (it still makes no sense to me), then at least show the courtesy of announcing it on your menu. <br />
<br />
I am told that the story is the same for their burritos and tacos. Everything tastes like Indian <a href="http://en.wikipedia.org/wiki/Roti">rotis</a>/chapatis because of the wheat. Now I'm fine with people customizing their food but I expect to be told upfront if the food being served has been customized. I took 'California Burrito' and 'nachos' at face value and did not get what I paid for. I won't be visiting them again. Taco Bell is not far away and looks like a much better choice.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com7tag:blogger.com,1999:blog-16889165.post-55534713068150185302011-01-25T00:15:00.016+05:302011-02-02T20:57:27.005+05:30Quick review: Sapna book house KoramangalaI checked out <a href="http://www.sapnaonline.com/">Sapna</a> book house in Koramangala today. Sapna is one of the old players in the book store market. They were in Bangalore way before newer stores like <a href="http://www.landmarkonthenet.com/">Landmark</a> and <a href="http://www.crossword.in/">Crossword</a> opened branches here. The Koramangala branch is the latest in their steadily expanding chain.
<br/><br/>
The first thing that caught my eye was the layout of the place. The shop is located in a brand new four storey building served by a single elevator. Ground and first floors stock stationery, movies, computer games and the like. Books are stocked in the second and third floors with the latter dedicated to technical and text books. The layout of the building reminded me of old Gangaram's in MG Road. Specifically the multi-floor building, the lone elevator and the distribution of wares across floors. Unlike G's however Sapna has kept the place clean, orderly, and dust free. No peeling paint or books stacked in the aisles here. They also have clean if tiny restrooms for men and women.
<br/><br/>
You can browse the collection reasonably well without needing help from staff. This is nice for an "old format" book store - I've rarely managed to dig up books in Gangaram's without help from their employees.
<br/><br/>
My first target was the history section. Unfortunately there isn't one. There is a section for biographies but that's about it. Sapna uses the non-fiction section as a catch-all for everything from "How to improve your sex life" to "Rise and Fall of the Third Reich" (no pun intended). Contrast this with say any of <a href="http://www.strandbookstall.com/">The Strand</a>, Landmark or Crossword. All three of them boast decent sized history sections. Landmark even has a separate section for military history.
<br/><br/>
The fiction section contains mostly popular books. I thought it compared well with other bookstores. A rather sparse science fiction section is housed together with the humor section. Perhaps they find science fiction a joke? :P There is no separate grouping for fantasy titles. Again Landmark, Crossword etc. make this distinction.
<br/><br/>
I found Sapna's collection of comics rather lacking. While the staples are all there - <a href="http://en.wikipedia.org/wiki/The_Adventures_of_Tintin">The Adventures of Tintin</a>, <a href="http://en.wikipedia.org/wiki/Asterix">Asterix and Obelix</a>, <a href="http://en.wikipedia.org/wiki/Amar_Chitra_Katha">Amar Chithra Katha</a> (Amar Chithra Katha even a separate section) there isn't much else. A few issues of Spiderman were placed below a boxed set of Maus. No sign of other popular DC or Marvel volumes let alone comic novels like Sandman, V for Vendetta or 100 Bullets, to name a few. I couldn't find any Anime/Manga titles either.
<br/><br/>
Fourth floor sets aside a lot of space to technical and text books. All computer science books are grouped under "computers". There are a dozen shelves titled computers making it tricky to look up specific books.
<br/><br/>
If there is one area that Sapna beats the competition it is in Kannada books. They have dedicated half a dozen shelves to stock Kannada volumes. I can't comment on the quality of the titles though.
<br/><br/>
Sapna is one of those bookstores who don't seem to expect their customers to read the books in the store. There are no chairs in the aisles, not even plastic footstools. Even the more crowded Landmark with its narrower aisles has a few cushioned seats, not to mention the comfortable upholstered sofas and chairs in Crossword.
<br/><br/>
In spite of the five floors there is only one elevator. Most of the customers trudged up and down the stairs. A sign board placed next to the elevator doors asks customers to use they stairs if they like to stay fit. I think stairs are fine when you have two floors (Landmark and Crossword, the former even sports an escalator) but with four they become irritating.
<br/><br/>
Billing is in the ground floor. There are nine counters but only three accept payment. Others are variously for delivery, issuing membership cards etc. The payment and delivery counters are helpfully located next to each other.
<br/><br/>
<span style="font-weight:bold;">Post script</span>: I find a store modeled after ol' Gangaram's in a brand new building in Karamangala very surprising. I believe that there is a lot of demand for more bookstalls like Landmark and Crossword. Why don't old brands like Sapna try to meet that demand? Are they content to get by with volume sales alone?Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com4tag:blogger.com,1999:blog-16889165.post-14706529687237512532010-12-27T16:00:00.010+05:302010-12-27T16:23:31.310+05:30A Comic Interlude(While I work up courage and energy to write about other things)
<br/><br/>
The comic strip <a href="http://en.wikipedia.org/wiki/Frazz">Frazz</a> offers insightful and witty takes on (American) school life. Its calligraphic style and appearance of the eponymous character has fueled <a href="http://en.wikipedia.org/wiki/Frazz#Comparisons_to_Calvin_and_Hobbes">speculation</a> that Frazz's creator Jef Mallett is actually Bill Watterson. Wikipedia seems to believe otherwise but hey, it is fun to speculate :P
<br/><br/>
Christmas day's Frazz comic offers a nod and wink to Calvin and Hobbes. Those who have enjoyed Calvin's early Christmas morning sorties to check for presents (and wake up his parents at ungodly hours) should get the reference easily enough.
<br/><br/>
<span style="font-weight:bold;">Frazz (Dec 25, 2010)</span>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhVJpyoh2qtAFMtV8fzlYlrSc10BaEk1OoM-UNOoaMiFGDemethpQJZe1ziufmAkFJ4eksH0ENodTo8YWb8ck8Azt9UUsFXOt9VgBfKe1T0fkMyyf5bmUatDwAE-JZqnjIZpvV3/s1600/largeimage.368c264287b0bd77975c2ae17c8d047a.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 102px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhVJpyoh2qtAFMtV8fzlYlrSc10BaEk1OoM-UNOoaMiFGDemethpQJZe1ziufmAkFJ4eksH0ENodTo8YWb8ck8Azt9UUsFXOt9VgBfKe1T0fkMyyf5bmUatDwAE-JZqnjIZpvV3/s320/largeimage.368c264287b0bd77975c2ae17c8d047a.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5555309199230306450" /></a>
<br/><br/>
<span style="font-weight:bold;">Calvin and Hobbes (Dec 25, 199?) </span>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjdzOMlZ0MUeqlzPVUmcbuqgLdOjTfljXxJD9f37JHM_WqrssbB12LwPPaJJY4beqDhgN9XKGc9Qk4FCHYDfweGkTJLR64CwXyhGBo0nW4lCAV-jumDvIiD7AZRPag2gBHYJdMA/s1600/ch101225.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 102px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjdzOMlZ0MUeqlzPVUmcbuqgLdOjTfljXxJD9f37JHM_WqrssbB12LwPPaJJY4beqDhgN9XKGc9Qk4FCHYDfweGkTJLR64CwXyhGBo0nW4lCAV-jumDvIiD7AZRPag2gBHYJdMA/s320/ch101225.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5555309554147274482" /></a>
<br/><br/>
I am not surprised - Jeff Mallett has acknowledged Watterson's influence and this is not the first time he has <a href="http://comics.com/frazz/2006-11-29/">tipped</a> <a href="http://comics.com/frazz/2003-09-21/">his hat</a> at Watterson.
<br/><br/>
In case you didn't know already, you can read both <a href="http://comics.com/frazz/">Frazz</a> and <a href="http://www.gocomics.com/calvinandhobbes/">Calvin and Hobbes</a> online.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-83463896549568836042010-09-10T22:00:00.003+05:302010-09-10T22:13:22.879+05:30Re: Why Django SucksI recently came across this <a href="http://www.scribd.com/doc/37113340/Why-Django-Sucks-and-How-we-Can-Fix-it">presentation</a> on 'Why Django Sucks' and the associated <a href="http://news.ycombinator.com/item?id=1673457">discussion</a> in Hacker News.
<br/><br/>
One of the key points raised was the perceived insularity of Django's core development community. In this context I have an anecdote to share about the core community or rather how the core community is frequently sloppy with the triage process.
<br/><br/>
I reported a <a href="http://code.djangoproject.com/ticket/6559">Django bug</a> and more importantly submitted <a href="http://code.djangoproject.com/attachment/ticket/6559/m2m_sqlite_windows.diff">tests</a> for it. The bug languished for a while and eventually got fixed as a side effect of some changes. I <a href="http://code.djangoproject.com/ticket/6559#comment:4">reported</a> this when I found out and a month later someone <a href="http://code.djangoproject.com/ticket/6559#comment:5">closed</a> it. The regression tests, however, never made it to the test suite.
<br/><br/>
I believe that (1) people who take their time to give you a test are doing you a favor (2) one should never miss a chance to add a valid regression test to the suite.
<br/><br/>
I don't think there was any malice or hubris but the closed nature of the community did have something to do with this. I suspect that how fast and how thoroughly a bug is accepted and processed depends on who submits it. This will prove unhealthy in the long run.
<br/><br/>
So what can be done to address this? I believe that the bug triage process will benefit from more eyes. These don't have to be those of core developers but of people with the authority to take decisions on bugs. The community should also actively encourage people to submit more tests. Spread the word that this is as important as submitting patches.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-79311829564613201892010-07-08T14:18:00.011+05:302010-07-08T14:30:25.876+05:30Setting up a color scheme for EmacsI am an <a href="http://www.gnu.org/software/emacs/">Emacs</a> newbie. I found a <a href="http://github.com/marktran/color-theme-chocolate-rain/blob/master/color-theme-chocolate-rain.el">nice color theme</a> for Emacs and wanted to set it as default. Following the instructions from the <a href="http://www.nongnu.org/color-theme/">color-scheme homepage</a> did not work. After some searching I found out a way to make it work.
<br/><br/>
I installed <code>emacs-goodies-el</code> using <code>apt-get</code> and put the following in my <code>$HOME/.emacs.el</code> file:
<br/>
<textarea name="code" class="sch" cols="60" rows="10">
(require 'color-theme)
(load-file "/path/to/color-theme-chocolate-rain.el")
(color-theme-chocolate-rain)
</textarea>
<br/>
I am reproducing this here in the hope that someone else will find it useful. I am running <code>Emacs 22.2.1 (i486-pc-linux-gnu, GTK+ Version 2.16.1) of 2010-03-26 on palmer, modified by Ubuntu</code> on Ubuntu Jaunty.
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-89407270714465799602010-06-25T10:41:00.005+05:302010-06-25T10:46:11.908+05:30Indian Software quote of the dayA friend was asked to translate the following sentence to another language. The author was an "experienced senior software engineer" in a large Indian software services company.
<br/><br/>
"<span style="font-style:italic;">We were bit used to use remote desktop, but I will do the necessary actions to check this option and shift the full activity independent for the remote option.</span>"
<br/><br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-73832508955189752202010-03-08T15:15:00.030+05:302010-03-08T17:45:57.556+05:30Reading Notes #3: Ring BenchmarkI have been working my way through Joe Armstrong's <a href="http://www.pragprog.com/titles/jaerlang/programming-erlang">Programming in Erlang</a>. One of the exercises in chapter 8 is to write a "ring benchmark" in Erlang and any other language, compare the results and publish them.
<br/><br/>
<span style="font-style:italic;">Write a ring benchmark. Create N processes in a ring. Send a message round the ring M times so that a total of N * M messages get sent. Time how long this takes for different values of N and M. Write a similar program in some other programming language you are familiar with. Compare the results. Write a blog, and publish the results on the Internet!</span>
<br/><br/>
Here are my benchmarks written in <a href="http://erlang.org/">Erlang</a> and <a href="http://www.python.org/">Python</a> respectively. I have presumed that the author meant sending messages <span style="font-style:italic;">synchronously</span>; i.e. a message has to go around the whole ring before the next can be sent.
<br/><br/>
The Erlang version was easy to write. After all the language is designed to use a processes and messages paradigm of programming. Here is the source code:
<br/>
<textarea name="code" class="erlang" cols="60" rows="10">
-module(pring).
%%
%% Exported Functions
%%
-export([run/2]).
-ifdef(debug).
-define(DEBUG(Format, Args), io:format(Format, Args)).
-else.
-define(DEBUG(Format, Args), void).
-endif.
%%
%% API Functions
%%
run(N, M) when is_integer(N), is_integer(M), N > 0, M > 0 ->
time_it(fun() -> start(N, M) end).
%%
%% Local Functions
%%
time_it(F) when is_function(F) ->
statistics(runtime),
statistics(wall_clock),
Result = F(),
{_, CPUTime} = statistics(runtime),
{_, ElapsedTime} = statistics(wall_clock),
{Result, CPUTime/1000, ElapsedTime/1000}.
start(N, M) when is_integer(N), is_integer(M), N > 0, M > 0 ->
This = self(),
First = spawn(fun() -> loop(This, This) end),
?DEBUG("Creating ~p for N = ~p~n", [First, N]),
Last = create(First, First, N - 1),
First ! {realign, First, Last},
First ! {relay, message, M, This},
receive
{done, message} ->
N * M
end.
create(First, Previous, N) when is_pid(First), is_pid(Previous), is_integer(N), N > 0 ->
Pid = spawn(fun() -> loop(First, Previous) end),
?DEBUG("Creating ~p for N = ~p~n", [Pid, N]),
create(First, Pid, N - 1);
create(First, Previous, 0) when is_pid(First), is_pid(Previous) ->
Previous.
send_relay_message(Target, Message, M, ReportBack) when is_pid(Target), is_integer(M), is_pid(ReportBack) ->
?DEBUG("~p => ~p (M = ~p) ~n", [self(), Target, M + 1]),
Target ! {relay, Message, M, ReportBack}.
loop(First, Previous) when is_pid(First), is_pid(Previous) ->
This = self(),
receive
{realign, NewFirst, NewPrevious} when is_pid(NewFirst), is_pid(NewPrevious) ->
?DEBUG("I am ~p Realigning: First ~p to ~p, Previous ~p to ~p~n", [This, First, NewFirst, Previous, NewPrevious]),
loop(NewFirst, NewPrevious);
{relay, Message, M, ReportBack} when is_integer(M), is_pid(ReportBack), This =:= First, M > 0 ->
send_relay_message(Previous, Message, M - 1, ReportBack),
loop(First, Previous);
{relay, Message, M, ReportBack} when is_integer(M), is_pid(ReportBack), This =:= First, M =:= 0 ->
?DEBUG("I am ~p All rounds of relay over~n", [This]),
ReportBack ! {done, Message},
void;
{relay, Message, M, ReportBack} when is_integer(M), is_pid(ReportBack), This =/= First, M > 0 ->
send_relay_message(Previous, Message, M, ReportBack),
loop(First, Previous);
{relay, Message, M, ReportBack} when is_integer(M), is_pid(ReportBack), This =/= First, M =:= 0 ->
send_relay_message(Previous, Message, M, ReportBack),
void;
_Other ->
?DEBUG("I am ~p I don't understand ~p~n", [This, _Other]),
loop(First, Previous)
end.
</textarea>
<br/>
I wrote the "other programming language" version in Python. The benchmark code makes use of Python's <a href="http://docs.python.org/library/multiprocessing.html">multiprocessing</a> module (available in version 2.6 and above). Since I couldn't find any Erlang-style way to directly send a message to a process I chose to use a set of <a href="http://docs.python.org/library/multiprocessing.html#multiprocessing.Queue">Queue</a> objects to accomplish message passing. Each process has access to two queues - an "in" queue to receive messages and an "out" queue to relay them to the next process in the ring. Each process' "out" queue serves as the "in" for the next. After constructing N - 1 processes, a "plug" process is created to complete the process ring.
<br/>
<textarea name="code" class="python" cols="60" rows="10">
from multiprocessing import Process, Pipe, Queue
import os, sys, argparse, time
def create(first, target, in_queue, n):
if n == 0:
return in_queue
out_queue = Queue()
process = Process(target = target, args = (first, in_queue, out_queue,))
process.start()
return create(first, target, out_queue, n - 1)
def send_relay_message(queue, message, m, sender):
queue.put(('relay', message, m,))
def loop(first, in_queue, out_queue):
this = os.getpid()
while True:
input_data = in_queue.get()
message_type = input_data[0]
if message_type == 'realign':
new_first = input_data[1]
first = new_first
elif message_type == 'relay':
(message, m) = input_data[1:]
if (this == first) and (m > 0):
send_relay_message(out_queue, message, m - 1, this)
elif (this == first) and (m == 0):
return
elif (this != first) and (m > 0):
send_relay_message(out_queue, message, m, this)
elif (this != first) and (m == 0):
send_relay_message(out_queue, message, m, this)
return
else:
print "I am %s. I do not understand %s" % (this, input_data)
if __name__ == '__main__':
parser = argparse.ArgumentParser(description = 'Run an N * M ring benchmark.')
parser.add_argument('-n', '--processes', help ='Number of Processes')
parser.add_argument('-m', '--messages', help = 'Number of Messages')
args = parser.parse_args(sys.argv[1:] or [])
n, m = map(int, (args.processes, args.messages))
start = time.time()
this = os.getpid()
first_in_queue = Queue()
first_out_queue = Queue()
first = Process(target = loop, args = [this, first_in_queue, first_out_queue])
first.start()
last_out_queue = create(first.pid, loop, first_out_queue, n - 2)
plug = Process(target = loop, args = [first, last_out_queue, first_in_queue])
plug.start()
first_in_queue.put(('realign', first.pid))
first_in_queue.put(('relay', 'hello', m))
first.join()
plug.join()
end = time.time()
print (end - start)
</textarea>
<br/>
I am not entirely convinced that Python's processes are the equivalent of Erlang ones. Certainly <a href="http://docs.python.org/library/threading.html">threads</a> are not the answer given their use of shared memory. Perhaps the difficulty in creating lightweight, shared-nothing processes in other languages is what the author wanted to illustrate using the example.
<br/><br/>
The results are shown below. The program was executed on a machine with a dual core Pentium, 2GB memory and running Ubuntu Jaunty.
<br/><br/>
Please note that:
<br/>
<ul>
<li>I could not increase the number of Python processes to the order of 1000 (10^3). When I tried to do this the program crashed with a number of errors.</li>
<li>I got a curious <code>QueueFeederThread</code> exception when I executed the process for N = 100, M = 10000. </li>
</ul>
<br/>
<table border="1" cellpadding="5" cellspacing="5">
<tr>
<th rowspan="2">N</th>
<th rowspan="2">M</th>
<th rowspan="2">N * M</th>
<th colspan="2">(Wall) Time in seconds</th>
</tr>
<tr>
<th>Erlang</th>
<th>Python</th>
</tr>
<tr>
<td>10</td>
<td>10</td>
<td>10^2</td>
<td>0.0</td>
<td>0.0732</td>
</tr>
<tr>
<td>10</td>
<td>100</td>
<td>10^3</td>
<td>0.003</td>
<td>0.1795</td>
</tr>
<tr>
<td>100</td>
<td>100</td>
<td>10^4</td>
<td>0.036</td>
<td>2.3976</td>
</tr>
<tr>
<td>100</td>
<td>1000</td>
<td>10^5</td>
<td>0.242</td>
<td>12.2252</td>
</tr>
<tr>
<td>1000</td>
<td>1000</td>
<td>10^6</td>
<td>1.877</td>
<td>-</td>
</tr>
<tr>
<td>1000</td>
<td>10000</td>
<td>10^7</td>
<td>18.593</td>
<td>-</td>
</tr>
<tr>
<td>10000</td>
<td>10000</td>
<td>10^8</td>
<td>197.477</td>
<td>-</td>
</tr>
</table>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-23232378882119153842009-11-17T14:11:00.014+05:302009-11-17T21:42:22.097+05:30Reading Notes #2: Passing functions as arguments to higher order functionsDoes <a href="http://www.erlang.org/index.html">Erlang</a> allow you to pass functions (not "funs" or anonymous functions) as arguments to <a href="http://en.wikipedia.org/wiki/Higher-order_function">higher order functions</a>? I was under the impression that it doesn't. To find out I <a href="http://twitter.com/egmanoj/status/5771294129">tweeted</a> a question about the same. After looking at the answers I decided to rephrase the question with the help of a concrete example. Here it goes:
<br/><br/>
Step 1: Define a function <code>add_one</code> in a module named <code>test</code>.
<br/>
<textarea name="code" class="erlang" cols="60" rows="10">
% test.erl
-module(test).
-export([add_one/1]).
add_one(X) -> X + 1.
</textarea>
<br/>
Step 2: Start the erlang shell and try to use this function.
<br/>
<textarea name="code" class="erlang" cols="60" rows="10">
1> c(test).
{ok,test}
2> test:add_one(2).
3
3> lists:map(test:add_one, [1, 2, 3]).
* 1: illegal expression
4> lists:map(fun(X) -> test:add_one(X) end, [1, 2, 3]).
[2,3,4]
5> lists:map(fun(X) -> X + 1 end, [1, 2, 3]).
[2,3,4]
6>
</textarea>
<br/>
As you can see I have tried three different combinations. Line #3 shows a call to the higher order function <code>lists:map</code> passing in the qualified name of the <code>add_one</code> function as first argument. The shell throws an error.
<br/><br/>
In Line #4 I wrap <code>test:add_one</code> inside a <code>fun</code> and it works.
<br/><br/>
In Line #5 I replicate the code of <code>add_one</code> inside an anonymous <code>fun</code> and everything works fine.
<br/><br/>
Contrast this with say, Python.
<br/><br/>
Definition:
<br/>
<textarea name="code" class="python" cols="60" rows="10">
def add_one(x): return x + 1
</textarea>
<br/>
Usage:
<br/>
<textarea name="code" class="python" cols="60" rows="10">
>>> from test import add_one
>>> map(add_one, [1, 2, 3])
[2, 3, 4]
>>>
</textarea>
<br/>
Now I'll repeat the question: Does Erlang allow you to pass functions (not "funs" or anonymous functions) as arguments to higher order functions? Or am I missing something?
<br/><br/>
Please share your thoughts in the comments.
<br/><br/>
<span style="font-weight:bold;">Update #1</span>:
<br/> Got an <a href="http://twitter.com/TheColonial/status/5792110510">answer</a>. There is a way to do it. It still involves using the <code>fun</code> keyword.
<textarea name="code" class="erlang" cols="60" rows="10">
1> c(test).
{ok,test}
2> lists:map(fun test:add_one/1, [1, 2, 3]).
[2,3,4]
3>
</textarea>
<br/>
<span style="font-weight:bold;">Update #2</span>:
<br/> Got <a href="http://twitter.com/justinsheehy/status/5796357792">another answer</a> which does *not* use <code>fun</code>. The syntax is just a little different. Thanks to <a href="http://blog.therestfulway.com/">Justin Sheehy</a>.
<textarea name="code" class="erlang" cols="60" rows="10">
1> c(test).
{ok,test}
2> lists:map({test,add_one}, [1, 2, 3]).
[2,3,4]
3>
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com2tag:blogger.com,1999:blog-16889165.post-90691724400022668112009-10-14T11:00:00.005+05:302009-10-14T12:10:38.467+05:30Reading Notes #1I have been reading Joe Armstrong's paper "<a href="http://www.sics.se/~joe/thesis/armstrong_thesis_2003.pdf">Making reliable distributed systems in the presence of software errors</a>" and making notes as I go. In chapter 3 the author gives examples of how Erlang handles higher order functions. One of them is a "generator" function.
<br/>
<textarea name="code" class="erlang" cols="60" rows="10">
1> Adder = fun(X) -> fun(Y) -> X + Y end end.
#Fun<erl_eval.5.123085357>
2> Adder10 = Adder(10).
#Fun<erl_eval.5.123085357>
3> Adder(10).
15
</textarea>
<br/>
Line 1 defines an <code>Adder</code> that returns another function with <code>X</code> bound to the input to <code>Adder</code>. In line 2 we create a specific adder - in this case a function that adds 10 to its input. I think line 3 was meant to show how the specific adder created in line 2 could be invoked. If <code>Adder10</code> were to be called with 5 as argument it would return 15. Instead <code>Adder</code> is invoked again and the result shown is not correct as <code>Adder(10)</code> would return a generator, not 15.
I think the snippet can be modified thus:
<br/>
<textarea name="code" class="erlang" cols="60" rows="10">
1> Adder = fun(X) -> fun(Y) -> X + Y end end.
#Fun<erl_eval.6.49591080>
2> Adder10 = Adder(10).
#Fun<erl_eval.6.49591080>
3> Adder10(5).
15
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-17596458381364481502009-08-10T03:29:00.005+05:302009-08-10T03:35:42.782+05:30Ticket #11627Logged another Django <a href="http://code.djangoproject.com/ticket/11627">ticket</a> related to test client. I find that most of my <a href="http://www.djangoproject.com/">Django</a> pet peeves are related to two areas: the ORM and testing framework.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-32016453371762265862009-07-23T11:12:00.004+05:302009-07-23T11:48:02.199+05:30DRY Logging in DjangoI have found custom logging a very useful tool for dealing with production issues. Especially when the users are not easily reachable. I recently configured custom logging messages for a <a href="http://www.djangoproject.com/">Django</a> project I have been working on. As logging is usually only initiated once per application I chose to do it in my <code>settings.py</code>. The code looked something like this:
<br/>
<textarea name="code" class="python" cols="60" rows="10">
import logging
import logging.handlers
logger = logging.getLogger('project_logger')
logger.setLevel(logging.INFO)
LOG_FILENAME = '/path/to/log/file/in/development'
handler = logging.handlers.TimedRotatingFileHandler(LOG_FILENAME, when = 'midnight')
formatter = logging.Formatter(LOG_MSG_FORMAT)
handler.setFormatter(formatter)
logger.addHandler(handler)
</textarea>
<br/>
This configuration worked out well in development. However I maintain a separate settings file for production, <code>production.py</code>. <code>Production.py</code> merely imports everything from <code>settings.py</code> and selectively overrides some of the attributes (set <code>DEBUG = False</code>, for instance).
<br/><br/>
My problem was that I wanted the production logs to be written to a different location and perhaps even use a different handler. I could not think of a good way to do this without calling the logging code fragment again in <code>production.py</code>. I wrote a utility function to do this (<code>configure_logging(filename)</code>). This reduced code repetition but revealed another problem. When <code>production.py</code> imports everything from <code>settings.py</code> it triggers logging to be configured once using the <code>LOG_FILENAME</code> attribute used in development and then *again* using the <code>LOG_FILENAME</code> attribute used in production.
<br/><br/>
This was ugly. For one there is no need to configure logging twice; for another the initial configuration throws an error if the path described by <code>LOG_FILENAME</code> in development is not present in the production machine.
<br/><br/>
I wasn't sure how to proceed and I posed this question at <a href="http://stackoverflow.com/questions/1147812/what-is-the-dry-way-to-configure-different-log-file-locations-for-different-setti">Stack Overflow</a>. I got an answer suggesting to switch <code>LOG_FILENAME</code> based on the <code>DEBUG</code> attribute. Something like this:
<br/>
<textarea name="code" class="python" cols="60" rows="10">
# Inside settings.py
if DEBUG:
LOG_FILENAME = '/path/to/log/file/in/development'
else:
LOG_FILENAME = '/path/to/log/file/in/production'
# Configure logging here.
</textarea>
<br/>
This looked good, but almost immediately revealed a problem. <code>DEBUG</code> is overridden *inside* <code>production.py</code> whereas this code snippet is inside <code>settings.py</code>. Consequently when the above given snippet gets executed <code>DEBUG</code> is still <code>True</code> and <code>LOG_FILENAME</code> will be pointed at the development environment.
<br/><br/>
I eventually found a solution from an answer to a <a href="http://stackoverflow.com/questions/342434/python-logging-in-django/343575#343575">different question</a>. User <a href="http://stackoverflow.com/users/13618/bluebird75">Bluebird75</a> suggested using the 'module singleton' pattern to ensure that logging is only configured once. I extended his(?) suggestion to come up with the following solution:
<br/>
<textarea name="code" class="python" cols="60" rows="10">
# Inside settings.py
LOG_FILENAME = '/path/to/log/file/in/development'
# Inside production.py
from settings import *
LOG_FILENAME = '/path/to/log/file/in/production'
# Singleton module log.py
import logging, logging.handlers
from django.conf import settings
LOGGING_INITIATED = False
def init_logging():
logger = logging.getLogger('project_logger')
logger.setLevel(logging.INFO)
handler = logging.handlers.TimedRotatingFileHandler(settings.LOG_FILENAME, when = 'midnight')
formatter = logging.Formatter(LOG_MSG_FORMAT)
handler.setFormatter(formatter)
logger.addHandler(handler)
if not LOGGING_INITIATED:
LOGGING_INITIATED = True
init_logging()
</textarea>
<br/>
The singleton module ensures that logging is only configured once. As this module resides within the app directory Django would already have loaded settings before this module is loaded, thereby ensuring the presence of <code>settings.LOG_FILENAME</code>. I can add as many settings files as I want and all I have to do is override the <code>LOG_FILENAME</code> attribute in each file.
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com6tag:blogger.com,1999:blog-16889165.post-30943106825113584552009-07-21T20:47:00.003+05:302009-07-21T20:50:25.978+05:30Ticket #11475Logged a <a href="http://www.djangoproject.com/">Django</a> bug related to <a href="http://code.djangoproject.com/ticket/11475">test client</a>. Part of my continuing series of adventures in Django.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-88320510899621388762009-07-12T22:29:00.004+05:302009-07-12T22:34:15.923+05:30Learning to write smaller sentencesI have started to use <a href="http://twitter.com/egmanoj">Twitter</a>. There are many things I'd like to write about that do not merit a blog post. Twitter is the right place to scribble in such cases. I hope to be a more regular writer using the new medium :)Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-27158278300725011722009-03-23T16:55:00.009+05:302009-03-30T02:39:57.865+05:30Quick and dirty serial numbers across pages in Django templates<span style="font-weight:bold;">Update</span>:
<br/><br/>
Scratch that. I just learned that this can be <a href="http://www.djangosnippets.org/snippets/1391/#c1763">done</a> in a much simpler way:
<br/>
<textarea name="code" class="html" cols="60" rows="10">
{% for object in object_list %}
{{ page_obj.start_index|add:forloop.counter0 }}
{% endfor %}
</textarea>
<br/>
I recently had to write a template for a <a href="http://docs.djangoproject.com/en/dev/topics/pagination/">paginated view</a> which displayed a serial number for each <code>object</code> in the <code>object_list</code>. I normally use <code>forloop.counter</code> for general purpose serial numbers. However this did not work with paginated views as the counter gets reset in each page. This caused the serial numbers to go from 1 to #-of-results-in-the-page and then repeat. I wrote a filter to tackle this problem.
<br/><br/>
The code (add to your filters file under ./templatetags/):
<br/>
<textarea name="code" class="python" cols="60" rows="10">
from django import template
from django.conf import settings
register = template.Library()
@register.filter
def adjust_for_pagination(value, page):
value, page = int(value), int(page)
adjusted_value = value + ((page - 1) * settings.RESULTS_PER_PAGE)
return adjusted_value
</textarea>
<br/>
And the template snippet:
<br/>
<textarea name="code" class="html" cols="60" rows="10">
{% for object in object_list %}
<div class="serial-no">
{% if is_paginated %}
{{ forloop.counter|adjust_for_pagination:page }}
{% else %}
{{ forloop.counter }}
{% endif %}
</div>
...
{% endfor %}
</textarea>
<br/>
The <code>adjust_for_pagination</code> filter adjusts the value of <code>forloop.counter</code> based on the current page. <code>Page</code> and <code>is_paginated</code> variables are expected to be present in the context. These should respectively denote the current page number (1 based) and if the results are paginated. <code>RESULTS_PER_PAGE</code> is currently taken from the settings file. I couldn't think of a way to pass this value also from the template.
<br/><br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-19835792165648966562009-03-08T14:26:00.018+05:302009-03-08T14:55:02.443+05:30SICP Section 5.2 A Register-Machine Simulator<span style="font-weight:bold;">Exercise 5.7.</span> Use the simulator to test the machines you designed in exercise 5.4.
<br/><br/>
<span style="font-weight:bold;">Answer:</span> <br/>
1. Recursive Version
<br/>
<textarea name="code" class="sch" cols="60">
(define expt-machine
(make-machine
'(n b val continue)
(list (list '= =) (list '- -) (list '* *))
'(controller
(assign continue (label expt-done))
expt-loop
(test (op =) (reg n) (const 0)) ;; Test for (= n 0)
(branch (label base-case))
;; We only need to save continue as b is constant throughout
;; and the successive values of n are not used for calculation.
(save continue)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-expt))
(goto (label expt-loop))
after-expt
(restore continue)
(assign val (op *) (reg b) (reg val))
(goto (reg continue))
base-case
(assign val (const 1))
(goto (reg continue))
expt-done)))
(set-register-contents! expt-machine 'n 2)
done
(set-register-contents! expt-machine 'b 4)
done
(start expt-machine)
done
(get-register-contents expt-machine 'val)
16
</textarea>
<br/>
2. Iterative Version
<br/>
<textarea name="code" class="sch" cols="60">
(define expt-machine
(make-machine
'(n b counter product)
(list (list '= =) (list '- -) (list '* *))
'(controller
(assign counter (reg n))
(assign product (const 1))
expt-loop
(test (op =) (reg counter) (const 0))
(branch (label expt-done))
;; We don't have to save any value in the stack.
;; The result of exponentiation will be available in register product at the end of calculation.
(assign counter (op -) (reg counter) (const 1))
(assign product (op *) (reg b) (reg product))
(goto (label expt-loop))
expt-done)))
(set-register-contents! expt-machine 'n 2)
done
(set-register-contents! expt-machine 'b 4)
done
(start expt-machine)
done
(get-register-contents expt-machine 'product)
16
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.8.</span> The following register-machine code is ambiguous, because the label here is defined more than once:
<br/>
<textarea name="code" class="sch" cols="60">
start
(goto (label here))
here
(assign a (const 3))
(goto (label there))
here
(assign a (const 4))
(goto (label there))
there
</textarea>
<br/>
With the simulator as written, what will the contents of register a be when control reaches there? Modify the extract-labels procedure so that the assembler will signal an error if the same label name is used to indicate two different locations.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Using the current implementation <tt>goto</tt> will direct control to the first occurrence of the label here in the sequence of instructions. This means that <tt>(assign a (const 3))</tt> will get executed before control proceeds to the label <tt>there</tt>. Therefore register a will contain the value 3 at the end of execution.
<br/><br/>
This version of <tt>extract-labels</tt> checks if a given label is already present in the labels processed so far. If so it raises an error.
<br/>
<textarea name="code" class="sch" cols="60">
(define (extract-labels text receive)
(if (null? text)
(receive '() '())
(extract-labels (cdr text)
(lambda (insts labels)
(let ((next-inst (car text)))
(if (symbol? next-inst)
(begin
(if (assoc next-inst labels)
(error "Multiple declarations of label -- EXTRACT-LABELS" next-inst))
(receive insts
(cons (make-label-entry next-inst
insts)
labels)))
(receive (cons (make-instruction next-inst)
insts)
labels)))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.9.</span> The treatment of machine operations above permits them to operate on labels as well as on constants and the contents of registers. Modify the expression-processing procedures to enforce the condition that operations can be used only with registers and constants.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I have moved the code that generates <tt>aprocs</tt> for an operation expression to a helper procedure. This procedure will raise and error if any of the operands of the expression is not a register or a constant.
<br/>
<textarea name="code" class="sch" cols="60">
(define (generate-operation-aprocs exp machine labels)
(map (lambda (e)
(if (or (register-exp? e) (constant-exp? e))
(make-primitive-exp e machine labels)
(error "Operations can only be used with registers and constants -- ASSEMBLE" e)))
(operation-exp-operands exp)))
(define (make-operation-exp exp machine labels operations)
(let ((op (lookup-prim (operation-exp-op exp) operations))
(aprocs (generate-operation-aprocs exp machine labels)))
(lambda ()
(apply op (map (lambda (p) (p)) aprocs)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.10.</span> Design a new syntax for register-machine instructions and modify the simulator to use your new syntax. Can you implement your new syntax without changing any part of the simulator except the syntax procedures in this section?
<br/><br/>
Skipping.
<br/><br/>
<span style="font-weight:bold;">Exercise 5.11.</span> When we introduced save and restore in section 5.1.4, we didn't specify what would happen if you tried to restore a register that was not the last one saved, as in the sequence
<br/>
<textarea name="code" class="sch" cols="60">
(save y)
(save x)
(restore y)
</textarea>
<br/>
There are several reasonable possibilities for the meaning of restore:
<br/><br/>
a. (restore y) puts into y the last value saved on the stack, regardless of what register that value came from. This is the way our simulator behaves. Show how to take advantage of this behavior to eliminate one instruction from the Fibonacci machine of section 5.1.4 (figure 5.12).
<br/><br/>
b. (restore y) puts into y the last value saved on the stack, but only if that value was saved from y; otherwise, it signals an error. Modify the simulator to behave this way. You will have to change save to put the register name on the stack along with the value.
<br/><br/>
c. (restore y) puts into y the last value saved from y regardless of what other registers were saved after y and not restored. Modify the simulator to behave this way. You will have to associate a separate stack with each register. You should make the initialize-stack operation initialize all the register stacks.
<br/><br/>
<span style="font-weight:bold;">Answer:</span> <br/>
a. The first two statements under the label <tt>afterfib-n-2</tt> perform the following actions: <br/>
1) Transfer the value of <tt>val</tt> to <tt>n</tt>. This means copying <tt>fib(n - 2)</tt> to <tt>n</tt>. <br/>
2) Restore previously saved <tt>fib(n - 1)</tt> to <tt>val</tt>. <br/>
<tt>N</tt> and <tt>val</tt> are subsequently added to yield <tt>fib(n)</tt>.
<br/><br/>
These two statements can be replaced with a single <tt>restore</tt> statement. Consider executing <tt>(restore n)</tt> instead of these two statements. As <tt>fib(n - 1)</tt> was the last value restored on the stack n will be assigned the value <tt>fib(n - 1)</tt>. <tt>Val</tt> already contains <tt>fib(n - 2)</tt>. We can proceed to add them together and still get <tt>fib(n)</tt>.
<br/><br/>
b. <tt>Save</tt> instruction has been changed to pass the register name to the stack along with its value. The stack will maintain a list of register-name/value tuples. <tt>Pop</tt> has been changed to pass the target register name as a parameter. Stack will raise an error if the target register name is not the same as the name associated with the top value in the stack.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-save inst machine stack pc)
(let ((reg (get-register machine
(stack-inst-reg-name inst)))
(reg-name (stack-inst-reg-name inst)))
(lambda ()
(push stack reg-name (get-contents reg))
(advance-pc pc))))
(define (push stack reg-name value)
((stack 'push) reg-name value))
(define (make-restore inst machine stack pc)
(let ((reg (get-register machine
(stack-inst-reg-name inst)))
(reg-name (stack-inst-reg-name inst)))
(lambda ()
(set-contents! reg (pop stack reg-name))
(advance-pc pc))))
(define (pop stack reg-name)
((stack 'pop) reg-name))
(define (make-stack)
(let ((s '()))
(define (push reg x)
(set! s (cons (list reg x) s)))
(define (pop reg)
(if (null? s)
(error "Empty stack -- POP")
(let ((top (car s)))
(cond ((eq? (car top) reg)
(set! s (cdr s))
(cadr top))
(else
(error "Register mismatch -- POP" reg (car top)))))))
(define (initialize)
(set! s '())
'done)
(define (dispatch message)
(cond ((eq? message 'push) push)
((eq? message 'pop) pop)
((eq? message 'initialize) (initialize))
(else (error "Unknown request -- STACK"
message))))
dispatch))
</textarea>
<br/>
c. A new table named <tt>stack-table</tt> will maintain a list of register names and associated stacks. <tt>Allocate-register</tt> will create a new entry in this table each time a new register is allocated. <tt>Make-save</tt> will first get the appropriate stack from the machine before pushing the value in. Similarly <tt>make-restore</tt> will first retrieve the appropriate stack before popping the value.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(stack-table '()))
(define (initialize-stack-table)
(for-each (lambda (stack)
(stack 'initialize))
(map cadr stack-table)))
(let ((the-ops
(list (list 'initialize-stack initialize-stack-table)))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(begin
(set! register-table
(cons (list name (make-register name))
register-table))
(allocate-stack-for-register name)))
'register-allocated)
(define (allocate-stack-for-register name)
(set! stack-table
(cons (list name (make-stack)) stack-table)))
(define (get-register-stack name)
(let ((record (assoc name stack-table)))
(if record
(cadr record)
(error "No stack found for register" name))))
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
((instruction-execution-proc (car insts)))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'get-register-stack) get-register-stack)
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (get-register-stack machine register-name)
((machine 'get-register-stack) register-name))
(define (make-save inst machine stack pc)
(let ((reg (get-register machine (stack-inst-reg-name inst)))
(stack (get-register-stack machine (stack-inst-reg-name inst))))
(lambda ()
(push stack (get-contents reg))
(advance-pc pc))))
(define (make-restore inst machine stack pc)
(let ((reg (get-register machine (stack-inst-reg-name inst)))
(stack (get-register-stack machine (stack-inst-reg-name inst))))
(lambda ()
(set-contents! reg (pop stack))
(advance-pc pc))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.12.</span> The simulator can be used to help determine the data paths required for implementing a machine with a given controller. Extend the assembler to store the following information in the machine model:
<br/><br/>
* a list of all instructions, with duplicates removed, sorted by instruction type (assign, goto, and so on);
<br/><br/>
* a list (without duplicates) of the registers used to hold entry points (these are the registers referenced by goto instructions);
<br/><br/>
* a list (without duplicates) of the registers that are saved or restored;
<br/><br/>
* for each register, a list (without duplicates) of the sources from which it is assigned (for example, the sources for register val in the factorial machine of figure 5.11 are (const 1) and ((op *) (reg n) (reg val))).
<br/><br/>
Extend the message-passing interface to the machine to provide access to this new information. To test your analyzer, define the Fibonacci machine from figure 5.12 and examine the lists you constructed.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I am not quite satisfied with the way I have answered this question. The solution looks flaky and involved too many <tt>set!</tt> operations in my opinion. If you have any suggestions about how to improve the answer let me know.
<br/>
<textarea name="code" class="sch" cols="60">
(define (contains? x items)
(if (null? items)
false
(if (equal? x (car items))
true
(contains? x (cdr items)))))
;; Machine will store
;; 1. A list of instructions sorted by type.
;; 2. A list of registers used to hold entry points.
;; 3. A list of registers that are saved or restored.
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(all-instructions '())
(entry-points '())
(saved-or-restored '())
(register-sources '()))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
((instruction-execution-proc (car insts)))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'get-all-instructions)
(for-each (lambda (record)
(printf "~a\n" (car record))
(for-each (lambda (item)
(printf "\t~a\n" item))
(cdr record)))
all-instructions))
((eq? message 'store-all-instructions)
(lambda (instructions) (set! all-instructions instructions)))
((eq? message 'get-entry-points)
(printf "Entry point registers:\n")
(for-each (lambda (e) (printf "\t~a\n" e)) entry-points))
((eq? message 'store-entry-points)
(lambda (items) (set! entry-points items)))
((eq? message 'get-saved-or-restored-registers)
(printf "Saved or restored registers:\n")
(for-each (lambda (r) (printf "\t~a\n" r)) saved-or-restored))
((eq? message 'store-saved-or-restored-registers)
(lambda (items) (set! saved-or-restored items)))
((eq? message 'get-register-sources)
(for-each (lambda (record)
(printf "Register: ~a\n" (car record))
(for-each (lambda (item)
(printf "\t~a\n" item))
(cdr record)))
register-sources))
((eq? message 'store-register-sources)
(lambda (sources) (set! register-sources sources)))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (store-unique-instructions machine insts)
((machine 'store-all-instructions) insts))
(define (get-unique-instructions machine)
(machine 'get-all-instructions))
(define (store-entry-points machine items)
((machine 'store-entry-points) items))
(define (get-entry-points machine)
(machine 'get-entry-points))
(define (store-saved-or-restored-registers machine items)
((machine 'store-saved-or-restored-registers) items))
(define (get-saved-or-restored-registers machine)
(machine 'get-saved-or-restored-registers))
(define (store-register-sources machine items)
((machine 'store-register-sources) items))
(define (get-register-sources machine)
(machine 'get-register-sources))
;; Assemble will call a procedure to return a unique set of instructions sorted by type.
(define (assemble controller-text machine)
(extract-labels controller-text
(lambda (insts labels)
(update-insts! insts labels machine)
(store-useful-information machine insts)
insts)))
(define (store-useful-information machine insts)
(let ((unique-instructions '((assign) (branch) (goto) (perform) (restore) (save) (test)))
(entry-points '())
(saved-or-restored-registers '())
(register-sources '())
(inst-text (map instruction-text insts)))
(define (gather-unique-instructions inst)
(let ((record (assoc (car inst) unique-instructions)))
(let ((items (cdr record)))
(cond ((not (contains? inst items))
(set-cdr! record (cons inst items)))))))
(define (gather-entry-points inst)
(let ((inst-type (car inst))
(inst-target (cadr inst)))
(if (and (eq? inst-type 'goto) ; GOTO instruction.
(register-exp? inst-target) ; Target is a register.
(not (memq (register-exp-reg inst-target) entry-points)))
(set! entry-points (cons (register-exp-reg inst-target) entry-points)))))
(define (gather-saved-or-restored-registers inst)
(let ((inst-type (car inst))
(inst-target (cadr inst)))
(if (and (or (eq? inst-type 'save) ; Save or Restore instruction.
(eq? inst-type 'restore))
(not (memq inst-target saved-or-restored-registers)))
(set! saved-or-restored-registers (cons inst-target saved-or-restored-registers)))))
(define (gather-regigster-sources inst)
(if (eq? (car inst) 'assign) ; Assign instruction.
(let ((register (assign-reg-name inst))
(source (assign-value-exp inst)))
(let ((record (assoc register register-sources)))
(if (and record (not (contains? source (cdr record))))
(let ((items (cdr record)))
(set-cdr! record (cons source items)))
(set! register-sources (cons (list register source) register-sources)))))))
(for-each (lambda (inst)
(gather-unique-instructions inst)
(gather-entry-points inst)
(gather-saved-or-restored-registers inst)
(gather-regigster-sources inst))
inst-text)
(store-unique-instructions machine unique-instructions)
(store-entry-points machine entry-points)
(store-saved-or-restored-registers machine saved-or-restored-registers)
(store-register-sources machine register-sources)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.13.</span> Modify the simulator so that it uses the controller sequence to determine what registers the machine has rather than requiring a list of registers as an argument to make-machine. Instead of pre-allocating the registers in make-machine, you can allocate them one at a time when they are first seen during assembly of the instructions.
<br/><br/>
<span style="font-weight:bold;">Answer:</span><tt>Make-machine</tt> does not require the list of registers to be explicitly passed.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-machine ops controller-text)
(let ((machine (make-new-machine)))
((machine 'install-operations) ops)
((machine 'install-instruction-sequence)
(assemble controller-text machine))
machine))
</textarea>
<br/>
<tt>Update-insts</tt> will scan each instruction to find the registers used by that instruction. If that register has not already been installed <tt>update-insts</tt> will install it. Registers have to be allocated *before* installing the instruction execution procedures.
<br/>
<textarea name="code" class="sch" cols="60">
(define (update-insts! insts labels machine)
(let ((pc (get-register machine 'pc))
(flag (get-register machine 'flag))
(stack (machine 'stack))
(ops (machine 'operations))
(installed-registers '()))
(for-each
(lambda (inst)
(for-each (lambda (register)
(if (not (memq register installed-registers))
(begin
((machine 'allocate-register) register)
(set! installed-registers (cons register installed-registers)))))
(find-registers-used (instruction-text inst)))
(set-instruction-execution-proc!
inst
(make-execution-procedure
(instruction-text inst) labels machine
pc flag stack ops)))
insts)))
</textarea>
<br/>
<tt>Find-registers-used</tt> will scan the given instruction to find the registers used.
<br/>
<textarea name="code" class="sch" cols="60">
(define (find-registers-used inst)
(define (iter inst-text registers)
(if (null? inst-text)
registers
(let ((first (car inst-text))
(rest (cdr inst-text)))
(if (and (register-exp? first) (not (memq (register-exp-reg first) registers)))
(iter rest (cons (register-exp-reg first) registers))
(iter rest registers)))))
(cond ((eq? (car inst) 'assign)
(iter (cdr inst) (list (assign-reg-name inst))))
((or (eq? (car inst) 'save) (eq? (car inst) 'restore))
(list (stack-inst-reg-name inst)))
(else
(iter (cdr inst) '()))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.14.</span> Measure the number of pushes and the maximum stack depth required to compute n! for various small values of n using the factorial machine shown in figure 5.11. From your data determine formulas in terms of n for the total number of push operations and the maximum stack depth used in computing n! for any n > 1. Note that each of these is a linear function of n and is thus determined by two constants. In order to get the statistics printed, you will have to augment the factorial machine with instructions to initialize the stack and print the statistics. You may want to also modify the machine so that it repeatedly reads a value for n, computes the factorial, and prints the result (as we did for the GCD machine in figure 5.4), so that you will not have to repeatedly invoke get-register-contents, set-register-contents!, and start.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
;; Test setup
(define fact-machine
(make-machine
'(n val continue)
(list (list 'read read) (list '- -) (list '* *) (list '= =) (list 'print printf))
'(controller
init
(assign continue (label fact-done)) ; set up final return address
(assign n (op read))
fact-loop
(test (op =) (reg n) (const 1))
(branch (label base-case))
;; Set up for the recursive call by saving n and continue.
;; Set up continue so that the computation will continue
;; at after-fact when the subroutine returns.
(save continue)
(save n)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-fact))
(goto (label fact-loop))
after-fact
(restore n)
(restore continue)
(assign val (op *) (reg n) (reg val)) ; val now contains n(n - 1)!
(goto (reg continue)) ; return to caller
base-case
(assign val (const 1)) ; base case: 1! = 1
(goto (reg continue)) ; return to caller
fact-done
(perform (op print) (const "Factorial:~a\n") (reg val))
(perform (op print-stack-statistics))
(perform (op initialize-stack))
(goto (label init)))))
(start fact-machine)
;; Results
;; n - total pushes - max depth
;; 2 - 2 - 2
;; 3 - 4 - 4
;; 4 - 6 - 6
;; 5 - 8 - 8
;; 6 - 10 - 10
;; 7 - 12 - 12
;; 8 - 14 - 14
;; 9 - 16 - 16
;; 10 - 18 - 18
</textarea>
<br/>
The total number of pushes and max depth of the stack for calculating n! is given by the formula 2(n - 1).
<br/><br/>
<span style="font-weight:bold;">Exercise 5.15.</span> Add instruction counting to the register machine simulation. That is, have the machine model keep track of the number of instructions executed. Extend the machine model's interface to accept a new message that prints the value of the instruction count and resets the count to zero.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(instruction-count 0))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(begin
((instruction-execution-proc (car insts)))
(set! instruction-count (+ instruction-count 1))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-count)
(set! instruction-count 0))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (get-instruction-count machine)
(machine 'instruction-count))
(define (reset-instruction-count machine)
(machine 'reset-instruction-count))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.16. </span> Augment the simulator to provide for instruction tracing. That is, before each instruction is executed, the simulator should print the text of the instruction. Make the machine model accept trace-on and trace-off messages to turn tracing on and off.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(instruction-count 0)
(tracing false))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(let ((inst (car insts)))
(if tracing
(begin (display (instruction-text inst))
(newline)))
(set! instruction-count (+ instruction-count 1))
((instruction-execution-proc inst))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-count) (set! instruction-count 0))
((eq? message 'trace-on) (set! tracing true))
((eq? message 'trace-off) (set! tracing false))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (set-trace-on machine)
(machine 'trace-on))
(define (set-trace-off machine)
(machine 'trace-off))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.17.</span> Extend the instruction tracing of exercise 5.16 so that before printing an instruction, the simulator prints any labels that immediately precede that instruction in the controller sequence. Be careful to do this in a way that does not interfere with instruction counting (exercise 5.15). You will have to make the simulator retain the necessary label information.
<br/><br/>
<span style="font-weight:bold;">Answer:</span> <tt>Extract-labels</tt> will include labels as part of instructions.
<br/>
<textarea name="code" class="sch" cols="60">
(define (extract-labels text receive)
(if (null? text)
(receive '() '())
(extract-labels (cdr text)
(lambda (insts labels)
(let ((next-inst (car text)))
(if (symbol? next-inst)
(let ((new-insts (cons (cons next-inst '()) insts)))
(receive new-insts
(cons (make-label-entry next-inst
new-insts)
labels)))
(receive (cons (make-instruction next-inst)
insts)
labels)))))))
</textarea>
<br/>
<tt>Make-execution-procedure</tt> will create a special execution procedure for labels. These procedures will advance the program counter (pc) and return the name of the label.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-execution-procedure inst labels machine
pc flag stack ops)
(cond ((not (pair? inst))
(make-label-exec-proc inst pc))
((eq? (car inst) 'assign)
(make-assign inst machine labels ops pc))
((eq? (car inst) 'test)
(make-test inst machine labels ops flag pc))
((eq? (car inst) 'branch)
(make-branch inst machine labels flag pc))
((eq? (car inst) 'goto)
(make-goto inst machine labels pc))
((eq? (car inst) 'save)
(make-save inst machine stack pc))
((eq? (car inst) 'restore)
(make-restore inst machine stack pc))
((eq? (car inst) 'perform)
(make-perform inst machine labels ops pc))
(else (error "Unknown instruction type -- ASSEMBLE"
inst))))
(define (make-label-exec-proc inst pc)
(lambda ()
(advance-pc pc)
inst))
</textarea>
<br/>
Machine with tracing and counting. Count is not incremented if the instruction being executed is a label.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(instruction-count 0)
(tracing false))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(let ((inst (car insts)))
(if tracing
(begin (display (instruction-text inst))
(newline)))
(if (pair? (car inst)) ;; Not a label.
(set! instruction-count (+ instruction-count 1)))
((instruction-execution-proc inst))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-count) (set! instruction-count 0))
((eq? message 'trace-on) (set! tracing true))
((eq? message 'trace-off) (set! tracing false))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (get-instruction-count machine)
(machine 'instruction-count))
(define (reset-instruction-count machine)
(machine 'reset-instruction-count))
(define (set-trace-on machine)
(machine 'trace-on))
(define (set-trace-off machine)
(machine 'trace-off))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.18.</span> Modify the make-register procedure of section 5.2.1 so that registers can be traced. Registers should accept messages that turn tracing on and off. When a register is traced, assigning a value to the register should print the name of the register, the old contents of the register, and the new contents being assigned. Extend the interface to the machine model to permit you to turn tracing on and off for designated machine registers.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-register name)
(let ((contents '*unassigned*)
(tracing false))
(define (set value)
(if tracing
(printf "~a ~a ~a\n" name contents value))
(set! contents value))
(define (dispatch message)
(cond ((eq? message 'get) contents)
((eq? message 'set) set)
((eq? message 'trace-on) (set! tracing true))
((eq? message 'trace-off) (set! tracing false))
(else
(error "Unknown request -- REGISTER" message))))
dispatch))
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(instruction-count 0)
(tracing false))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(let ((inst (car insts)))
(if tracing
(begin (display (instruction-text inst))
(newline)))
(if (pair? (car inst)) ;; Not a label.
(set! instruction-count (+ instruction-count 1)))
((instruction-execution-proc inst))
(execute)))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-count) (set! instruction-count 0))
((eq? message 'trace-on) (set! tracing true))
((eq? message 'trace-off) (set! tracing false))
((eq? message 'reg-trace-on)
(lambda (reg-name) ((lookup-register reg-name) 'trace-on)))
((eq? message 'reg-trace-off)
(lambda (reg-name) ((lookup-register reg-name) 'trace-off)))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (set-reg-trace-on machine reg-name)
((machine 'reg-trace-on) reg-name))
(define (set-reg-trace-off machine reg-name)
((machine 'reg-trace-off) reg-name))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.19.</span> Alyssa P. Hacker wants a breakpoint feature in the simulator to help her debug her machine designs. You have been hired to install this feature for her. She wants to be able to specify a place in the controller sequence where the simulator will stop and allow her to examine the state of the machine. You are to implement a procedure
<br/>
<textarea name="code" class="sch" cols="60">
(set-breakpoint <machine> <label> <n>)
</textarea>
<br/>
that sets a breakpoint just before the nth instruction after the given label. For example,
<br/>
<textarea name="code" class="sch" cols="60">
(set-breakpoint gcd-machine 'test-b 4)
</textarea>
<br/>
installs a breakpoint in gcd-machine just before the assignment to register a. When the simulator reaches the breakpoint it should print the label and the offset of the breakpoint and stop executing instructions. Alyssa can then use get-register-contents and set-register-contents! to manipulate the state of the simulated machine. She should then be able to continue execution by saying
<br/>
<textarea name="code" class="sch" cols="60">
(proceed-machine <machine>)
</textarea>
<br/>
She should also be able to remove a specific breakpoint by means of
<br/>
<textarea name="code" class="sch" cols="60">
(cancel-breakpoint <machine> <label> <n>)
</textarea>
<br/>
or to remove all breakpoints by means of
<br/>
<textarea name="code" class="sch" cols="60">
(cancel-all-breakpoints <machine>)
</textarea>
<br/><br/>
<span style="font-weight:bold;">Answer:</span> I had a LOT of fun doing this exercise. Sure it took time and I messed up in between. But in the end it was worth the time and energy spent. I present, my first "debugger" :)
<br/>
<textarea name="code" class="sch" cols="60">
(define (remove-from-list element items)
(filter (lambda (x) (not (eq? x element))) items))
(define (make-new-machine)
(let ((pc (make-register 'pc))
(flag (make-register 'flag))
(stack (make-stack))
(the-instruction-sequence '())
(instruction-count 0)
(tracing false)
(breakpoints '())
(current-label '*unassigned*)
(line-number 0))
(let ((the-ops
(list (list 'initialize-stack
(lambda () (stack 'initialize)))))
(register-table
(list (list 'pc pc) (list 'flag flag))))
(define (allocate-register name)
(if (assoc name register-table)
(error "Multiply defined register: " name)
(set! register-table
(cons (list name (make-register name))
register-table)))
'register-allocated)
(define (lookup-register name)
(let ((val (assoc name register-table)))
(if val
(cadr val)
(error "Unknown register:" name))))
(define (execute)
(let ((insts (get-contents pc)))
(if (null? insts)
'done
(let ((inst (car insts)))
(if tracing
(printf "~a\n" (instruction-text inst)))
(cond ((pair? (car inst)) ; Not a label inst.
(set! line-number (+ line-number 1))) ; Increment line number
(else ; Is a label inst.
(set! current-label (car inst)) ; Store the current label name
(set! line-number 0))) ; Reset the line number
; Check if there is a breakpoint matching the current label name and line number.
(let ((bp (assoc current-label breakpoints)))
(cond ((and bp (memq line-number (cdr bp)))
(printf "Breakpoint reached ~a ~a About to execute: ~a\n"
current-label line-number (instruction-text inst)))
(else
(if (pair? (car inst))
(set! instruction-count (+ instruction-count 1)))
((instruction-execution-proc inst))
(execute))))))))
(define (dispatch message)
(cond ((eq? message 'start)
(set-contents! pc the-instruction-sequence)
(execute))
((eq? message 'install-instruction-sequence)
(lambda (seq) (set! the-instruction-sequence seq)))
((eq? message 'allocate-register) allocate-register)
((eq? message 'get-register) lookup-register)
((eq? message 'install-operations)
(lambda (ops) (set! the-ops (append the-ops ops))))
((eq? message 'stack) stack)
((eq? message 'operations) the-ops)
((eq? message 'instruction-count) instruction-count)
((eq? message 'reset-instruction-count) (set! instruction-count 0))
((eq? message 'trace-on) (set! tracing true))
((eq? message 'trace-off) (set! tracing false))
((eq? message 'reg-trace-on)
(lambda (reg-name) ((lookup-register reg-name) 'trace-on)))
((eq? message 'reg-trace-off)
(lambda (reg-name) ((lookup-register reg-name) 'trace-off)))
((eq? message 'set-breakpoint)
(lambda (label n)
(let ((bp (assoc label breakpoints)))
(cond (bp ; Label is already present in breakpoints. Add line number to list.
(let ((line-numbers (cdr bp)))
(if (memq n line-numbers)
(error "Breakpoint exists -- MACHINE" label n)
(set-cdr! bp (cons n line-numbers)))))
(else
(set! breakpoints (cons (list label n) breakpoints)))))))
((eq? message 'cancel-breakpoint)
(lambda (label n)
(let ((bp (assoc label breakpoints)))
(cond (bp
(let ((line-numbers (cdr bp)))
(if (memq n line-numbers)
(set-cdr! bp (remove-from-list n line-numbers))
(error "Missing breakpoint -- MACHINE" label n))))
(else
(error "Missing breakpoint -- MACHINE" label n))))))
((eq? message 'cancel-all-breakpoints)
(set! breakpoints '()))
((eq? message 'proceed-machine)
(execute))
(else (error "Unknown request -- MACHINE" message))))
dispatch)))
(define (set-breakpoint machine label n)
((machine 'set-breakpoint) label n))
(define (cancel-breakpoint machine label n)
((machine 'cancel-breakpoint) label n))
(define (cancel-all-breakpoints machine)
(machine 'cancel-all-breakpoints))
(define (proceed-machine machine)
(machine 'proceed-machine))
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-44174989198215907722009-02-25T11:45:00.007+05:302009-02-25T12:22:25.095+05:30SICP Section 5.1 Designing Register Machines<span style="font-weight:bold;">Exercise 5.2. (and 5.1)</span> Use the register-machine language to describe the iterative factorial machine of exercise 5.1.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign p (const 1))
(assign c (const 1))
test-c
(test (op >) (reg c) (reg n))
(branch (label factorial-done))
(assign t (op *) (reg p) (reg c))
(assign p (reg t))
(assign t (op +) (reg c) (const 1))
(assign c (reg t))
(goto (label test-c))
factorial-done)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.3.</span> Design a machine to compute square roots using Newton's method, as described in section 1.1.7:
<br/>
<textarea name="code" class="sch" cols="60">
(define (sqrt x)
(define (good-enough? guess)
(< (abs (- (square guess) x)) 0.001))
(define (improve guess)
(average guess (/ x guess)))
(define (sqrt-iter guess)
(if (good-enough? guess)
guess
(sqrt-iter (improve guess))))
(sqrt-iter 1.0))
</textarea>
<br/>
Begin by assuming that good-enough? and improve operations are available as primitives. Then show how to expand these in terms of arithmetic operations. Describe each version of the sqrt machine design by drawing a data-path diagram and writing a controller definition in the register-machine language.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I am skipping the data-path diagrams for the three different versions of sqrt. Controller definitions of the three versions in the register-machine language follow. All three versions assume that <tt>abs</tt>, <tt>square</tt> and <tt>average</tt> are available as primitive operations along with <tt>-</tt> and <tt>/</tt>.
<br/><br/>
Version 1.
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign guess (const 1.0))
sqrt-iter
(test (op good-enough?) (reg guess))
(branch (label sqrt-done))
(assign guess (op improve) (reg guess))
(goto (label sqrt-iter))
sqrt-done)
</textarea>
<br/>
Version 2. In this version <tt>good-enough?</tt> is expanded using arithmetic operations.
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign guess (const 1.0))
sqrt-iter
(assign t (op square) (reg guess))
(assign t (op -) (reg t) (reg x))
(assign t (op abs) (reg t))
(test (op <) (reg t) (const 0.001))
(branch (label sqrt-done))
(assign guess (op improve) (reg guess))
(goto (label sqrt-iter))
sqrt-done)
</textarea>
<br/>
Version 3. <tt>Improve</tt> is also expanded using arithmetic operations.
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign guess (const 1.0))
sqrt-iter
(assign t (op square) (reg guess))
(assign t (op -) (reg t) (reg x))
(assign t (op abs) (reg t))
(test (op <) (reg t) (const 0.001))
(branch (label sqrt-done))
(assign t (op /) (reg x) (reg guess))
(assign guess (op average) (reg t) (reg guess))
(goto (label sqrt-iter))
sqrt-done)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.4.</span> Specify register machines that implement each of the following procedures. For each machine, write a controller instruction sequence and draw a diagram showing the data paths.
<br/><br/>
a. Recursive exponentiation:
<br/>
<textarea name="code" class="sch" cols="60">
(define (expt b n)
(if (= n 0)
1
(* b (expt b (- n 1)))))
</textarea>
<br/>
b. Iterative exponentiation:
<br/>
<textarea name="code" class="sch" cols="60">
(define (expt b n)
(define (expt-iter counter product)
(if (= counter 0)
product
(expt-iter (- counter 1) (* b product))))
(expt-iter n 1))
</textarea>
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br>a. Recursive exponentiation.
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign continue (label expt-done))
expt-loop
(test (op =) (reg n) (const 0)) ;; Test for (= n 0)
(branch (label base-case))
;; We only need to save continue as b is constant throughout
;; and the successive values of n are not used for calculation.
(save continue)
(assign n (op -) (reg n) (const 1))
(assign continue (label after-expt))
(goto (label expt-loop))
after-expt
(restore continue)
(assign val (op *) (reg b) (reg val))
(goto (reg continue))
base-case
(assign val (const 1))
(goto (reg continue))
expt-done)
</textarea>
<br/>
b. Iterative exponentiation.
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign counter (reg n))
(assign product (const 1))
expt-loop
(test (op =) (reg counter) (const 0))
(branch (label expt-done))
;; We don't have to save any value in the stack.
;; The result of exponentiation will be available in register product at the end of calculation.
(assign counter (op -) (reg counter) (const 1))
(assign product (op *) (reg b) (reg product))
(goto (label expt-loop))
expt-done)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 5.5.</span> Hand-simulate the factorial and Fibonacci machines, using some nontrivial input (requiring execution of at least one recursive call). Show the contents of the stack at each significant point in the execution.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
(factorial 3)<br/>
Init:<br/>
continue = fact-done; n = 3;<br/>
<br/><br/>
Iteration round 1.<br/>
Test (= n 1) fails.<br/>
Stack: continue => fact-done; n=> 3.<br/>
n = 2; continue = after-fact.<br/>
<br/><br/>
Iteration round 2.<br/>
Test (= n 1) fails.<br/>
Stack: continue => after-fact, fact-done; n=> 2, 3.<br/>
n = 1; continue = after-fact.<br/>
<br/><br/>
Iteration round 3.<br/>
Test (= n 1) succeeds. Proceed to base-case<br/>
val = 1; proceed to after-fact<br/>
<br/><br/>
After-fact round 1.<br/>
n <= 2. continue <= after-fact.<br/>
Stack: continue => fact-done; n=> 3.<br/>
val = 2 * 1 = 2<br/>
<br/><br/>
After-fact round 2.<br/>
n <= 3. continue <= fact-done.<br/>
Stack: empty<br/>
val = 3 * 2 = 6<br/>
Proceed to fact-done<br/>
<br/><br/>
<span style="font-weight:bold;">Exercise 5.6. </span> Ben Bitdiddle observes that the Fibonacci machine's controller sequence has an extra save and an extra restore, which can be removed to make a faster machine. Where are these instructions?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The redundant <tt>save</tt> and <tt>restore</tt> statements occur in the set of instructions labeled <tt>afterfib-n-1</tt>. The <tt>(restore continue)</tt> and <tt>(save continue)</tt> statements that occur at the top can be removed as the value of continue will never change between restore and save calls. The machine can be now re-written as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(controller
(assign continue (label fib-done))
fib-loop
(test (op <) (reg n) (const 2))
(branch (label immediate-answer))
;; set up to compute Fib(n - 1)
(save continue)
(assign continue (label afterfib-n-1))
(save n) ; save old value of n
(assign n (op -) (reg n) (const 1)); clobber n to n - 1
(goto (label fib-loop)) ; perform recursive call
afterfib-n-1 ; upon return, val contains Fib(n - 1)
(restore n)
;; (restore continue) ;; **REDUNDANT**
;; set up to compute Fib(n - 2)
(assign n (op -) (reg n) (const 2))
;; (save continue) ;; **REDUNDANT**
(assign continue (label afterfib-n-2))
(save val) ; save Fib(n - 1)
(goto (label fib-loop))
afterfib-n-2 ; upon return, val contains Fib(n - 2)
(assign n (reg val)) ; n now contains Fib(n - 2)
(restore val) ; val now contains Fib(n - 1)
(restore continue)
(assign val ; Fib(n - 1) + Fib(n - 2)
(op +) (reg val) (reg n))
(goto (reg continue)) ; return to caller, answer is in val
immediate-answer
(assign val (reg n)) ; base case: Fib(n) = n
(goto (reg continue))
fib-done)
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-35651743974589415302009-02-19T11:48:00.035+05:302009-02-19T12:50:16.791+05:30SICP Section 4.4 Logic Programming<span style="font-weight:bold;">Exercise 4.55.</span> Give simple queries that retrieve the following information from the data base:
a. all people supervised by Ben Bitdiddle;
<br/><br/>
b. the names and jobs of all people in the accounting division;
<br/><br/>
c. the names and addresses of all people who live in Slumerville.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a. All people supervised by Ben Bitdiddle.
<br/>
<textarea name="code" class="sch" cols="60">
(supervisor ?name (Bitdiddle Ben))
</textarea>
<br/>
b. The names and jobs of all people in the accounting division.
<br/>
<textarea name="code" class="sch" cols="60">
(job ?name (accounting . ?type))
</textarea>
<br/>
c. The names and addresses of all people who line in Slumerville.
<br/>
<textarea name="code" class="sch" cols="60">
(address ?name (Slumerville . ?home-address))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.56.</span> Formulate compound queries that retrieve the following information:
<br/><br/>
a. the names of all people who are supervised by Ben Bitdiddle, together with their addresses;
<br/><br/>
b. all people whose salary is less than Ben Bitdiddle's, together with their salary and Ben Bitdiddle's salary;
<br/><br/>
c. all people who are supervised by someone who is not in the computer division, together with the supervisor's name and job.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(and (supervisor ?person (Bitdiddle Ben))
(address ?person ?details))
</textarea>
<br/>
b.
<br/>
<textarea name="code" class="sch" cols="60">
(and (salary (Bitdiddle Ben) ?bens-salary)
(salary ?person ?amount)
(lisp-value < ?amount ?bens-salary))
</textarea>
<br/>
c.
<br/>
<textarea name="code" class="sch" cols="60">
(and (supervisor ?person ?boss)
(not (job ?boss (computer . ?details)))
(job ?boss ?boss-job-details))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.57.</span> Define a rule that says that person 1 can replace person 2 if either person 1 does the same job as person 2 or someone who does person 1's job can also do person 2's job, and if person 1 and person 2 are not the same person. Using your rule, give queries that find the following:
<br/><br/>
a. all people who can replace Cy D. Fect;
<br/><br/>
b. all people who can replace someone who is being paid more than they are, together with the two salaries.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(rule (can-replace ?person1 ?person2)
(and (or (and (job ?person1 ?details)
(job ?person2 ?details))
(and (job ?person1 ?person1-job)
(job ?person2 ?person2-job)
(can-do ?person1-job ?person2-job)))
(not (same ?person1 ?person2))))
</textarea>
<br/>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(can-replace ?person (Fect Cy D))
</textarea>
<br/>
b.
<br/>
<textarea name="code" class="sch" cols="60">
(and (salary ?person1 ?amount1)
(salary ?person2 ?amount2)
(lisp-value > ?amount2 ?amount1)
(can-replace ?person1 ?person2))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.58.</span> Define a rule that says that a person is a ``big shot'' in a division if the person works in the division but does not have a supervisor who works in the division.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(rule (bigshot ?person ?division)
(and (job ?person (?division . ?details1))
(or
;; person does not have a supervisor
(not (supervisor ?person ?boss))
;; person's supervisor is from another division
(and (supervisor ?person ?boss)
(job ?boss (?another-division . ?details2))
(not (same ?division ?another-division))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.59.</span> Ben Bitdiddle has missed one meeting too many. Fearing that his habit of forgetting meetings could cost him his job, Ben decides to do something about it. He adds all the weekly meetings of the firm to the Microshaft data base by asserting the following:
<br/>
<textarea name="code" class="sch" cols="60">
(meeting accounting (Monday 9am))
(meeting administration (Monday 10am))
(meeting computer (Wednesday 3pm))
(meeting administration (Friday 1pm))
</textarea>
<br/>
Each of the above assertions is for a meeting of an entire division. Ben also adds an entry for the company-wide meeting that spans all the divisions. All of the company's employees attend this meeting.
<br/>
<textarea name="code" class="sch" cols="60">
(meeting whole-company (Wednesday 4pm))
</textarea>
<br/>
a. On Friday morning, Ben wants to query the data base for all the meetings that occur that day. What query should he use?
<br/><br/>
b. Alyssa P. Hacker is unimpressed. She thinks it would be much more useful to be able to ask for her meetings by specifying her name. So she designs a rule that says that a person's meetings include all whole-company meetings plus all meetings of that person's division. Fill in the body of Alyssa's rule.
<br/>
<textarea name="code" class="sch" cols="60">
(rule (meeting-time ?person ?day-and-time)
<rule-body>)
</textarea>
<br/>
c. Alyssa arrives at work on Wednesday morning and wonders what meetings she has to attend that day. Having defined the above rule, what query should she make to find this out?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(meeting ?department (Friday ?time))
</textarea>
<br/>
b.
<br/>
<textarea name="code" class="sch" cols="60">
(rule (meeting-time ?person ?day-and-time)
(or (and (job ?person (?division . ?title))
(meeting ?division ?day-and-time))
(meeting whole-company ?day-and-time)))
</textarea>
<br/>
c.
<br/>
<textarea name="code" class="sch" cols="60">
(meeting-time (Hacker Alyssa P) (Wednesday . ?time))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.60.</span> By giving the query
<br/>
<textarea name="code" class="sch" cols="60">
(lives-near ?person (Hacker Alyssa P))
</textarea>
<br/>
Alyssa P. Hacker is able to find people who live near her, with whom she can ride to work. On the other hand, when she tries to find all pairs of people who live near each other by querying
<br/>
<textarea name="code" class="sch" cols="60">
(lives-near ?person-1 ?person-2)
</textarea>
<br/>
she notices that each pair of people who live near each other is listed twice; for example,
<br/>
<textarea name="code" class="sch" cols="60">
(lives-near (Hacker Alyssa P) (Fect Cy D))
(lives-near (Fect Cy D) (Hacker Alyssa P))
</textarea>
<br/>
Why does this happen? Is there a way to find a list of people who live near each other, in which each pair appears only once? Explain.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Lives-near works by showing all entries in the database that matches a certain pattern. If <tt>person1</tt> and <tt>person2</tt> match the pattern by virtue of being neighbors then the reverse is also true and therefore <tt>person2</tt> and <tt>person1</tt> also meet the pattern. There is no way to prevent this given the current definition of the rule.
<br/><br/>
The rule can be changed to add an artificial constraint to avoid the names being printed twice. For instance we can compare the lengths of the names of the people and print only those results where the name of <tt>person1</tt> is longer than the name of <tt>person2</tt>.
<br/>
<textarea name="code" class="sch" cols="60">
(rule (lives-near ?person-1 ?person-2)
(and (address ?person-1 (?town . ?rest-1))
(address ?person-2 (?town . ?rest-2))
(not (same ?person-1 ?person-2))
(lisp-value string>? ?person-1 ?person-2)))
</textarea>
<br/>
<tt>String>?</tt> is a built in operator which compares strings according to the order of the characters they contain.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.61.</span> The following rules implement a next-to relation that finds adjacent elements of a list:
<br/>
<textarea name="code" class="sch" cols="60">
(rule (?x next-to ?y in (?x ?y . ?u)))
(rule (?x next-to ?y in (?v . ?z))
(?x next-to ?y in ?z))
</textarea>
<br/>
What will the response be to the following queries?
<br/>
<textarea name="code" class="sch" cols="60">
(?x next-to ?y in (1 (2 3) 4))
(?x next-to 1 in (2 1 3 1))
</textarea>
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
;; (?x next-to ?y in (1 (2 3) 4))
(1 (2 3))
((2 3) 4)
;; (?x next-to 1 in (2 1 3 1))
(2 1)
(3 1)
(1 3)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.62.</span> Define rules to implement the last-pair operation of exercise 2.17, which returns a list containing the last element of a nonempty list. Check your rules on queries such as (last-pair (3) ?x), (last-pair (1 2 3) ?x), and (last-pair (2 ?x) (3)). Do your rules work correctly on queries such as (last-pair ?x (3)) ?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(rule (last-pair (?x) (?x)))
(rule (last-pair (?y . ?rest) ?x)
(last-pair ?rest ?x))
;; (last-pair (3) ?x) => (last-pair (3) (3))
;; (last-pair (1 2 3) ?x) => (last-pair (1 2 3) (3))
;; (last-pair (2 ?x) (3)) => (last-pair (2 3) (3))
;; (last-pair ?x (3)) does not return. The system goes into an infinite loop.
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.63.</span> The following data base (see Genesis 4) traces the genealogy of the descendants of Ada back to Adam, by way of Cain:
<br/>
<textarea name="code" class="sch" cols="60">
(son Adam Cain)
(son Cain Enoch)
(son Enoch Irad)
(son Irad Mehujael)
(son Mehujael Methushael)
(son Methushael Lamech)
(wife Lamech Ada)
(son Ada Jabal)
(son Ada Jubal)
</textarea>
<br/>
Formulate rules such as ``If S is the son of F, and F is the son of G, then S is the grandson of G'' and ``If W is the wife of M, and S is the son of W, then S is the son of M'' (which was supposedly more true in biblical times than today) that will enable the query system to find the grandson of Cain; the sons of Lamech; the grandsons of Methushael. (See exercise 4.69 for some rules to deduce more complicated relationships.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(rule (grandson ?g ?s)
(and (son ?g ?f)
(son ?f ?s)))
(rule (son ?m ?s)
(and (wife ?m ?w)
(son ?w ?s)))
;;;; Query input:
;(grandson Methushael ?x)
;;;; Query results:
;(grandson Methushael Jubal)
;(grandson Methushael Jabal)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.64.</span> Louis Reasoner mistakenly deletes the outranked-by rule (section 4.4.1) from the data base. When he realizes this, he quickly reinstalls it. Unfortunately, he makes a slight change in the rule, and types it in as
<br/>
<textarea name="code" class="sch" cols="60">
(rule (outranked-by ?staff-person ?boss)
(or (supervisor ?staff-person ?boss)
(and (outranked-by ?middle-manager ?boss)
(supervisor ?staff-person ?middle-manager))))
</textarea>
<br/>
Just after Louis types this information into the system, DeWitt Aull comes by to find out who outranks Ben Bitdiddle. He issues the query
<br/>
<textarea name="code" class="sch" cols="60">
(outranked-by (Bitdiddle Ben) ?who)
</textarea>
<br/>
After answering, the system goes into an infinite loop. Explain why.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I'll use the procedure explained in section 4.4.2 (pg. 460) to explore how this query is executed.
<br/><br/>
1. Unify query with the conclusion of the rule to form, if successful, an extension of the original frame. By unifying the query <tt>(outranked-by (Bitiddle Ben) ?who)</tt> with the conclusion of the rule <tt>(outranked-by ?staff-person ?boss)</tt> we get a frame where <tt>?staff-person</tt> and <tt>?boss</tt> are bound to <tt>(Bitiddle Ben)</tt> and <tt>?who</tt> respectively.
<br/><br/>
2. Relative to the extended frame, evaluate the query formed by the body of the rule. The query formed by the body of the rule in this case is:
<br/>
<textarea name="code" class="sch" cols="60">
(or (superior ?staff-person ?boss)
(and (outranked-by ?middle-manager ?boss)
(superior ?staff-person ?middle-manager)))
</textarea>
<br/>
The first argument to or immediately produces a match from the database: <tt>(supervisor (Bitiddle Ben) (Warbucks Oliver))</tt>. This result is printed. The second argument to or is the and sub-query, the first part of which uses the <tt>outranked-by</tt> rule. This leads the interpreter to again evaluate the rule body resulting in a frame where <tt>?staff-person</tt> and <tt>?boss</tt> are bound to to <tt>?middle-manager</tt> and <tt>?who</tt> respectively. This once again leads to the evaluation of <tt>outranked-by</tt> and so on infinitely.
<br/><br/>
I can see how the infinite loop is triggered. What I don't understand is how the first part of or, i.e., <tt>(superior ?staff-person ?boss)</tt> is not matched in these infinite calls and their results printed (like how the first result got printed). Perhaps I'll be able to explain it once I study how the query interpreter is implemented.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.65.</span> Cy D. Fect, looking forward to the day when he will rise in the organization, gives a query to find all the wheels (using the wheel rule of section 4.4.1):
<br/>
<textarea name="code" class="sch" cols="60">
(wheel ?who)
</textarea>
<br/>
To his surprise, the system responds
<br/>
<textarea name="code" class="sch" cols="60">
;;; Query results:
(wheel (Warbucks Oliver))
(wheel (Bitdiddle Ben))
(wheel (Warbucks Oliver))
(wheel (Warbucks Oliver))
(wheel (Warbucks Oliver))
</textarea>
<br/>
Why is Oliver Warbucks listed four times?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Once again I'll use the procedure explained in section 4.4.2 (pg. 460) to explore how this query is executed.
<br/><br/>
1. Unify query with the conclusion of the rule to form, if successful, an extension of the original frame. By unifying the query <tt>(wheel ?who)</tt> with the conclusion of the rule <tt>(wheel ?person)</tt> we get a frame where <tt>?person</tt> is bound to <tt>?who</tt>.
<br/><br/>
2. Relative to the extended frame, evaluate the query formed by the body of the rule. The query formed by the body of the rule in this case is:
<br/>
<textarea name="code" class="sch" cols="60">
(and (supervisor ?middle-manager ?person)
(supervisor ?x ?middle-manager))
</textarea>
<br/>
This query produces multiple matches, one each for every instance of a supervisor-employee pair where the supervisor reports to <tt>?person</tt>.
<br/>
<textarea name="code" class="sch" cols="60">
(and (supervisor (Scrooge Eben) (Warbucks Oliver)) (supervisor (Cratchet Robert) (Scrooge Eben)))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (supervisor (Tweakit Lem E) (Bitdiddle Ben)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P)))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (supervisor (Fect Cy D) (Bitdiddle Ben)))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (supervisor (Hacker Alyssa P) (Bitdiddle Ben)))
</textarea>
<br/>
The rule conclusion is instantiated with the value for <tt>?person</tt> for every result produced by the query. Therefore we find that Oliver Warbuck's name pops up four times.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.66.</span> Ben has been generalizing the query system to provide statistics about the company. For example, to find the total salaries of all the computer programmers one will be able to say
<br/>
<textarea name="code" class="sch" cols="60">
(sum ?amount
(and (job ?x (computer programmer))
(salary ?x ?amount)))
</textarea>
<br/>
In general, Ben's new system allows expressions of the form
<br/>
<textarea name="code" class="sch" cols="60">
(accumulation-function <variable>
<query pattern>)
</textarea>
<br/>
where accumulation-function can be things like sum, average, or maximum. Ben reasons that it should be a cinch to implement this. He will simply feed the query pattern to qeval. This will produce a stream of frames. He will then pass this stream through a mapping function that extracts the value of the designated variable from each frame in the stream and feed the resulting stream of values to the accumulation function. Just as Ben completes the implementation and is about to try it out, Cy walks by, still puzzling over the wheel query result in exercise 4.65. When Cy shows Ben the system's response, Ben groans, ``Oh, no, my simple accumulation scheme won't work!''
<br/><br/>
What has Ben just realized? Outline a method he can use to salvage the situation.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Consider the following application of Ben's new system:
<br/>
<textarea name="code" class="sch" cols="60">
(sum ?amount
(and (wheel ?who)
(salary ?who ?amount)))
</textarea>
<br/>
This query is meant to calculate the sum of the salaries paid to "wheels". As we saw in exercise 4.65 the <tt>(wheel ?who)</tt> query will repeat Oliver Warbuck's name. Consequently his salary will be added up multiple times. This is the error Ben has realized - that queries can repeat the results.
<br/><br/>
One way to solve Ben's problem would be to ensure that the query pattern produces unique results. This can be done by implementing the equivalent of <tt>distinct?</tt> for the query results.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.68.</span> Define rules to implement the reverse operation of exercise 2.18, which returns a list containing the same elements as a given list in reverse order. (Hint: Use append-to-form.) Can your rules answer both (reverse (1 2 3) ?x) and (reverse ?x (1 2 3)) ?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(assert!
(rule (reverse (?first . ?rest) ?y)
(and (reverse ?rest ?reverse-of-rest)
(append-to-form ?reverse-of-rest (?first) ?y))))
(assert!
(rule (reverse (?x) (?x))))
</textarea>
<br/>
<tt>(reverse (1 2 3) ?x)</tt> returns <tt>(reverse (1 2 3) (3 2 1))</tt>.
<br/><br/>
<tt>(reverse ?x (1 2 3))</tt> prints <tt>(reverse (3 2 1) (1 2 3))</tt> and goes into an infinite loop if the order of the reverse rules is as shown. If the second rule is added first then the evaluator goes into infinite loop without printing any result.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.69.</span> Beginning with the data base and the rules you formulated in exercise 4.63, devise a rule for adding ``greats'' to a grandson relationship. This should enable the system to deduce that Irad is the great-grandson of Adam, or that Jabal and Jubal are the great-great-great-great-great-grandsons of Adam. (Hint: Represent the fact about Irad, for example, as ((great grandson) Adam Irad). Write rules that determine if a list ends in the word grandson. Use this to express a rule that allows one to derive the relationship ((great . ?rel) ?x ?y), where ?rel is a list ending in grandson.) Check your rules on queries such as ((great grandson) ?g ?ggs) and (?relationship Adam Irad).
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(assert!
(rule (grandson ?g ?s)
(and (son ?g ?f)
(son ?f ?s))))
(assert!
(rule (son ?m ?s)
(and (wife ?m ?w)
(son ?w ?s))))
(assert!
(rule (last-pair (?x) (?x))))
(assert!
(rule (last-pair (?y . ?rest) ?x)
(last-pair ?rest ?x)))
(assert!
(rule (ends-in-grandson ?list)
(last-pair ?list (grandson))))
(assert!
(rule ((grandson) ?a ?d) (grandson ?a ?d)))
(assert!
(rule ((great . ?rel) ?x ?person)
(and (and (son ?x ?son-of-x)
(?rel ?son-of-x ?person))
(ends-in-grandson ?rel))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.70.</span> What is the purpose of the let bindings in the procedures add-assertion! and add-rule! ? What would be wrong with the following implementation of add-assertion! ? Hint: Recall the definition of the infinite stream of ones in section 3.5.2: (define ones (cons-stream 1 ones)).
<br/>
<textarea name="code" class="sch" cols="60">
(define (add-assertion! assertion)
(store-assertion-in-index assertion)
(set! THE-ASSERTIONS
(cons-stream assertion THE-ASSERTIONS))
'ok)
</textarea>
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The implementation given in the question uses <tt>THE-ASSERTIONS</tt> in the <tt>cons-stream</tt> operation. This defines <tt>THE-ASSERTIONS</tt> recursively as a combination of the given assertion and <tt>THE-ASSERTIONS</tt>. Such a definition would make <tt>THE-ASSERTIONS</tt> an infinite stream (whose <tt>stream-car</tt> is the new assertion) rather than a finite stream of assertions. The original definition creates a finite stream by joining the given assertion with the empty stream.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.71. </span> Louis Reasoner wonders why the simple-query and disjoin procedures (section 4.4.4.2) are implemented using explicit delay operations, rather than being defined as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (simple-query query-pattern frame-stream)
(stream-flatmap
(lambda (frame)
(stream-append (find-assertions query-pattern frame)
(apply-rules query-pattern frame)))
frame-stream))
(define (disjoin disjuncts frame-stream)
(if (empty-disjunction? disjuncts)
the-empty-stream
(interleave
(qeval (first-disjunct disjuncts) frame-stream)
(disjoin (rest-disjuncts disjuncts) frame-stream))))
</textarea>
<br/>
Can you give examples of queries where these simpler definitions would lead to undesirable behavior?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The call to <tt>delay</tt> application of rules will prevent infinite looping in cases where the rules recursively rely on themselves and/or assertions. In such cases the <tt>delay</tt> will ensure that results matching the assertions in the database are printed before the rules get evaluated rather than going into an infinite loop immediately.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.72.</span> Why do disjoin and stream-flatmap interleave the streams rather than simply append them? Give examples that illustrate why interleaving works better. (Hint: Why did we use interleave in section 3.5.3?)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The hint is sufficient to get you started towards the answer. Interleaving was originally introduced to handle multiple infinite streams. Interleaving prevented any one stream being explored infinitely and ensured that values from all component streams were explored in turn. These reasons are still valid here in the case of <tt>stream-flatmap</tt> and <tt>disjoin</tt>.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.73. </span> Why does flatten-stream use delay explicitly? What would be wrong with defining it as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (flatten-stream stream)
(if (stream-null? stream)
the-empty-stream
(interleave
(stream-car stream)
(flatten-stream (stream-cdr stream)))))
</textarea>
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<tt>Flatten-stream</tt> internally calls the <tt>interleave</tt> procedure. The first argument to <tt>interleave</tt> is the <tt>stream-car</tt> of the input stream. The second argument is the result of flattening the <tt>stream-cdr</tt> of the input stream. In the absence of an explicit <tt>delay</tt> the second argument is evaluated before being passed to <tt>interleave</tt>. As the second argument recursively calls <tt>flatten-stream</tt> this leads to a loop. The loop will not terminate until the input stream is exhausted. In case of infinite streams this leads to an infinite loop.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.74.</span> Alyssa P. Hacker proposes to use a simpler version of stream-flatmap in negate, lisp-value, and find-assertions. She observes that the procedure that is mapped over the frame stream in these cases always produces either the empty stream or a singleton stream, so no interleaving is needed when combining these streams.
<br/><br/>
a. Fill in the missing expressions in Alyssa's program.
<br/>
<textarea name="code" class="sch" cols="60">
(define (simple-stream-flatmap proc s)
(simple-flatten (stream-map proc s)))
(define (simple-flatten stream)
(stream-map <??>
(stream-filter <??> stream)))
</textarea>
<br/>
b. Does the query system's behavior change if we change it in this way?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(define (simple-stream-flatmap proc s)
(simple-flatten (stream-map proc s)))
(define (simple-flatten stream)
(stream-map stream-car
(stream-filter (lambda (s) (not (stream-null? s))) stream)))
</textarea>
<br/>
b. The changes will not affect the behavior of the query system. The end result of <tt>simple-stream-flatmap</tt> remains a stream of singleton streams in the same order as before the changes. Therefore the overall behavior should remain unchanged.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.75.</span> Implement for the query language a new special form called unique. Unique should succeed if there is precisely one item in the data base satisfying a specified query. For example,
<br/>
<textarea name="code" class="sch" cols="60">
(unique (job ?x (computer wizard)))
</textarea>
<br/>
should print the one-item stream
<br/>
<textarea name="code" class="sch" cols="60">
(unique (job (Bitdiddle Ben) (computer wizard)))
</textarea>
<br/>
since Ben is the only computer wizard, and
<br/>
<textarea name="code" class="sch" cols="60">
(unique (job ?x (computer programmer)))
</textarea>
<br/>
should print the empty stream, since there is more than one computer programmer. Moreover,
<br/>
<textarea name="code" class="sch" cols="60">
(and (job ?x ?j) (unique (job ?anyone ?j)))
</textarea>
<br/>
should list all the jobs that are filled by only one person, and the people who fill them.
<br/><br/>
There are two parts to implementing unique. The first is to write a procedure that handles this special form, and the second is to make qeval dispatch to that procedure. The second part is trivial, since qeval does its dispatching in a data-directed way. If your procedure is called uniquely-asserted, all you need to do is
<br/>
<textarea name="code" class="sch" cols="60">
(put 'unique 'qeval uniquely-asserted)
</textarea>
<br/>
and qeval will dispatch to this procedure for every query whose type (car) is the symbol unique.
<br/><br/>
The real problem is to write the procedure uniquely-asserted. This should take as input the contents (cdr) of the unique query, together with a stream of frames. For each frame in the stream, it should use qeval to find the stream of all extensions to the frame that satisfy the given query. Any stream that does not have exactly one item in it should be eliminated. The remaining streams should be passed back to be accumulated into one big stream that is the result of the unique query. This is similar to the implementation of the not special form.
<br/><br/>
Test your implementation by forming a query that lists all people who supervise precisely one person.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (unique-query operands)
(car operands))
(define (singleton-stream? s)
(and (not (stream-null? s))
(stream-null? (stream-cdr s))))
(define (uniquely-asserted operands frame-stream)
(stream-flatmap
(lambda (frame)
(let ((ext (qeval (unique-query operands) (singleton-stream frame))))
(if (singleton-stream? ext) ext the-empty-stream)))
frame-stream))
;;; Query input:
(and (supervisor ?x ?boss)
(unique (supervisor ?anyone ?boss)))
;;; Query results:
(and (supervisor (Cratchet Robert) (Scrooge Eben)) (unique (supervisor (Cratchet Robert) (Scrooge Eben))))
(and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.76.</span> Our implementation of and as a series combination of queries (figure 4.5) is elegant, but it is inefficient because in processing the second query of the and we must scan the data base for each frame produced by the first query. If the data base has N elements, and a typical query produces a number of output frames proportional to N (say N/k), then scanning the data base for each frame produced by the first query will require N2/k calls to the pattern matcher. Another approach would be to process the two clauses of the and separately, then look for all pairs of output frames that are compatible. If each query produces N/k output frames, then this means that we must perform N2/k2 compatibility checks -- a factor of k fewer than the number of matches required in our current method.
<br/><br/>
Devise an implementation of and that uses this strategy. You must implement a procedure that takes two frames as inputs, checks whether the bindings in the frames are compatible, and, if so, produces a frame that merges the two sets of bindings. This operation is similar to unification.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (conjoin conjuncts frame-stream)
(if (empty-conjunction? conjuncts)
frame-stream
(let ((fs1 (qeval (first-conjunct conjuncts) frame-stream))
(fs2 (conjoin (rest-conjuncts conjuncts) frame-stream)))
(compare-and-merge-streams fs1 fs2))))
(define (compare-and-merge-streams fs1 fs2)
(stream-flatmap
(lambda (f1)
(stream-filter
(lambda (frame) (not (equal? frame 'failed)))
(stream-map
(lambda (f2)
(merge-frames f1 f2))
fs2)))
fs1))
(define (merge-frames f1 f2)
(if (null? f1)
f2
(let ((variable (caar f1))
(value (cdar f1)))
(let ((extension (extend-if-possible variable value f2)))
(if (equal? extension 'failed)
'failed
(merge-frames (cdr f1) extension))))))
</textarea>
<br/>
<span style="font-weight:bold;">Note:</span> I am skipping the last three problems of this chapter and moving on to Chapter 5. I will revisit them after completing Chapter 5.Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-78776324736347255142009-02-02T15:15:00.008+05:302009-02-02T15:42:35.237+05:30Customer Support @ MegacorpFirst, about Megacorp: there is no such thing. Megacorp is an imaginary organization which represents all organizations where I or my friends have worked at some point. Many thanks to Ravi Mohan for coming up with <a href="http://pindancing.blogspot.com/2008/11/introducing-megacorp.html">the idea</a>.
<br/><br/>
Megacorp developed a tool/product which was mostly used by its own employees. As the tool was fairly useful it came to be widely adopted. Soon enough there were bug reports, requests for new features and general questions. Initially these requests were managed through phone calls and emails. While convenient in the beginning the situation soon became worse with customers ringing up arbitrary team members to demand help. As things got close to crazy the development team suggested using a single point of contact and some tool like <a href="http://trac.edgewall.org/">Trac</a> to track such requests.
<br/><br/>
The new manager heard them out and decided to implement it - albeit with some variations. For starters Trac would not be used. Instead a new all-round-management-reporting system would be "adapted". Said system was the brainchild of the manager, purchased by paying extravagant costs and took months to get up and running. All the while the mayhem continued. Eventually the new system was inaugurated. Users could log new tickets, engineers could view them and so on. There was one major feature change courtesy the Manager. The tickets could only be closed by *whoever initiated it*.
<br/><br/>
A month or so later the development team got a memo from the manager asking about the large number of open tickets. "Because we can't close them" came the reply. Manager seemed bemused. "Of course *you* cannot close them. I wanted to know why you are not getting them closed by
asking the customers". Explanations about the difficulty in doing this were brushed off. Soon the development team were back to working the phones - except this time they were calling the customers and asking them to close the tickets. As most of the customers traveled
around for work it was difficult to reach them. Many also seemed reluctant to close tickets as they had not been fixed to "their satisfaction". Some customers had forgotten how to log in or their passwords had expired (the system forced you to change your password every month). They could do nothing until the log in problem had been fixed. Most developers soon gave up.
<br/><br/>
Several months later it was time for the audit. Manager was surprised to see open tickets which were months old. Finally realizing the futility of trying to get the tickets closed she asked the system administrators to close ALL of them - even those which had legitimate reasons to be open. Ta da! The audit was a huge success.
<br/><br/>
Last heard the manager was rewarded for successfully introducing the all-round-management-reporting system. The developers and the customers alike dumped the system and were back to calling each other.
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com2tag:blogger.com,1999:blog-16889165.post-39446782106835713962009-01-31T08:31:00.010+05:302009-01-31T09:18:27.967+05:30SICP Section 4.3 Variations on a Scheme -- Nondeterministic Computing<span style="font-weight:bold;">Exercise 4.35.</span> Write a procedure an-integer-between that returns an integer between two given bounds. This can be used to implement a procedure that finds Pythagorean triples, i.e., triples of integers (i,j,k) between the given bounds such that i < j and i2 + j2 = k2, as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (a-pythagorean-triple-between low high)
(let ((i (an-integer-between low high)))
(let ((j (an-integer-between i high)))
(let ((k (an-integer-between j high)))
(require (= (+ (* i i) (* j j)) (* k k)))
(list i j k)))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (an-integer-between low high)
(require (<= low high))
(amb low (an-integer-between (+ low 1) high)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.36.</span> Exercise 3.69 discussed how to generate the stream of all Pythagorean triples, with no upper bound on the size of the integers to be searched. Explain why simply replacing an-integer-between by an-integer-starting-from in the procedure in exercise 4.35 is not an adequate way to generate arbitrary Pythagorean triples. Write a procedure that actually will accomplish this. (That is, write a procedure for which repeatedly typing try-again would in principle eventually generate all Pythagorean triples.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Here is what the procedure explained in exercise 4.35 would look like if we rewrite it using <tt>an-integer-starting-from</tt>
<br/>
<textarea name="code" class="sch" cols="60">
(define (all-pythagorean-triples-starting-from n)
(let ((i (an-integer-starting-from n)))
(let ((j (an-integer-starting-from i)))
(let ((k (an-integer-starting-from j)))
(require (= (+ (* i i) (* j j)) (* k k)))
(list i j k)))))
</textarea>
<br/>
This procedure can be invoked as follows: <tt>(all-pythagorean-triples-starting-from 1)</tt>
<br/><br/>
The amb operator starts with <tt>i = 1</tt>. This leads to <tt>j = 1</tt> and <tt>k = 1</tt>. As these values do not meet the Pythagorean condition the operator retraces its path to the *most recent choice point* and tries the next alternative. That means heading back to <tt>k = 1</tt> and resuming with <tt>k = 2</tt>. Since this also fails <tt>k = 3</tt> is selected and so on. This continues until *all values* of k are tried. As this is an impossible task we are stuck in a situation where i and j never proceed beyond 1. This is similar to the problems faced in chapter 3 while working with infinite streams. The search will not proceed meaningfully without some form of interleaving.
<br/><br/>
I am not able to come up with a good answer to the second part of the problem.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.37. </span> Ben Bitdiddle claims that the following method for generating Pythagorean triples is more efficient than the one in exercise 4.35. Is he correct? (Hint: Consider the number of possibilities that must be explored.)
<br/>
<textarea name="code" class="sch" cols="60">
(define (a-pythagorean-triple-between low high)
(let ((i (an-integer-between low high))
(hsq (* high high)))
(let ((j (an-integer-between i high)))
(let ((ksq (+ (* i i) (* j j))))
(require (>= hsq ksq))
(let ((k (sqrt ksq)))
(require (integer? k))
(list i j k))))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
Ben's version generates fewer options to explore due the condition <tt>(require (>= hsq ksq))</tt>. Further those values of <tt>i^2 + j^2</tt> whose root is not an integer are not explored. Together these conditions make Ben's version more efficient than the version given in exercise 4.35.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.39.</span> Does the order of the restrictions in the multiple-dwelling procedure affect the answer? Does it affect the time to find an answer? If you think it matters, demonstrate a faster program obtained from the given one by reordering the restrictions. If you think it does not matter, argue your case.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The order of the restrictions does not affect the answer. The answer has to meet ALL of them, so whatever emerges would have met all the conditions.
<br/><br/>
The time taken is affected by the order of restrictions. Take for example this variant which moves the restriction for distinct floors for each resident to the end of the list. Distinct? takes relatively more time compared to the other restrictions. It operates on 5 tuples (one for each resident-floor pair) each time it is called. It is therefore better to invoke this procedure *after* as many of the restrictions as possible have been met.
<br/>
<textarea name="code" class="sch" cols="60">
(define (multiple-dwelling)
(let ((baker (amb 1 2 3 4 5))
(cooper (amb 1 2 3 4 5))
(fletcher (amb 1 2 3 4 5))
(miller (amb 1 2 3 4 5))
(smith (amb 1 2 3 4 5)))
(require (not (= baker 5)))
(require (not (= cooper 1)))
(require (not (= fletcher 5)))
(require (not (= fletcher 1)))
(require (> miller cooper))
(require (not (= (abs (- smith fletcher)) 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(require
(distinct? (list baker cooper fletcher miller smith)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.40.</span> In the multiple dwelling problem, how many sets of assignments are there of people to floors, both before and after the requirement that floor assignments be distinct? It is very inefficient to generate all possible assignments of people to floors and then leave it to backtracking to eliminate them. For example, most of the restrictions depend on only one or two of the person-floor variables, and can thus be imposed before floors have been selected for all the people. Write and demonstrate a much more efficient nondeterministic procedure that solves this problem based upon generating only those possibilities that are not already ruled out by previous restrictions. (Hint: This will require a nest of let expressions.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
There is no need for distinctness before the first restriction is imposed. This means that for every assignment for the first person there are 5 for the next, 5 * 5 for the third, 5 * 5 * 5 for the fourth person and so on. Therefore there is a grand total of 5^5 = 3125 assignments of people to floors before <tt>distinct?</tt>.
<br/><br/>
After the <tt>distinct?</tt> restriction is applied this reduces to 5 possibilities for the first person, 4 for the next (as the first and second cannot be on the same floor), 3 thereafter and so on. We get 5! = 120 possibilities afterwards.
<br/><br/>
More efficient solution:
<br/><br/>
Let us start with the restrictions on individuals. Some of the possibilities can be "trimmed" by avoiding certain assignments. For instance Baker cannot be on the fifth floor. Therefore we can remove 5 from the amb expression generating floors for Baker. Similarly we can remove 1 from the list for Cooper and both 1 and 5 from the list for Fletcher.
<br/><br/>
Miller has to live above Cooper. As the lowest floor Cooper can live on is 2, Miller can only live on floors 3, 4 or 5. Here is a version of the program incorporating all these:
<br/>
<textarea name="code" class="sch" cols="60">
(define (multiple-dwelling-1)
(let ((baker (amb 1 2 3 4)) ;; Floor 5 removed.
(cooper (amb 2 3 4 5)) ;; Floor 1 removed.
(fletcher (amb 2 3 4 )) ;; Floors 1 and 5 removed.
(miller (amb 3 4 5)) ;; Floors 1 and 2 removed.
(smith (amb 1 2 3 4 5)))
;; (require (not (= baker 5))) ;; Already factored in
;; (require (not (= cooper 1))) ;; Already factored in
;; (require (not (= fletcher 5))) ;; Already factored in
;; (require (not (= fletcher 1))) ;; Already factored in
(require (> miller cooper))
(require (not (= (abs (- smith fletcher)) 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(require
(distinct? (list baker cooper fletcher miller smith)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))
</textarea>
<br/>
We can further refine the program as the authors have hinted. For instance if we first enforce the restriction that Miller should live above Cooper then we are left with the following Six possibilities: (Cooper, Miller): (2, 3), (2,4) (2,5), (3, 4), (3, 5), (4, 5). We can delay the assignment of floors for Baker until after after all the other restrictions have been imposed.
<br/>
<textarea name="code" class="sch" cols="60">
(define (multiple-dwelling-2)
(let ((cooper (amb 2 3 4 5))
(miller (amb 3 4 5)))
(require (> miller cooper))
(let ((fletcher (amb 2 3 4)))
(require (not (= (abs (- fletcher cooper)) 1)))
(let ((smith (amb 1 2 3 4 5)))
(require (not (= (abs (- smith fletcher)) 1)))
(let ((baker (amb 1 2 3 4)))
(require
(distinct? (list baker cooper fletcher miller smith)))
(list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith)))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.41.</span> Write an ordinary Scheme program to solve the multiple dwelling puzzle.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
This solution makes use of the <tt>permutations</tt> procedure from Chapter 2.
<br/>
<textarea name="code" class="sch" cols="60">
(load "permutations.scm")
(define (multiple-dwelling assignments)
(let ((baker (list-ref assignments 0))
(cooper (list-ref assignments 1))
(fletcher (list-ref assignments 2))
(miller (list-ref assignments 3))
(smith (list-ref assignments 4)))
(if (and (not (= baker 5))
(not (= cooper 1))
(not (= fletcher 5))
(not (= fletcher 1))
(> miller cooper)
(not (= (abs (- smith fletcher)) 1))
(not (= (abs (- fletcher cooper)) 1)))
(display (list (list 'baker baker)
(list 'cooper cooper)
(list 'fletcher fletcher)
(list 'miller miller)
(list 'smith smith))))))
(define (distinct-floor-assignments)
(permutations '(1 2 3 4 5)))
;; (for-each multiple-dwelling (distinct-floor-assignments))
;; ((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.42.</span> Solve the following ``Liars'' puzzle (from Phillips 1934):
<br/><br/>
Five schoolgirls sat for an examination. Their parents -- so they thought -- showed an undue degree of interest in the result. They therefore agreed that, in writing home about the examination, each girl should make one true statement and one untrue one. The following are the relevant passages from their letters:
<ul>
<li>Betty: ``Kitty was second in the examination. I was only third.''</li>
<li> Ethel: ``You'll be glad to hear that I was on top. Joan was second.''</li>
<li> Joan: ``I was third, and poor old Ethel was bottom.''</li>
<li> Kitty: ``I came out second. Mary was only fourth.''</li>
<li> Mary: ``I was fourth. Top place was taken by Betty.'' </li>
</ul>
What in fact was the order in which the five girls were placed?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I wrote an utility procedure <tt>or</tt> for the solution.
<br/>
<textarea name="code" class="sch" cols="60">
(define (or args)
(cond ((null? args) false)
((car args) true)
(else (or (cdr args)))))
(define (liars)
(let ((betty (amb 1 2 3 4 5))
(ethel (amb 1 2 3 4 5))
(joan (amb 1 2 3 4 5))
(kitty (amb 1 2 3 4 5))
(mary (amb 1 2 3 4 5)))
(require (or (list (= kitty 2) (= betty 3))))
(require (or (list (= ethel 1) (= joan 2))))
(require (or (list (= joan 3) (= ethel 5))))
(require (or (list (= kitty 2) (= mary 4))))
(require (or (list (= mary 4) (= betty 1))))
(require
(distinct? (list betty ethel joan kitty mary)))
(list (list 'betty betty)
(list 'ethel ethel)
(list 'joan joan)
(list 'kitty kitty)
(list 'mary mary))))
;; ((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.43.</span> Use the amb evaluator to solve the following puzzle:
<br/><br/>
Mary Ann Moore's father has a yacht and so has each of his four friends: Colonel Downing, Mr. Hall, Sir Barnacle Hood, and Dr. Parker. Each of the five also has one daughter and each has named his yacht after a daughter of one of the others. Sir Barnacle's yacht is the Gabrielle, Mr. Moore owns the Lorna; Mr. Hall the Rosalind. The Melissa, owned by Colonel Downing, is named after Sir Barnacle's daughter. Gabrielle's father owns the yacht that is named after Dr. Parker's daughter. Who is Lorna's father?
<br/><br/>
Try to write the program so that it runs efficiently (see exercise 4.40). Also determine how many solutions there are if we are not told that Mary Ann's last name is Moore.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
1. Mary Ann is Mr. Moore's daughter. Therefore her father is Mr. Moore. We can remove Mr. Moore for consideration as the father of other girls.
<br/><br/>
2. Sir Barnacle owns the Gabrielle. So he cannot be Gabrielle's father.
<br/><br/>
3. Mr. Moore owns the Lorna and is Mary Ann's father.
<br/><br/>
4. Mr. Hall owns the Rosalind. Mr. Hall cannot be Rosalind's father.
<br/><br/>
5. The Melissa is owned by Col. Downing and named after Sir Barnacle's daughter. We can name Sir Barnacle as Melissa's father and remove him from the lists of possible fathers of other girls.
<br/><br/>
6. Gabrielle's father owns the yacht that is named after Dr. Parker's daughter. In my opinion formulating this restriction is the key learning of this exercise. Here is my approach: Gabrielle father is one of the following three: Col. Downing, Mr. Hall or Dr. Parker. If Dr. Parker is her father then the condition cannot be true as no man owns a yacht named after his own daughter. That leaves two possibilities and the restriction can be expressed in terms of those two.
<br/><br/>
If Col. Downing is Gabrielle's father Lorna must be Dr. Parker's daugther. On the other hand if Mr. Hall is Gabrielle's father then Rosalind must be Dr. Parker's daughter.
<br/>
<textarea name="code" class="sch" cols="60">
(define (daughters)
(let ((gabrielle (amb 'downing 'hall))
(lorna (amb 'downing 'hall 'parker))
(mary-ann 'moore)
(melissa 'barnacle-hood)
(rosalind (amb 'downing 'parker)))
(require (cond ((eq? gabrielle 'downing) (eq? lorna 'parker))
((eq? gabrielle 'hall) (eq? rosalind 'parker))
(else false)))
(require
(distinct? (list gabrielle lorna rosalind melissa mary-ann)))
lorna))
</textarea>
<br/>
Executing this, I got 'downing. Lorna's father is Col. Downing.
<br/><br/>
If we are not told about the identity of Mary Ann's father then the problem can be restructured as follows:
1. Sir Barnacle owns the Gabrielle. So he cannot be Gabrielle's father.
<br/><br/>
3. Mr. Moore owns the Lorna and therefore cannot be Lorna's father.
<br/><br/>
4. Mr. Hall owns the Rosalind. Mr. Hall cannot be Rosalind's father.
<br/><br/>
5. The Melissa is owned by Col. Downing and named after Sir Barnacle's daughter. We can name Sir Barnacle as Melissa's father and remove him from the lists of possible fathers of other girls.
<br/><br/>
6. Gabrielle's father owns the yacht that is named after Dr. Parker's daughter.
In this scenario Gabrielle father is one of the following four: Col. Downing, Mr. Hall, Mr. Moore or Dr. Parker. If Dr. Parker is her father then the condition cannot be true as no man owns a yacht named after his own daughter. Col. Downing cannot be Gabrielle's father as his yacht is not named after Dr. Parker's daughter. That leaves two possibilities and the restriction can be expressed in terms of the two.
<br/><br/>
If Mr. Hall is Gabrielle's father then Rosalind must be Dr. Parker's daughter.
If Mr. Moore is Gabrielle's father then Lorna must be Dr. Parker's daughter.
<br/>
<textarea name="code" class="sch" cols="60">
(define (daughters)
(let ((gabrielle (amb 'downing 'hall 'moore))
(lorna (amb 'downing 'hall 'parker))
(mary-ann (amb 'downing 'hall 'moore 'parker))
(melissa 'barnacle-hood)
(rosalind (amb 'downing 'moore 'parker)))
(require (cond ((eq? gabrielle 'hall) (eq? rosalind 'parker))
((eq? gabrielle 'moore) (eq? lorna 'parker))
(else false)))
(require
(distinct? (list gabrielle lorna rosalind melissa mary-ann)))
lorna))
</textarea>
<br/>
This problem has two answers: Lorna's father could be Col. Downing or Mr. Parker.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.44.</span> Exercise 2.42 described the ``eight-queens puzzle'' of placing queens on a chessboard so that no two attack each other. Write a nondeterministic program to solve this puzzle.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (an-element-of items)
(if (null? items)
(amb)
(amb (car items) (an-element-of (cdr items)))))
(define (generate-positions-for-col k board-size)
(map (lambda (row) (list k row))
(enumerate-interval 1 board-size)))
(define (map proc items)
(if (null? items)
'()
(cons (proc (car items))
(map proc (cdr items)))))
(define (enumerate-interval low high)
(if (> low high)
'()
(cons low (enumerate-interval (+ low 1) high))))
(define (require p)
(if (not p) (amb)))
(define (safe? k positions)
(define (iter new-pos others)
(if (null? others)
true
(let ((other-pos (car others)))
(if (row-col-or-dia-matches? new-pos other-pos)
false
(iter new-pos (cdr others))))))
(if (= k 1)
true
(iter (car positions) (cdr positions))))
(define (row-col-or-dia-matches? new-position other-position)
(or (list (same-row? new-position other-position)
(same-col? new-position other-position)
(same-diagonal? new-position other-position))))
(define (or args)
(cond ((null? args) false)
((car args) true)
(else (or (cdr args)))))
(define (same-row? pos1 pos2)
(= (cadr pos1) (cadr pos2)))
(define (same-col? pos1 pos2)
(= (car pos1) (car pos2)))
(define (same-diagonal? pos1 pos2)
(let ((k1 (car pos1))
(k2 (car pos2))
(r1 (cadr pos1))
(r2 (cadr pos2)))
(= (abs (- k1 k2))
(abs (- r1 r2)))))
(define (queens board-size)
(define (iter k rest-of-queens)
(let ((new-pos (an-element-of (generate-positions-for-col k board-size))))
(let ((positions (cons new-pos rest-of-queens)))
(require (safe? k positions))
(if (= k board-size)
positions
(iter (+ k 1) positions)))))
(iter 1 '()))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.45.</span> With the grammar given above, the following sentence can be parsed in five different ways: ``The professor lectures to the student in the class with the cat.'' Give the five parses and explain the differences in shades of meaning among them.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Parse 1: The professor is lecturing with the cat, in the classroom.
<pre>
The professor
lectures
to the student
in the class with the cat
</pre>
<br/>
<textarea name="code" class="sch" cols="60">
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(simple-noun-phrase (article the) (noun student))))
(prep-phrase (prep in)
(noun-phrase
(simple-noun-phrase (article the) (noun class))
(prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat)))))))
</textarea>
<br/>
Parse 2: The student has the cat. The professor is lecturing the student.
<pre>
The professor
lectures
to the student in the class with the cat
</pre>
<br/>
<textarea name="code" class="sch" cols="60">
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(noun-phrase
(simple-noun-phrase (article the) (noun student))
(prep-phrase (prep in)
(noun-phrase
(simple-noun-phrase (article the) (noun class))
(prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat)))))))))
</textarea>
<br/>
Parse 3: The professor has the cat. The professor is lecturing the student in the classroom. However it is not clear if the cat is in the classroom.
<pre>
The professor
lectures
to the student in the class
with the cat
</pre>
<br/>
<textarea name="code" class="sch" cols="60">
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(noun-phrase
(simple-noun-phrase (article the) (article student))
(prep-phrase (prep in)
(simple-noun-phrase (article the) (noun class))))))
(prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat)))))
</textarea>
<br/>
Parse 4: The student has the cat. However it is not clear if the student has brought the cat to the classroom.
<pre>
The professor
lectures
to the student in the class
with the cat
</pre>
<br/>
<textarea name="code" class="sch" cols="60">
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(noun-phrase
(noun-phrase
(simple-noun-phrase (article the) (article student))
(prep-phrase (prep in)
(simple-noun-phrase (article the) (noun class))))
(prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat)))))))
</textarea>
<br/>
Parse 5: There classroom has the cat. The professor is lecturing the student in this classroom. It is not clear if the cat belongs to the student or the professor. It could be a studious and independent cat choosing to spend its time in the classroom for all we know.
<pre>
The professor
lectures
to the student
in the class with the cat
</pre>
<br/>
<textarea name="code" class="sch" cols="60">
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(noun-phrase
(noun-phrase
(simple-noun-phrase (article the) (article student)))
(prep-phrase (prep in)
(noun-phrase
(simple-noun-phrase (article the) (noun class))
(prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat)))))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.46.</span> The evaluators in sections 4.1 and 4.2 do not determine what order operands are evaluated in. We will see that the amb evaluator evaluates them from left to right. Explain why our parsing program wouldn't work if the operands were evaluated in some other order.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I'll use the simplest grammar used at the start of the section to tackle this problem. A sentence is parsed as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-sentence)
(list 'sentence
(parse-noun-phrase)
(parse-word verbs)))
</textarea>
<br/>
Consider the sample input <tt>'(the cat eats)</tt>. Parse-sentence simply makes a call to <tt>list</tt>. Let us assume that the arguments to <tt>list</tt> are evaluated from right to left. <tt>(parse-word verbs)</tt> would therefore get invoked first. This procedure requires that the first word in <tt>*unparsed*</tt> should be present in the <tt>cdr</tt> of the word list passed in. In this case it would expect <tt>'the</tt> to be present in the list of verbs supplied. As this condition is never met, parsing fails. Thus we can see that the evaluator should use a left-to-right order for evaluating operands.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.47.</span> Louis Reasoner suggests that, since a verb phrase is either a verb or a verb phrase followed by a prepositional phrase, it would be much more straightforward to define the procedure parse-verb-phrase as follows (and similarly for noun phrases):
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-verb-phrase)
(amb (parse-word verbs)
(list 'verb-phrase
(parse-verb-phrase)
(parse-prepositional-phrase))))
</textarea>
<br/>
Does this work? Does the program's behavior change if we interchange the order of expressions in the amb?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Louis' version of <tt>parse-verb-phrase</tt> will work. Take for example the sentence 'The professor lectures to the student with the cat. <tt>Parse-verb-phrase</tt> will start by invoking <tt>(parse-word verbs)</tt> which will search <tt>*unparsed*</tt> for verbs. As 'lectures is a verb it will succeed and return <tt>'(verb lectures)</tt>. Parsing will continue as there are more words left.
<br/><br/>
On the subsequent try the second argument to amb, i.e. <tt>(list 'verb-phrase (parse-verb-phrase) (parse-prepositional-phrase))</tt> is evaluated. By the time the second argument is evaluated the <tt>set!</tt> operation would have been undone and <tt>*unparsed*</tt> would have been restored as <tt>'lectures to the student with the cat</tt>. <tt>(parse-verb-phrase)</tt> will return <tt>'(verb lectures)</tt> and <tt>(parse-prepositional-phrase)</tt> will continue to parse the rest of the words.
<br/><br/>
If we interchange the arguments to amb, the procedure becomes:
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-verb-phrase)
(amb (list 'verb-phrase
(parse-verb-phrase)
(parse-prepositional-phrase))
(parse-word verbs)))
</textarea>
<br/>
When the procedure is invoked, the arguments to <tt>list</tt> are evaluated. As the second argument is a recursive call to the same procedure, <tt>(parse-verb-phrase)</tt> is again invoked. This leads to an infinite loop as <tt>parse-verb-phrase</tt> never gets a chance to return.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.48.</span> Extend the grammar given above to handle more complex sentences. For example, you could extend noun phrases and verb phrases to include adjectives and adverbs, or you could handle compound sentences.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
This solution assumes the simplest case of adjective use - adjectives used as pre-modifiers. The adjective appears before the noun, after the article. For example 'the old professor. Such phrases are called adjective phrases. With this assumption we can modifiy the parse-simple-noun-phrase as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-simple-noun-phrase)
(amb
(list 'simple-noun-phrase
(parse-word articles)
(parse-word adjectives)
(parse-word nouns))
(list 'adjective-phrase
(parse-word articles)
(parse-word adjectives)
(parse-word nouns))))
</textarea>
<br/>
Here is a partial list of adjectives:
<br/>
<textarea name="code" class="sch" cols="60">
(define adjectives '(adjective old young big black))
</textarea>
<br/>
Similarly adverbs have varying rules of placement. Here is a simple solution which tackles adverbs placed after the verb. For example 'the old professor quietly lectured the young student with the black cat. Here 'quietly is an adverb modifying the verb, 'lectured. I have added a new category simple-verb-phrase and an utility procedure to parse them.
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-simple-verb-phrase)
(amb
(parse-word verbs)
(list 'simple-verb-phrase
(parse-word adverbs)
(parse-word verbs))))
</textarea>
<br/>
The parse-verb-phrase procedure has been changed accordingly.
<br/>
<textarea name="code" class="sch" cols="60">
(define (parse-verb-phrase)
(define (maybe-extend verb-phrase)
(amb verb-phrase
(maybe-extend (list 'verb-phrase
verb-phrase
(parse-prepositional-phrase)))))
(maybe-extend (parse-simple-verb-phrase)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.49.</span> Alyssa P. Hacker is more interested in generating interesting sentences than in parsing them. She reasons that by simply changing the procedure parse-word so that it ignores the ``input sentence'' and instead always succeeds and generates an appropriate word, we can use the programs we had built for parsing to do generation instead. Implement Alyssa's idea, and show the first half-dozen or so sentences generated.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (get-random-element items)
(list-ref items (random (length items))))
(define (parse-word word-list)
(let ((found-word (get-random-element (cdr word-list))))
(list (car word-list) found-word)))
</textarea>
<br/>
The sample sentences generated are quoted below. Apparently the recursive nature of the definition causes the new prepositional phrases to be generated and attached to the sentence rather than generating a new sentence. This looks like the recursion trap mentioned in footnote 54.
<br/>
<textarea name="code" class="sch" cols="60">
(sentence (simple-noun-phrase (article a) (noun professor)) (verb studies))
(sentence (simple-noun-phrase (article a) (noun professor)) (verb-phrase (verb studies) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun student)))))
(sentence (simple-noun-phrase (article a) (noun professor)) (verb-phrase (verb-phrase (verb studies) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun class)))))
(sentence (simple-noun-phrase (article a) (noun professor)) (verb-phrase (verb-phrase (verb-phrase (verb studies) (prep-phrase (prep in) (simple-noun-phrase (article the) (noun student)))) (prep-phrase (prep for) (simple-noun-phrase (article a) (noun class)))) (prep-phrase (prep with) (simple-noun-phrase (article a) (noun professor)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.50.</span> Implement a new special form ramb that is like amb except that it searches alternatives in a random order, rather than from left to right. Show how this can help with Alyssa's problem in exercise 4.49.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
My implementation of ramb works by fetching one element at random from its choices. This element is removed after use and the the process is continued with the rest of the elements. I have used the filter procedure defined in chapter 2 inside the utility procedure remove-from-list. Ramb fails after all its choices have been exhausted.
<br/>
<textarea name="code" class="sch" cols="60">
(define (remove-from-list element items)
(filter (lambda (x) (not (eq? x element))) items))
(define (get-random-element items)
(list-ref items (random (length items))))
(define (ramb? exp) (tagged-list? exp 'ramb))
(define (ramb-choices exp) (cdr exp))
(define (analyze-ramb exp)
(let ((cprocs (map analyze (ramb-choices exp))))
(lambda (env succeed fail)
(define (try-next choices)
(if (null? choices)
(fail)
(let ((element (get-random-element choices)))
(element env
succeed
(lambda ()
(try-next (remove-from-list element choices)))))))
(try-next cprocs))))
;; Added to analyze:
((ramb? exp) (analyze-ramb exp))
</textarea>
<br/>
The second part of the question is to demonstrate how ramb can help Alyssa's problem in exercise 4.49. My solution to exercise 4.49 does not involve amb. Parse-word simply picks up a word at random from the list given. I am unable to figure out how to use ramb to assist solving exercise 4.49.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.51.</span> Implement a new kind of assignment called permanent-set! that is not undone upon failure. For example, we can choose two distinct elements from a list and count the number of trials required to make a successful choice as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define count 0)
(let ((x (an-element-of '(a b c)))
(y (an-element-of '(a b c))))
(permanent-set! count (+ count 1))
(require (not (eq? x y)))
(list x y count))
;;; Starting a new problem
;;; Amb-Eval value:
(a b 2)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(a c 3)
</textarea>
<br/>
What values would have been displayed if we had used set! here rather than permanent-set! ?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (permanent-assignment? exp)
(tagged-list? exp 'permanent-set!))
(define (analyze-permanent-assignment exp)
(let ((var (assignment-variable exp))
(vproc (analyze (assignment-value exp))))
(lambda (env succeed fail)
(vproc env
(lambda (val fail2)
(set-variable-value! var val env)
(succeed 'ok fail2))
fail))))
;; Addition to analyze:
((permanent-assignment? exp) (analyze-permanent-assignment exp))
</textarea>
<br/>
Count would be printed as 1 always if we had used set! instead of permanent-set!
<br/><br/>
<span style="font-weight:bold;">Exercise 4.52.</span> Implement a new construct called if-fail that permits the user to catch the failure of an expression. If-fail takes two expressions. It evaluates the first expression as usual and returns as usual if the evaluation succeeds. If the evaluation fails, however, the value of the second expression is returned, as in the following example:
<br/>
<textarea name="code" class="sch" cols="60">
;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
(require (even? x))
x)
'all-odd)
;;; Starting a new problem
;;; Amb-Eval value:
all-odd
;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5 8))))
(require (even? x))
x)
'all-odd)
;;; Starting a new problem
;;; Amb-Eval value:
8
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (if-fail? exp)
(tagged-list? exp 'if-fail))
(define (first-expression exp)
(cadr exp))
(define (alternate-expression exp)
(caddr exp))
(define (analyze-if-fail exp)
(let ((fproc (analyze (first-expression exp)))
(aproc (analyze (alternate-expression exp))))
(lambda (env succeed fail)
(fproc env
succeed
(lambda ()
(aproc env succeed fail))))))
;; Addition to analyze
((if-fail? exp) (analyze-if-fail exp))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.53.</span> With permanent-set! as described in exercise 4.51 and if-fail as in exercise 4.52, what will be the result of evaluating
<br/>
<textarea name="code" class="sch" cols="60">
(let ((pairs '()))
(if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
(permanent-set! pairs (cons p pairs))
(amb))
pairs))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
The expression will print <tt>((8 35) (3 110) (3 20))</tt>
<br/><br/>
<span style="font-weight:bold;">Exercise 4.54.</span> If we had not realized that require could be implemented as an ordinary procedure that uses amb, to be defined by the user as part of a nondeterministic program, we would have had to implement it as a special form. This would require syntax procedures
<br/>
<textarea name="code" class="sch" cols="60">
(define (require? exp) (tagged-list? exp 'require))
(define (require-predicate exp) (cadr exp))
</textarea>
<br/>
and a new clause in the dispatch in analyze
<br/>
<textarea name="code" class="sch" cols="60">
((require? exp) (analyze-require exp))
</textarea>
<br/>
as well the procedure analyze-require that handles require expressions. Complete the following definition of analyze-require.
<br/>
<textarea name="code" class="sch" cols="60">
(define (analyze-require exp)
(let ((pproc (analyze (require-predicate exp))))
(lambda (env succeed fail)
(pproc env
(lambda (pred-value fail2)
(if <??>
<??>
(succeed 'ok fail2)))
fail))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (analyze-require exp)
(let ((pproc (analyze (require-predicate exp))))
(lambda (env succeed fail)
(pproc env
(lambda (pred-value fail2)
(if (not (true? pred-value))
(fail)
(succeed 'ok fail2)))
fail))))
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-87203670552859519102009-01-14T17:57:00.010+05:302009-01-14T18:35:02.913+05:30SICP Section 4.2 Variations on a Scheme -- Lazy EvaluationExercise 4.25. Suppose that (in ordinary applicative-order Scheme) we define unless as shown above and then define factorial in terms of unless as
<br/>
<textarea name="code" class="sch" cols="60">
(define (factorial n)
(unless (= n 1)
(* n (factorial (- n 1)))
1))
</textarea>
<br/>
What happens if we attempt to evaluate (factorial 5)? Will our definitions work in a normal-order language?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The expression (factorial 5) leads to the following application of unless:
<br/>
<textarea name="code" class="sch" cols="60">
(unless (= n 1) (* n (factorial (- n 1))) 1)
</textarea>
<br/>
In an applicative-order language all the arguments to a procedure are evaluated when the procedure is applied. In the case of the above expression the first and third arguments are readily evaluated irrespective of the order of evaluation (left to right or vice-versa). The second argument however requires evaluating <tt>(factorial (-n 1))</tt>, i.e. <tt>(factorial 4)</tt> for completion. This is turn requires that <tt>(factorial 3)</tt> be evaluated and so on. The evaluation never completes even when n becomes 1 as the second argument never gets evaluated. Therefore we are left with an infinite loop.
<br/><br/>
In a normal-order language evaluation of procedure arguments are delayed until the actual argument values are needed. In the case of the above expression <tt>(factorial 4)</tt> is invoked as n != 1. The recursive invocation continues until the time n becomes 1. When n = 1, the second argument of the unless expression is not evaluated and 1 is returned. Therefore the program completes and we get the result.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.26.</span> Ben Bitdiddle and Alyssa P. Hacker disagree over the importance of lazy evaluation for implementing things such as unless. Ben points out that it's possible to implement unless in applicative order as a special form. Alyssa counters that, if one did that, unless would be merely syntax, not a procedure that could be used in conjunction with higher-order procedures. Fill in the details on both sides of the argument. Show how to implement unless as a derived expression (like cond or let), and give an example of a situation where it might be useful to have unless available as a procedure, rather than as a special form.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (unless? exp)
(tagged-list? exp 'unless))
(define (unless-condition exp)
(cadr exp))
(define (unless-usual-value exp)
(caddr exp))
(define (unless-exceptional-value exp)
(if (null? (cdddr exp))
'false
(cadddr exp)))
(define (analyze-unless exp)
(let ((condition (analyze (unless-condition exp)))
(usual-value (analyze (unless-usual-value exp)))
(exceptional-value (analyze (unless-exceptional-value exp))))
(lambda (env)
(if (true? (condition env))
(exceptional-value env)
(usual-value env)))))
;; Addition to analyze:
((unless? exp) (analyze-unless exp))
</textarea>
<br/>
I am not able to come up with any examples of using unless as a higher order procedure. :(
<br/><br/>
<span style="font-weight:bold;">Exercise 4.27.</span> Suppose we type in the following definitions to the lazy evaluator:
<br/>
<textarea name="code" class="sch" cols="60">
(define count 0)
(define (id x)
(set! count (+ count 1))
x)
</textarea>
<br/>
Give the missing values in the following sequence of interactions, and explain your answers.
<br/>
<textarea name="code" class="sch" cols="60">
(define w (id (id 10)))
;;; L-Eval input:
count
;;; L-Eval value:
<response>
;;; L-Eval input:
w
;;; L-Eval value:
<response>
;;; L-Eval input:
count
;;; L-Eval value:
<response>
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define w (id (id 10)))
;;; L-Eval input:
count
;;; L-Eval value:
1
;;; L-Eval input:
w
;;; L-Eval value:
10
;;; L-Eval input:
count
;;; L-Eval value:
2
</textarea>
<br/>
Explanation: When the preceding statement <tt>(define w (id (id 10)))</tt> is evaluated only the outer call to id is forced as it is immediately required. This causes count to be incremented once, to 1. The value of w becomes a thunk consisting of the inner call to id and the environment. This can be inspected by calling (lookup-variable-value 'w the-global-environment) after evaluating the expressions.
<br/><br/>
When w is called the driver-loop forces the actual-value of the thunk to be evaluated before presenting it to the output. This causes the delayed call to <tt>(id 10)</tt> to be executed. This expression increments count again and returns 10.
<br/><br/>
As the actual-value of w was forced in the last expression count has become 2.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.28.</span> Eval uses actual-value rather than eval to evaluate the operator before passing it to apply, in order to force the value of the operator. Give an example that demonstrates the need for this forcing.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Consider the following function. It retruns either of the procedures even? or odd? depending on the input.
<br/>
<textarea name="code" class="sch" cols="60">
(define (choose x)
(if (= x 1) even? odd?))
</textarea>
<br/>
Now invoke this function as shown below
<br/>
<textarea name="code" class="sch" cols="60">
((choose 1) 2)
</textarea>
<br/>
If the evaluator did not use actual-value to evaluate the operator the operand would have been a thunk representing (choose 1) and not the actual result. Consequently the expression would have thrown an error.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.29.</span> Exhibit a program that you would expect to run much more slowly without memoization than with memoization. Also, consider the following interaction, where the id procedure is defined as in exercise 4.27 and count starts at 0:
<br/>
<textarea name="code" class="sch" cols="60">
(define (square x)
(* x x))
;;; L-Eval input:
(square (id 10))
;;; L-Eval value:
<response>
;;; L-Eval input:
count
;;; L-Eval value:
<response>
</textarea>
<br/>
Give the responses both when the evaluator memoizes and when it does not.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The program given below involves two recursive calls to itself. It will be faster with memoization than without.
<br/>
<textarea name="code" class="sch" cols="60">
(define (fib n)
(cond ((= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1))
(fib (- n 2))))))
</textarea>
<br/>
<br/>
<textarea name="code" class="sch" cols="60">
(square (id 10))
100
</textarea>
<br/>
This result is the same with or without memoization.
<br/>
<textarea name="code" class="sch" cols="60">
count
1 ;; with memoization
2 ;; without memoization.
</textarea>
<br/>
When <tt>(square (id 10))</tt> is called, the evaluation of <tt>(id 10)</tt> is delayed until it is actually needed. The need for forcing <tt>(id 10)</tt> happens when <tt>(* x x)</tt> is evaluated. Without memoization the procedure id is invoked twice, once for each argument to *, causing count to be incremented twice. With memoization id is only invoked once. The return value is used without calling it again for the second argument to *. Therefore count is incremented only once with memoization.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.30.</span> Cy D. Fect, a reformed C programmer, is worried that some side effects may never take place, because the lazy evaluator doesn't force the expressions in a sequence. Since the value of an expression in a sequence other than the last one is not used (the expression is there only for its effect, such as assigning to a variable or printing), there can be no subsequent use of this value (e.g., as an argument to a primitive procedure) that will cause it to be forced. Cy thus thinks that when evaluating sequences, we must force all expressions in the sequence except the final one. He proposes to modify eval-sequence from section 4.1.1 to use actual-value rather than eval:
<br/>
<textarea name="code" class="sch" cols="60">
(define (eval-sequence exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (actual-value (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
</textarea>
<br/>
a. Ben Bitdiddle thinks Cy is wrong. He shows Cy the for-each procedure described in exercise 2.23, which gives an important example of a sequence with side effects:
<br/>
<textarea name="code" class="sch" cols="60">
(define (for-each proc items)
(if (null? items)
'done
(begin (proc (car items))
(for-each proc (cdr items)))))
</textarea>
<br/>
He claims that the evaluator in the text (with the original eval-sequence) handles this correctly:
<br/>
<textarea name="code" class="sch" cols="60">
;;; L-Eval input:
(for-each (lambda (x) (newline) (display x))
(list 57 321 88))
57
321
88
;;; L-Eval value:
done
</textarea>
<br/>
Explain why Ben is right about the behavior of for-each.
b. Cy agrees that Ben is right about the for-each example, but says that that's not the kind of program he was thinking about when he proposed his change to eval-sequence. He defines the following two procedures in the lazy evaluator:
<br/>
<textarea name="code" class="sch" cols="60">
(define (p1 x)
(set! x (cons x '(2)))
x)
(define (p2 x)
(define (p e)
e
x)
(p (set! x (cons x '(2)))))
</textarea>
<br/>
What are the values of (p1 1) and (p2 1) with the original eval-sequence? What would the values be with Cy's proposed change to eval-sequence?
<br/><br/>
c. Cy also points out that changing eval-sequence as he proposes does not affect the behavior of the example in part a. Explain why this is true.
<br/><br/>
d. How do you think sequences ought to be treated in the lazy evaluator? Do you like Cy's approach, the approach in the text, or some other approach?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a. The lambda procedure used with for-each uses two primitive procedures, newline and display. As apply does not delay the arguments in the case of primitive procedures, newline and display are executed immediately. Hence Ben is able to predict that the original evaluator can handle the operation correctly.
<br/><br/>
b. <br/>
(p1 1) returns (1 2) with the original eval-sequence. <br/>
(p2 1) returns 1 with the original eval-sequence. <br/>
The set! expression is passed to the internal procedure p in the form of a thunk. As this thunk is not forced, the value of x remains unchanged. Hence (p2 1) returns 1.
<br/><br/>
After implementing Cy's changes the behaviour of (p1 1) remains unchanged. However (p2 1) will return (1 2). This is a consequence of forcing all expressions in eval-sequence. The set! expression passed on to the internal procedure p as a thunk gets forced, thereby changing the value of x. Hence (p2 1) returns (1 2).
<br/><br/>
c. The example in part a uses primitive procedures for display. As arguments to primitive procedures were not delayed to begin with, the behavior remains unchanged.
<br/><br/>
d. Both approaches have their own trade offs. I prefer Cy's approach where assignment is involved. However this approach can slow things down where long sequences are involved.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.31.</span> The approach taken in this section is somewhat unpleasant, because it makes an incompatible change to Scheme. It might be nicer to implement lazy evaluation as an upward-compatible extension, that is, so that ordinary Scheme programs will work as before. We can do this by extending the syntax of procedure declarations to let the user control whether or not arguments are to be delayed. While we're at it, we may as well also give the user the choice between delaying with and without memoization. For example, the definition
<br/>
<textarea name="code" class="sch" cols="60">
(define (f a (b lazy) c (d lazy-memo))
...)
</textarea>
<br/>
would define f to be a procedure of four arguments, where the first and third arguments are evaluated when the procedure is called, the second argument is delayed, and the fourth argument is both delayed and memoized. Thus, ordinary procedure definitions will produce the same behavior as ordinary Scheme, while adding the lazy-memo declaration to each parameter of every compound procedure will produce the behavior of the lazy evaluator defined in this section. Design and implement the changes required to produce such an extension to Scheme. You will have to implement new syntax procedures to handle the new syntax for define. You must also arrange for eval or apply to determine when arguments are to be delayed, and to force or delay arguments accordingly, and you must arrange for forcing to memoize or not, as appropriate.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
;; Changes to procedure-parameters.
;; Input (a (b lazy) c (d lazy-memo))
;; Returns (a b c d)
(define (procedure-parameters p)
(map (lambda (x) (if (pair? x) (car x) x))
(procedure-parameters-with-tags p)))
;; Returns procedure parameters with tags
(define (procedure-parameters-with-tags p)
(cadr p))
;; New form of delay-it for memo
(define (delay-it-memo exp env)
(list 'thunk-memo exp env))
(define (thunk-memo? obj)
(tagged-list? obj 'thunk-memo))
;; Force-it does not memoize if thunk does not indicate that it has to be memoized
(define (force-it obj)
(cond ((thunk-memo? obj) ;; Memoized thunk.
(let ((result (actual-value
(thunk-exp obj)
(thunk-env obj))))
(set-car! obj 'evaluated-thunk)
(set-car! (cdr obj) result)
(set-cdr! (cdr obj) '())
result))
;; Thunk has already been evaluated.
((evaluated-thunk? obj)
(thunk-value obj))
;; Orinary thunk
((thunk? obj)
(actual-value
(thunk-exp obj)
(thunk-env obj)))
(else obj)))
;; Changes to list-of-delayed-args
;; The procedure parameters are also passed in.
;; Arguments are delayed if the corresponding parameter is tagged lazy.
(define (list-of-delayed-args parameters exps env)
(define (operation-type parm)
(cond ((lazy? parm) delay-it)
((lazy-memo? parm) delay-it-memo)
(else actual-value)))
(if (no-operands? exps)
'()
(let ((first-parm (car parameters))
(first-arg (first-operand exps)))
(cons ((operation-type first-parm) (first-operand exps) env)
(list-of-delayed-args (cdr parameters)
(rest-operands exps)
env)))))
;; Decide if parameter is lazy, lazy-memo or not.
(define (ends-with-tag? exp tag)
(if (pair? exp)
(eq? (cadr exp) tag)
false))
(define (lazy? exp)
(ends-with-tag? exp 'lazy))
(define (lazy-memo? exp)
(ends-with-tag? exp 'lazy-memo))
;; Changes to apply.
(define (apply procedure arguments env)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure
procedure
(list-of-arg-values arguments env))) ; changed
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
(list-of-delayed-args (procedure-parameters-with-tags procedure) arguments env) ; changed
(procedure-environment procedure))))
(else
(error
"Unknown procedure type -- APPLY" procedure))))
</textarea>
<br/>
This was a truly fascinating exercise. It looked intimidating but I came to enjoy doing it.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.32.</span> Give some examples that illustrate the difference between the streams of chapter 3 and the ``lazier'' lazy lists described in this section. How can you take advantage of this extra laziness?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The ability to delay both car and cdr operation allows us to create data structures that behave like streams w.r.t car as well as cdr. One such structure would be an infinite tree. If we recall how trees were implemented as lists earlier we can see how lazy car and cdr allow us to convert those to infinite trees.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.33.</span> Ben Bitdiddle tests the lazy list implementation given above by evaluating the expression
<br/>
<textarea name="code" class="sch" cols="60">
(car '(a b c))
</textarea>
<br/>
To his surprise, this produces an error. After some thought, he realizes that the ``lists'' obtained by reading in quoted expressions are different from the lists manipulated by the new definitions of cons, car, and cdr. Modify the evaluator's treatment of quoted expressions so that quoted lists typed at the driver loop will produce true lazy lists.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The key change is in the way quoted expressions are evaluated. The eval procedure is changed to construct and evaluate lazy lists if the quoted text contains a list. Lazy lists are constructed using a utility procedure text-list->lazy-list.
<br/>
<textarea name="code" class="sch" cols="60">
(define (text-list->lazy-list exp)
(cond ((null? exp) '())
((symbol? exp) (list 'quote exp))
(else (list 'cons
(text-list->lazy-list (car exp))
(text-list->lazy-list (cdr exp))))))
;; Changes to eval.
((quoted? exp)
(let ((text (text-of-quotation exp)))
(if (pair? text)
(eval (text-list->lazy-list text) env)
text)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.34.</span> Modify the driver loop for the evaluator so that lazy pairs and lists will print in some reasonable way. (What are you going to do about infinite lists?) You may also need to modify the representation of lazy pairs so that the evaluator can identify them in order to print them.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
In order to print lazy lists we should first identify them as such. Ideally there should be a tag, say 'lazy-list or some such for the same. Right now I am using a make shift solutions, identifying them by matching them with the structure of cons. i.e. (lambda (m) (m x y))
<br/>
<textarea name="code" class="sch" cols="60">
(define (lazy-list? object)
(and (compound-procedure? object)
(equal? (procedure-parameters object) (list 'm))
(equal? (procedure-body object) (list (list 'm 'x 'y)))))
</textarea>
<br/>
Next, driver-loop should be modified to check if the output is a lazy list. If so it invokes a special procedure to print the output. The first 5 elements of a list are printed followed by "..." if there are more. This number is arbitrary.
<br/>
<textarea name="code" class="sch" cols="60">
(define (driver-loop)
(prompt-for-input input-prompt)
(let ((input (read)))
(let ((output
(actual-value input the-global-environment)))
(announce-output output-prompt)
(if (lazy-list? output)
(display (display-lazy-pair input 5))
(user-print output))))
(driver-loop))
</textarea>
<br/>
Finally a special procedure to print a lazy list.
<br/>
<textarea name="code" class="sch" cols="60">
(define (display-lazy-pair exp count)
(define (get-actual-value op exp)
(actual-value (list op exp) the-global-environment))
(if (> count 0)
(let ((first (get-actual-value 'car exp))
(rest (get-actual-value 'cdr exp)))
(append
(if (lazy-list? first)
(display-lazy-pair (list 'car exp) (- count 1))
(list first))
(if (lazy-list? rest)
(display-lazy-pair (list 'cdr exp) (- count 1))
(list rest))))
'(...)))
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com1tag:blogger.com,1999:blog-16889165.post-66687737868055091002009-01-13T17:00:00.004+05:302009-01-13T18:33:56.617+05:30SICP Section 4.1 The Metacircular Evaluator<span style="font-weight:bold;">Exercise 4.1.</span> Notice that we cannot tell whether the metacircular evaluator evaluates operands from left to right or from right to left. Its evaluation order is inherited from the underlying Lisp: If the arguments to cons in list-of-values are evaluated from left to right, then list-of-values will evaluate operands from left to right; and if the arguments to cons are evaluated from right to left, then list-of-values will evaluate operands from right to left.
<br/><br/>
Write a version of list-of-values that evaluates operands from left to right regardless of the order of evaluation in the underlying Lisp. Also write a version of list-of-values that evaluates operands from right to left.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Version of list-of-values that evaluates from left to right irrespective of order of evaluation in the underlying Lisp.
<br/>
<textarea name="code" class="sch" cols="60">
(define (list-of-values exps env)
(define (iter results exps)
(if (no-operands? exps)
results
(let ((result (eval (first-operand exps) env)))
(iter (cons result results) (rest-operands exps)))))
(iter '() exps))
</textarea>
<br/>
Version of list-of-values that evaluates from right to left irrespective of order of evaluation in the underlying Lisp.
<br/>
<textarea name="code" class="sch" cols="60">
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(let ((right (list-of-values (rest-operands) exps)))
(cons (eval (first-operand exps) env) right))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.2.</span> Louis Reasoner plans to reorder the cond clauses in eval so that the clause for procedure applications appears before the clause for assignments. He argues that this will make the interpreter more efficient: Since programs usually contain more applications than assignments, definitions, and so on, his modified eval will usually check fewer clauses than the original eval before identifying the type of an expression.
<br/><br/>
a. What is wrong with Louis's plan? (Hint: What will Louis's evaluator do with the expression (define x 3)?)
<br/><br/>
b. Louis is upset that his plan didn't work. He is willing to go to any lengths to make his evaluator recognize procedure applications before it checks for most other kinds of expressions. Help him by changing the syntax of the evaluated language so that procedure applications start with call. For example, instead of (factorial 3) we will now have to write (call factorial 3) and instead of (+ 1 2) we will have to write (call + 1 2).
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a. After Louis' changes, all definitions will be evaluated as procedure applications. This can lead to errors. In the example (define x 3) will be treated as the application of the procedure define on the values x and 3.
<br/><br/>
b. This can be achieved by changing the selectors.
<br/>
<textarea name="code" class="sch" cols="60">
(define (application? exp)
(tagged-list? exp 'call))
(define (operator exp)
(cadr exp))
(define (operands exp)
(cddr exp))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.3.</span> Rewrite eval so that the dispatch is done in data-directed style. Compare this with the data-directed differentiation procedure of exercise 2.73. (You may use the car of a compound expression as the type of the expression, as is appropriate for the syntax implemented in this section.).
<br/><br/>
<br/>
<textarea name="code" class="sch" cols="60">
(define (eval exp env)
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((get 'eval (car exp))
((get 'eval (car exp)) exp env))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))
;; (put 'quote (lambda (exp env) (text-of-quotation exp)))
;; (put 'set! eval-assignment)
;; (put 'define eval-definition)
;; (put 'if eval-if)
;; (put 'lambda (lambda (exp env) (make-procedure (lambda-parameters exp)
;; (lambda-body exp)
;; env)))
;; (put 'begin eval-sequence)
;; (put 'cond (lambda (exp env) (eval (cond->if exp) env)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.4.</span> Recall the definitions of the special forms and and or from chapter 1:
<ul>
<li>and: The expressions are evaluated from left to right. If any expression evaluates to false, false is returned; any remaining expressions are not evaluated. If all the expressions evaluate to true values, the value of the last expression is returned. If there are no expressions then true is returned.</li>
<li>or: The expressions are evaluated from left to right. If any expression evaluates to a true value, that value is returned; any remaining expressions are not evaluated. If all expressions evaluate to false, or if there are no expressions, then false is returned. </li>
</ul>
Install and and or as new special forms for the evaluator by defining appropriate syntax procedures and evaluation procedures eval-and and eval-or. Alternatively, show how to implement and and or as derived expressions.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (and? exp) (tagged-list? exp 'and))
(define (eval-and exp env)
(define (iter ops)
(if (no-operands? ops)
true
(if (eval (first-operand ops) env)
(iter (rest-operands ops))
false)))
(iter (operands exp)))
(define (or? exp) (tagged-list? exp 'or))
(define (eval-or exp env)
(define (iter ops)
(if (no-operands? ops)
false
(let ((value (eval (first-operand ops) env)))
(if value value (iter (rest-operands ops))))))
(iter (operands exp)))
;; Implementation as derived expressions
(define (and->if exp)
(expand-and-clauses (and-clauses exp)))
(define (expand-and-clauses clauses)
(if (null? clauses)
'true
(make-if (car clauses)
(expand-and-clauses (cdr clauses))
'false)))
(define (or->if exp)
(expand-or-clauses (and-clauses exp)))
(define (expand-or-clauses clauses)
(if (null? clauses)
'false
(make-if (car clauses)
'true
(expand-or-clauses (cdr clauses)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.5.</span> Scheme allows an additional syntax for cond clauses, (<test> => <recipient>). If <test> evaluates to a true value, then <recipient> is evaluated. Its value must be a procedure of one argument; this procedure is then invoked on the value of the <test>, and the result is returned as the value of the cond expression. For example
<br/>
<textarea name="code" class="sch" cols="60">
(cond ((assoc 'b '((a 1) (b 2))) => cadr)
(else false))
</textarea>
<br/>
returns 2. Modify the handling of cond so that it supports this extended syntax.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (cond-additional-syntax? clause)
(and (= (length clause) 3)
(eq? (caddr clause) '=>)))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last -- COND->IF"
clauses))
(let ((predicate (cond-predicate first))
(actions (cond-actions first)))
(if (cond-additional-syntax? clause)
(make-if predicate
(list (cadr actions) predicate)
(expand-clauses rest))
(make-if predicate
(sequence->exp actions)
(expand-clauses rest)))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.6.</span> Let expressions are derived expressions, because
<br/>
<textarea name="code" class="sch" cols="60">
(let ((<var1> <exp1>) ... (<varn> <expn>))
<body>)
</textarea>
<br/>
is equivalent to
<br/>
<textarea name="code" class="sch" cols="60">
((lambda (<var1> ... <varn>)
<body>)
<exp1>
<expn>)
</textarea>
<br/>
Implement a syntactic transformation let->combination that reduces evaluating let expressions to evaluating combinations of the type shown above, and add the appropriate clause to eval to handle let expressions.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (let? exp)
(tagged-list? exp 'let))
(define (let-variables-and-expressions exp)
(cadr exp))
(define (let-body exp)
(caddr exp))
(define (let->combination exp)
(let ((variables-and-expressions (let-variables-and-expressions exp))
(body (let-body exp)))
(let ((parameters (map car variables-and-expressions))
(expressions (map cadr variables-and-expressions)))
(cons (make-lambda parameters body) expressions))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.7.</span> Let* is similar to let, except that the bindings of the let variables are performed sequentially from left to right, and each binding is made in an environment in which all of the preceding bindings are visible. For example
<br/>
<textarea name="code" class="sch" cols="60">
(let* ((x 3)
(y (+ x 2))
(z (+ x y 5)))
(* x z))
</textarea>
<br/>
returns 39. Explain how a let* expression can be rewritten as a set of nested let expressions, and write a procedure let*->nested-lets that performs this transformation. If we have already implemented let (exercise 4.6) and we want to extend the evaluator to handle let*, is it sufficient to add a clause to eval whose action is
<br/>
<textarea name="code" class="sch" cols="60">
(eval (let*->nested-lets exp) env)
</textarea>
<br/>
or must we explicitly expand let* in terms of non-derived expressions?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-let variable-and-expression body)
(list 'let variable-and-expression body))
(define (let*->nested-lets exp)
(define (iter variables-and-expressions body)
(if (null? variables-and-expressions)
body
(make-let (car variables-and-expressions)
(iter (cdr variables-and-expressions) body))))
(iter (let-variables-and-expressions exp) (let-body exp)))
</textarea>
<br/>
b. It is sufficient to add the given snippet to eval to make let* work.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.8.</span> ``Named let'' is a variant of let that has the form
<br/>
<textarea name="code" class="sch" cols="60">
(let <var> <bindings> <body>)
</textarea>
<br/>
The <bindings> and <body> are just as in ordinary let, except that <var> is bound within <body> to a procedure whose body is <body> and whose parameters are the variables in the <bindings>. Thus, one can repeatedly execute the <body> by invoking the procedure named <var>. For example, the iterative Fibonacci procedure (section 1.2.2) can be rewritten using named let as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (fib n)
(let fib-iter ((a 1)
(b 0)
(count n))
(if (= count 0)
b
(fib-iter (+ a b) a (- count 1)))))
</textarea>
<br/>
Modify let->combination of exercise 4.6 to also support named let.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (named-let? exp)
(and (let? exp)
(= (length exp) 4)))
(define (let-var exp)
(if (named-let? exp)
(cadr exp)
'()))
(define (let-bindings exp)
(if (named-let? exp)
(caddr exp)
(cadr exp)))
(define (let-body exp)
(if (named-let? exp)
(caddr exp)
(cadddr exp)))
(define (make-named-lambda-definition var parameters body)
(list 'define var (make-lambda parameters body)))
(define (let->combination exp)
(let ((var (let-var exp))
(bindings (let-bindings exp))
(body (let-body exp)))
(let ((parameters (map car bindings))
(expressions (map cadr bindings)))
(if (named-let? exp)
(list (make-named-lambda-definition var parameters body)
(cons var expressions))
(cons (make-lambda parameters body) expressions)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.9.</span> Many languages support a variety of iteration constructs, such as do, for, while, and until. In Scheme, iterative processes can be expressed in terms of ordinary procedure calls, so special iteration constructs provide no essential gain in computational power. On the other hand, such constructs are often convenient. Design some iteration constructs, give examples of their use, and show how to implement them as derived expressions.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (while? exp)
(tagged-list? exp 'while))
(define (while-predicate exp)
(cadr exp))
(define (while-body exp)
(caddr exp))
(define (while->combination exp)
(let ((predicate (while-predicate exp))
(body (while-body exp)))
(sequence->exp
(list (make-named-lambda-definition
'while-loop
'()
(make-if predicate
(list body (list 'while-loop))
'true))
(list 'while-loop)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.11.</span> Instead of representing a frame as a pair of lists, we can represent a frame as a list of bindings, where each binding is a name-value pair. Rewrite the environment operations to use this alternative representation.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Lookup function remains unchanged. Changed code follows.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-frame variables values)
(define (iter variables values frame)
(if (null? variables)
frame
(iter (cdr variables)
(cdr values)
(cons (cons (car variables) (car values)) frame))))
(iter variables values '()))
(define (frame-variables frame)
(map car frame))
(define (frame-values frame)
(map cdr frame))
(define (add-binding-to-frame! var val frame)
(let ((old-car (car frame))
(new-car (cons var val)))
(set-car! frame new-car)
(set-cdr! frame (cons old-car (cdr frame)))))
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan pairs)
(cond ((null? pairs)
(env-loop (enclosing-environment env)))
((eq? var (caar pairs))
(set-cdr! (car pairs) val))
(else (scan (cdr pairs)))))
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((frame (first-frame env)))
(scan frame))))
(env-loop env))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define (scan pairs)
(cond ((null? pairs)
(add-binding-to-frame! var val frame))
((eq? var (caar pairs))
(set-cdr! (car pairs) val))
(else (scan (cdr pairs)))))
(scan frame)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.12. </span> The procedures set-variable-value!, define-variable!, and lookup-variable-value can be expressed in terms of more abstract procedures for traversing the environment structure. Define abstractions that capture the common patterns and redefine the three procedures in terms of these abstractions.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
This solution depends on the original mechanism of representing frames.
<br/>
<textarea name="code" class="sch" cols="60">
(define (lookup-value-in-frame var frame)
(define (iter variables values)
(cond ((null? variables) false)
((eq? var (car variables))
(car values))
(else
(iter (cdr variables) (cdr values)))))
(iter (frame-variables frame) (frame-values frame)))
(define (lookup-variable-value var env)
(define (env-loop env)
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((value (lookup-value-in-frame var (first-frame env))))
(if value value (env-loop (enclosing-environment env))))))
(env-loop env))
(define (set-value-in-frame! var val frame)
(define (iter variables values)
(cond ((null? values) false)
((eq? var (car variables))
(set-car! values val))
(else
(iter (cdr variables) (cdr values)))))
(iter (frame-variables frame) (frame-values frame)))
(define (set-variable-value! var val env)
(define (env-loop env)
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(let ((result (set-value-in-frame! var val (first-frame env))))
(if (not result) (env-loop (enclosing-environment env))))))
(env-loop env))
(define (define-variable-in-frame! var val frame)
(if (not (set-value-in-frame! var val frame))
(add-binding-to-frame! var val frame)))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(define-variable-in-frame! var val frame)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.13.</span> Scheme allows us to create new bindings for variables by means of define, but provides no way to get rid of bindings. Implement for the evaluator a special form make-unbound! that removes the binding of a given symbol from the environment in which the make-unbound! expression is evaluated. This problem is not completely specified. For example, should we remove only the binding in the first frame of the environment? Complete the specification and justify any choices you make.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
I prefer to treat make-unbound! as the functional opposite of define-variable!. Therefore it should only remove the binding from the first frame. This also prevents the operation from affecting the global environment, which is desirable. The operation raises an error if the value being unbound is not present in the first frame.
<br/>
<textarea name="code" class="sch" cols="60">
(define (remove-binding-from-frame var frame)
(let ((new-vars '()) (new-vals '()))
(define (iter variables values)
(cond ((not (null? variables))
(cond ((not (eq? var (car variables)))
(set! new-vars (cons (car variables) new-vars))
(set! new-vals (cons (car values) new-vals))))
(iter (cdr variables) (cdr values)))))
(iter (frame-variables frame) (frame-values frame))
(set-car! frame new-vars)
(set-cdr! frame new-vals)))
(define (make-unbound! var env)
(let ((frame (first-frame env)))
(if (lookup-value-in-frame var frame)
(remove-binding-from-frame var frame)
(error "Unbound variable -- REMOVE!" var))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.14.</span> Eva Lu Ator and Louis Reasoner are each experimenting with the metacircular evaluator. Eva types in the definition of map, and runs some test programs that use it. They work fine. Louis, in contrast, has installed the system version of map as a primitive for the metacircular evaluator. When he tries it, things go terribly wrong. Explain why Louis's map fails even though Eva's works.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Louis' version of map uses the primitive version of the procedure. This version expects a <procedure> in the *native language* as the first argument, to be applied by the *native apply*. However the argument supplied to map is in the *new language*. This leads to errors.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.15.</span> Given a one-argument procedure p and an object a, p is said to ``halt'' on a if evaluating the expression (p a) returns a value (as opposed to terminating with an error message or running forever). Show that it is impossible to write a procedure halts? that correctly determines whether p halts on a for any procedure p and object a. Use the following reasoning: If you had such a procedure halts?, you could implement the following program:
<br/>
<textarea name="code" class="sch" cols="60">
(define (run-forever) (run-forever))
(define (try p)
(if (halts? p p)
(run-forever)
'halted))
</textarea>
<br/>
Now consider evaluating the expression (try try) and show that any possible outcome (either halting or running forever) violates the intended behavior of halts?.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Executing <tt>(try try)</tt> evaluates <tt>(halts? try try)</tt>. Assume that this returns true, implying that the application of <tt>(try try)</tt> is expected to halt. However this leads to the program running forever as <tt>(run-forever)</tt> is invoked.
<br/><br/>
If the return value is false, indicating that <tt>(try try)</tt> should not halt, then the program will halt. As both the outcomes contradicts the purpose of checking using halt?, there cannot be such a function.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.16. </span> In this exercise we implement the method just described for interpreting internal definitions. We assume that the evaluator supports let (see exercise 4.6).
<br/><br/>
a. Change lookup-variable-value (section 4.1.3) to signal an error if the value it finds is the symbol *unassigned*.
<br/><br/>
b. Write a procedure scan-out-defines that takes a procedure body and returns an equivalent one that has no internal definitions, by making the transformation described above.
<br/><br/>
c. Install scan-out-defines in the interpreter, either in make-procedure or in procedure-body (see section 4.1.3). Which place is better? Why?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(define (lookup-value-in-frame var frame)
(define (iter variables values)
(cond ((null? variables) false)
((eq? var (car variables))
(let ((value (car values)))
(if (eq? value '*unassigned*)
(error "Value is *unassigned* -- LOOKUP" var)
value)))
(else
(iter (cdr variables) (cdr values)))))
(iter (frame-variables frame) (frame-values frame)))
;; This part is unchanged.
(define (lookup-variable-value var env)
(define (env-loop env)
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((value (lookup-value-in-frame var (first-frame env))))
(if value value (env-loop (enclosing-environment env))))))
(env-loop env))
</textarea>
<br/>
b.
<br/>
<textarea name="code" class="sch" cols="60">
(define (create-special-bindings vars)
(map (lambda (v) (list v '*unassigned*)) vars))
(define (make-set variable expression)
(list 'set! variable expression))
(define (create-set-expressions variables expressions)
(map (lambda (v e) (make-set v e)) variables expressions))
(define (scan-out-defines procedure-body)
(define (collect seq variables expressions rest)
(cond ((null? seq)
(list variables expressions rest))
((definition? (car seq))
(collect (cdr seq)
(cons (definition-variable (car seq)) variables)
(cons (definition-value (car seq)) expressions)
rest))
(else
(collect (cdr seq)
variables
expressions
(cons (car seq) rest)))))
(let ((collection (collect (lambda-body procedure-body) '() '() '())))
(let ((variables (car collection))
(expressions (cadr collection))
(rest (reverse (caddr collection))))
(make-lambda (lambda-parameters procedure-body)
(make-let (create-special-bindings variables)
(append (create-set-expressions variables expressions) rest))))))
</textarea>
<br/>
c. A procedure is defined or redefined fewer times than it is executed/applied. As <tt>procedure-body</tt> is used by apply for each execution of the procedure it is better to install <tt>scan-out-defines</tt> in make-procedure which is used only when the procedure definition is being evaluated.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.17.</span> Draw diagrams of the environment in effect when evaluating the expression <e3> in the procedure in the text, comparing how this will be structured when definitions are interpreted sequentially with how it will be structured if definitions are scanned out as described. Why is there an extra frame in the transformed program? Explain why this difference in environment structure can never make a difference in the behavior of a correct program. Design a way to make the interpreter implement the ``simultaneous'' scope rule for internal definitions without constructing the extra frame.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The new frame is introduced due to the let operation being used. Every time a let is used a new frame is added which contains the expressions defined in the let.
<br/><br/>
As this newly introduced frame contains only those variables used by the let it should not make any difference to the behaviour of a correct program.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.18.</span> Consider an alternative strategy for scanning out definitions that translates the example in the text to
<br/>
<textarea name="code" class="sch" cols="60">
(lambda <vars>
(let ((u '*unassigned*)
(v '*unassigned*))
(let ((a <e1>)
(b <e2>))
(set! u a)
(set! v b))
<e3>))
</textarea>
<br/>
Here a and b are meant to represent new variable names, created by the interpreter, that do not appear in the user's program. Consider the solve procedure from section 3.5.4:
<br/>
<textarea name="code" class="sch" cols="60">
(define (solve f y0 dt)
(define y (integral (delay dy) y0 dt))
(define dy (stream-map f y))
y)
</textarea>
<br/>
Will this procedure work if internal definitions are scanned out as shown in this exercise? What if they are scanned out as shown in the text? Explain.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
This procedure will not work if the internal definitions are scanned out as shown in this exercise. Consider the outer <tt>let</tt> statement. When it is evaluated y and dy are both set to '*unassigned*. Intermediate variables a and b are then evaluated in the inner let. Their values will be evaluated as <tt>(integral (delay '*unassigned*) y0 dt)</tt> and <tt>(stream-map f '*unassigned*)</tt> respectively. The latter throws an error as the second argument of <tt>stream-map</tt> is not a stream as expected.
<br/><br/>
Scanning out the internal definitions as shown in the text will work. In this case only one <tt>let</tt> expression is constructed. At the time of evaluation y and dy are initially assigned the value '*unassigned*. By the time the <tt>set!</tt> expression for dy is executed y has already been set to <tt>(integrate (delay dy) y0 dt)</tt>, the result of which is in fact a stream. This satisfies the requirement that the second argument to <tt>stream-map</tt> should be a stream. Thereby the procedure works.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.19.</span> Ben Bitdiddle, Alyssa P. Hacker, and Eva Lu Ator are arguing about the desired result of evaluating the expression
<br/>
<textarea name="code" class="sch" cols="60">
(let ((a 1))
(define (f x)
(define b (+ a x))
(define a 5)
(+ a b))
(f 10))
</textarea>
<br/>
Ben asserts that the result should be obtained using the sequential rule for define: b is defined to be 11, then a is defined to be 5, so the result is 16. Alyssa objects that mutual recursion requires the simultaneous scope rule for internal procedure definitions, and that it is unreasonable to treat procedure names differently from other names. Thus, she argues for the mechanism implemented in exercise 4.16. This would lead to a being unassigned at the time that the value for b is to be computed. Hence, in Alyssa's view the procedure should produce an error. Eva has a third opinion. She says that if the definitions of a and b are truly meant to be simultaneous, then the value 5 for a should be used in evaluating b. Hence, in Eva's view a should be 5, b should be 15, and the result should be 20. Which (if any) of these viewpoints do you support? Can you devise a way to implement internal definitions so that they behave as Eva prefers?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
The ideal case would be to have simultaneous evaluations as Eva prefers. However this is quite complex to implement, especially when mutual recursion is involved. Delay could be used in such cases thought it wouldn't be straightforward to implement. Given the difficulties involved in implementing the best alternative would be to support Alyssa's position and throw an error.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.20.</span> Because internal definitions look sequential but are actually simultaneous, some people prefer to avoid them entirely, and use the special form letrec instead. Letrec looks like let, so it is not surprising that the variables it binds are bound simultaneously and have the same scope as each other. The sample procedure f above can be written without internal definitions, but with exactly the same meaning, as
<br/>
<textarea name="code" class="sch" cols="60">
(define (f x)
(letrec ((even?
(lambda (n)
(if (= n 0)
true
(odd? (- n 1)))))
(odd?
(lambda (n)
(if (= n 0)
false
(even? (- n 1))))))
<rest of body of f>))
</textarea>
<br/>
Letrec expressions, which have the form
<br/>
<textarea name="code" class="sch" cols="60">
(letrec ((<var1> <exp1>) ... (<varn> <expn>))
<body>)
</textarea>
<br/>
are a variation on let in which the expressions <expk> that provide the initial values for the variables <vark> are evaluated in an environment that includes all the letrec bindings. This permits recursion in the bindings, such as the mutual recursion of even? and odd? in the example above, or the evaluation of 10 factorial with
<br/>
<textarea name="code" class="sch" cols="60">
(letrec ((fact
(lambda (n)
(if (= n 1)
1
(* n (fact (- n 1)))))))
(fact 10))
</textarea>
<br/>
a. Implement letrec as a derived expression, by transforming a letrec expression into a let expression as shown in the text above or in exercise 4.18. That is, the letrec variables should be created with a let and then be assigned their values with set!.
<br/><br/>
b. Louis Reasoner is confused by all this fuss about internal definitions. The way he sees it, if you don't like to use define inside a procedure, you can just use let. Illustrate what is loose about his reasoning by drawing an environment diagram that shows the environment in which the <rest of body of f> is evaluated during evaluation of the expression (f 5), with f defined as in this exercise. Draw an environment diagram for the same evaluation, but with let in place of letrec in the definition of f.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
(define (letrec? exp)
(tagged-list? exp 'letrec))
(define (letrec-bindings exp)
(cadr exp))
(define (letrec-body exp)
(caddr exp))
(define (letrec->let exp)
(let ((bindings (letrec-bindings exp))
(body (letrec-body exp)))
(let ((variables (map car bindings))
(expressions (map cadr bindings)))
(make-let (create-special-bindings variables)
(append (create-set-expressions variables expressions) body)))))
</textarea>
<br/>
b. (1) f written as in this exercise using letrec. Consider how the letrec would have been transformed using lambda:
<br/>
<textarea name="code" class="sch" cols="60">
((lambda (even? odd?)
(set! even? (lambda (n) (if (= n 0) true (odd? (- n 1)))))
(set! odd? (lambda (n) (if (= n 0) false (even? (- n 1)))))
<rest-of-body-of-f>)
'*unassigned '*unassigned)
</textarea>
<br/>
It is clear that the procedures even? and odd? can see each other as they are defined in the same environment. The rest-of-the-body-of-f is eveluated in the same environment as even? and odd?. This would not have been possible if let had been used instead of letrec (see below).
<br/><br/>
(2) f using let instead of letrec. In order to understand this better let us rewrite the let expression using lambda.
<br/>
<textarea name="code" class="sch" cols="60">
(
(lambda (even? odd?) <rest-of-body-of-f>)
(lambda (n) (if (= n 0) true (odd? (- n 1)))) even?
(lambda (n) (if (= n 0) false (even? (- n 1)))) odd?
)
</textarea>
<br/>
It can be seen that the rest-of-the-body-of-f is evaluated in an environment different from that of the two lambda procedures defining even? and odd?. These procedures cannot see each other - the body of even? will not find odd? and vice versa. Therefore this tranformation should not work. However this snippet *does* work in Dr Scheme. I suspect that this is perhaps because Dr Scheme treats such expressions in the same way as letrec.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.21.</span> Amazingly, Louis's intuition in exercise 4.20 is correct. It is indeed possible to specify recursive procedures without using letrec (or even define), although the method for accomplishing this is much more subtle than Louis imagined. The following expression computes 10 factorial by applying a recursive factorial procedure:27
<br/>
<textarea name="code" class="sch" cols="60">
((lambda (n)
((lambda (fact)
(fact fact n))
(lambda (ft k)
(if (= k 1)
1
(* k (ft ft (- k 1)))))))
10)
</textarea>
<br/>
a. Check (by evaluating the expression) that this really does compute factorials. Devise an analogous expression for computing Fibonacci numbers.
<br/><br/>
b. Consider the following procedure, which includes mutually recursive internal definitions:
<br/>
<textarea name="code" class="sch" cols="60">
(define (f x)
(define (even? n)
(if (= n 0)
true
(odd? (- n 1))))
(define (odd? n)
(if (= n 0)
false
(even? (- n 1))))
(even? x))
</textarea>
<br/>
Fill in the missing expressions to complete an alternative definition of f, which uses neither internal definitions nor letrec:
<br/>
<textarea name="code" class="sch" cols="60">
(define (f x)
((lambda (even? odd?)
(even? even? odd? x))
(lambda (ev? od? n)
(if (= n 0) true (od? <??> <??> <??>)))
(lambda (ev? od? n)
(if (= n 0) false (ev? <??> <??> <??>)))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
a.
<br/>
<textarea name="code" class="sch" cols="60">
((lambda (n)
((lambda (fib)
(fib fib n))
(lambda (f k)
(cond ((= k 0) 0)
((= k 1) 1)
(else
(+ (f f (- k 1))
(f f (- k 2))))))))
9)
</textarea>
<br/>
b.
<br/>
<textarea name="code" class="sch" cols="60">
(define (f x)
((lambda (even? odd?)
(even? even? odd? x))
(lambda (ev? od? n)
(if (= n 0) true (od? ev? od? (- n 1))))
(lambda (ev? od? n)
(if (= n 0) false (ev? ev? od? (- n 1))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.22.</span> Extend the evaluator in this section to support the special form let. (See exercise 4.6.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
We have already defined the opreation let->combination which transforms a given let expression to a lambda form. As analyze can understand lambda expressions it is sufficient to add the following condition to analyze to achieve the result:
<br/>
<textarea name="code" class="sch" cols="60">
((let? exp)
(let->combination exp))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 4.23.</span> Alyssa P. Hacker doesn't understand why analyze-sequence needs to be so complicated. All the other analysis procedures are straightforward transformations of the corresponding evaluation procedures (or eval clauses) in section 4.1.1. She expected analyze-sequence to look like this:
<br/>
<textarea name="code" class="sch" cols="60">
(define (analyze-sequence exps)
(define (execute-sequence procs env)
(cond ((null? (cdr procs)) ((car procs) env))
(else ((car procs) env)
(execute-sequence (cdr procs) env))))
(let ((procs (map analyze exps)))
(if (null? procs)
(error "Empty sequence -- ANALYZE"))
(lambda (env) (execute-sequence procs env))))
</textarea>
<br/>
Eva Lu Ator explains to Alyssa that the version in the text does more of the work of evaluating a sequence at analysis time. Alyssa's sequence-execution procedure, rather than having the calls to the individual execution procedures built in, loops through the procedures in order to call them: In effect, although the individual expressions in the sequence have been analyzed, the sequence itself has not been.
<br/><br/>
Compare the two versions of analyze-sequence. For example, consider the common case (typical of procedure bodies) where the sequence has just one expression. What work will the execution procedure produced by Alyssa's program do? What about the execution procedure produced by the program in the text above? How do the two versions compare for a sequence with two expressions?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Alyssa's version produces an execution procedure whose body contains a call to execute-sequence. Execute-sequence is actually run only at runtime when the execution procedure runs.
<br/><br/>
The original version of analyze-sequence invokes execute-sequence *during* anaylsis. The results of the call are embedded in the execution procedure.
<br/><br/>
<span style="font-weight:bold;">Exercise 4.24.</span> Design and carry out some experiments to compare the speed of the original metacircular evaluator with the version in this section. Use your results to estimate the fraction of time that is spent in analysis versus execution for various procedures.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
Experiment:
<br/>
<textarea name="code" class="sch" cols="60">
(define the-global-environment (setup-environment))
(eval '(define (factorial n) (if (= n 1) 1 (* (factorial (- n 1)) n)))
the-global-environment)
(time
(for-each (lambda (x) (eval '(factorial 35) the-global-environment))
(enumerate-interval 1 10000)))
</textarea>
<br/>
Results:
<br/><br/>
Without analyze: cpu time: 44838 real time: 45448 gc time: 160
<br/><br/>
With analyze: cpu time: 21961 real time: 22004 gc time: 116. There is a saving of around 50%.
<br/><br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-81846810935260682552009-01-13T16:00:00.000+05:302009-01-13T16:50:11.852+05:30SICP Section 3.5 Streams<span style="font-weight:bold;">Exercise 3.50.</span> Complete the following definition, which generalizes stream-map to allow procedures that take multiple arguments, analogous to map in section 2.2.3, footnote 12.
<br/>
<textarea name="code" class="sch" cols="60">
(define (stream-map proc . argstreams)
(if (<??> (car argstreams))
the-empty-stream
(<??>
(apply proc (map <??> argstreams))
(apply stream-map
(cons proc (map <??> argstreams))))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (stream-map proc . argstreams)
(if (stream-null? (car argstreams))
the-empty-stream
(cons-stream
(apply proc (map stream-car argstreams))
(apply stream-map
(cons proc (map stream-cdr argstreams))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.51.</span> In order to take a closer look at delayed evaluation, we will use the following procedure, which simply returns its argument after printing it:
<br/>
<textarea name="code" class="sch" cols="60">
(define (show x)
(display-line x)
x)
</textarea>
<br/>
What does the interpreter print in response to evaluating each expression in the following sequence?
<br/>
<textarea name="code" class="sch" cols="60">
(define x (stream-map show (stream-enumerate-interval 0 10)))
(stream-ref x 5)
(stream-ref x 7)
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define x (stream-map show (stream-enumerate-interval 0 10)))
;; prints 0
(stream-ref x 5)
;; Prints 1, 2, 3, 4 and 5 separated by newlines.
(stream-ref x 7)
;; Prints 6, 7
</textarea>
<br/>
<code>(stream-ref x 7)</code> does not print 1 through 5 as <code>show</code> is not invoked thanks to <code>memo-proc</code>. Instead the stored results from previous invocations is reused.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.52.</span> Consider the sequence of expressions
<br/>
<textarea name="code" class="sch" cols="60">
(define sum 0)
(define (accum x)
(set! sum (+ x sum))
sum)
(define seq (stream-map accum (stream-enumerate-interval 1 20)))
(define y (stream-filter even? seq))
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
seq))
(stream-ref y 7)
(display-stream z)
</textarea>
<br/>
What is the value of sum after each of the above expressions is evaluated? What is the printed response to evaluating the stream-ref and display-stream expressions? Would these responses differ if we had implemented (delay <exp>) simply as (lambda () <exp>) without using the optimization provided by memo-proc ? Explain.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define seq (stream-map accum (stream-enumerate-interval 1 20)))
;; Sum becomes 1
(define y (stream-filter even? seq))
;; Sum becomes 6
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
seq))
;; Sum becomes 10
(stream-ref y 7)
;; Prints 136
;; Sum becomes 136
(display-stream z)
;; Prints 10, 15, 45, 55, 105, 120, 190, 210
;; Sum becomes 210
</textarea>
<br/>
Without <code>memo-proc</code>:
<br/>
<textarea name="code" class="sch" cols="60">
;; (define y (stream-filter even? seq))
Sum becomes 6
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
seq))
;; Sum becomes 15 (6 +2 +3 +4)
(stream-ref y 7)
;; Prints 162
;; Sum becomes 162 (15 +4 +5 +6 +... +17)
(display-stream z)
;; Prints 15, 180, 230, 305
;; Sum becomes 362
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.53. </span> Without running the program, describe the elements of the stream defined by
<br/>
<textarea name="code" class="sch" cols="60">
(define s (cons-stream 1 (add-streams s s)))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span> This is the stream 1, 2, 4, 8, 16, 32, 64 etc. It represents the powers of 2: 2<sup>0</sup>, 2<sup>1</sup>, 2<sup>2</sup>, 2<sup>3</sup>, 2<sup>4</sup> etc.
<br/><br/>
The very first value is 1, the hard-coded start value for s. Subsequent elements are created by invoking <code>add-streams</code>. <code>Add-streams</code> creates a new stream whose <code>car</code> is the result of adding the <code>car</code> of its argument streams. The very first time around this yields 1 + 1 = 2. As the stream is defined self-referentially, the <code>car</code> of s becomes 2 following the first call to <code>add-streams</code>. subsequent calls to <code>add-streams</code> causes addition of 2 and 2, yielding 4; 4 and 4 yielding 8 and so on.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.54.</span> Define a procedure mul-streams, analogous to add-streams, that produces the elementwise product of its two input streams. Use this together with the stream of integers to complete the following definition of the stream whose nth element (counting from 0) is n + 1 factorial:
<br/>
<textarea name="code" class="sch" cols="60">
(define factorials (cons-stream 1 (mul-streams <??> <??>)))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (mul-streams s1 s2)
(stream-map * s1 s2))
(define factorials (cons-stream 1 (mul-streams factorials (integers-starting-from 2))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.55.</span> Define a procedure partial-sums that takes as argument a stream S and returns the stream whose elements are S0, S0 + S1, S0 + S1 + S2, .... For example, (partial-sums integers) should be the stream 1, 3, 6, 10, 15, ....
<br/><br/>
<span style="font-weight:bold;">Answer:</span> This is an interesting exercise. As with many other exercises related to Streams it becomes easier if the solution is initially worked out on paper. In this case, the key to the solution is realizing that partial sum at any point is the sum of the partial sum up to that point and the element at the point. This yields the following self-referential definition:
<br/>
<textarea name="code" class="sch" cols="60">
(define (partial-sums stream)
(cons-stream (stream-car stream)
(add-streams (partial-sums stream)
(stream-cdr stream))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.56.</span> A famous problem, first raised by R. Hamming, is to enumerate, in ascending order with no repetitions, all positive integers with no prime factors other than 2, 3, or 5. One obvious way to do this is to simply test each integer in turn to see whether it has any factors other than 2, 3, and 5. But this is very inefficient, since, as the integers get larger, fewer and fewer of them fit the requirement. As an alternative, let us call the required stream of numbers S and notice the following facts about it.
<ul>
<li>S begins with 1.</li>
<li>The elements of (scale-stream S 2) are also elements of S.</li>
<li>The same is true for (scale-stream S 3) and (scale-stream 5 S).</li>
<li>These are all the elements of S.</li>
</ul>
Now all we have to do is combine elements from these sources. For this we define a procedure merge that combines two ordered streams into one ordered result stream, eliminating repetitions:
<br/>
<textarea name="code" class="sch" cols="60">
(define (merge s1 s2)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2)))
(cond ((< s1car s2car)
(cons-stream s1car (merge (stream-cdr s1) s2)))
((> s1car s2car)
(cons-stream s2car (merge s1 (stream-cdr s2))))
(else
(cons-stream s1car
(merge (stream-cdr s1)
(stream-cdr s2)))))))))
</textarea>
<br/>
Then the required stream may be constructed with merge, as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define S (cons-stream 1 (merge <??> <??>)))
</textarea>
<br/>
Fill in the missing expressions in the places marked <??> above.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (merge s1 s2)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2)))
(cond ((< s1car s2car)
(cons-stream s1car (merge (stream-cdr s1) s2)))
((> s1car s2car)
(cons-stream s2car (merge s1 (stream-cdr s2))))
(else
(cons-stream s1car
(merge (stream-cdr s1)
(stream-cdr s2)))))))))
(define S (cons-stream 1 (merge
(merge (scale-stream S 2)
(scale-stream S 3))
(scale-stream S 5))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.57. </span> How many additions are performed when we compute the nth Fibonacci number using the definition of fibs based on the add-streams procedure? Show that the number of additions would be exponentially greater if we had implemented (delay <exp>) simply as (lambda () <exp>), without using the optimization provided by the memo-proc procedure described in section 3.5.1.64
<br/><br/>
<span style="font-weight:bold;">Answer:</span> First, let us define the Fibonacci series as a stream.
<br/>
<textarea name="code" class="sch" cols="60">
(define fibs
(cons-stream 0
(cons-stream 1
(add-streams (stream-cdr fibs)
fibs))))
</textarea>
<br/>
Tracing the flow on paper reveals that n-2 additions are required to calculate the nth Fibonacci number (counting n from 1).
<br/><br/>
Without <code>memo-proc</code>, each call to <code>(stream-cdr fibs)</code> would calculate the series from the beginning up to that point. This would exponentially increase the number of additions performed.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.58.</span> Give an interpretation of the stream computed by the following procedure:
<br/>
<textarea name="code" class="sch" cols="60">
(define (expand num den radix)
(cons-stream
(quotient (* num radix) den)
(expand (remainder (* num radix) den) den radix)))
</textarea>
<br/>
(Quotient is a primitive that returns the integer quotient of two integers.) What are the successive elements produced by (expand 1 7 10) ? What is produced by (expand 3 8 10) ?
<br/><br/>
<span style="font-weight:bold;">Answer:</span> This procedure produces the series of digits after the decimal point from the result of long division of the numerator (num) by the denominator (den) using the given radix base.
<br/><br/>
<code>(expand 1 7 10)</code> produces a series whose first six elements are 1, 4, 2, 8, 5 and 7. The rest of the elements is a repetition of these six. (1/7 = 0.1428571428...)
<br/><br/>
<code>(expand 3 8 10)</code> produces a series whose first three elements are 3, 7 and 5. The rest of the elements are all 0. (3/8 = 0.3750000...)
<br/><br/>
<span style="font-weight:bold;">Exercise 3.59.</span> In section 2.5.3 we saw how to implement a polynomial arithmetic system representing polynomials as lists of terms. In a similar way, we can work with power series, such as
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEikN65n4_kbtLCEn4IDIyrTpntLjJRfhyvjwBWC9sVFxyA36pWMK20JXqS4UBTrV9emT7_IkfgeoabvAhhglX9v8Lt1yFF9tBWowyHvy6LJfQ68msTyeJ4Zjcuor06GegWXzHxJ/s1600-h/ch3-Z-G-36.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 241px; height: 32px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEikN65n4_kbtLCEn4IDIyrTpntLjJRfhyvjwBWC9sVFxyA36pWMK20JXqS4UBTrV9emT7_IkfgeoabvAhhglX9v8Lt1yFF9tBWowyHvy6LJfQ68msTyeJ4Zjcuor06GegWXzHxJ/s320/ch3-Z-G-36.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290693810016262194" /></a>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEihlKtVXJSoENklu__rfrJauvvM9wYxgqZAAIwvK3tyuddUCWDBzBT69mTT-2C7jyF73GbLQmdnxq5PkcNL4XNRYDzekxb64O_Ua1CNgrpxZiSUUh8b4nl-5oZQ9b0jhCXCoG1X/s1600-h/ch3-Z-G-37.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 189px; height: 32px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEihlKtVXJSoENklu__rfrJauvvM9wYxgqZAAIwvK3tyuddUCWDBzBT69mTT-2C7jyF73GbLQmdnxq5PkcNL4XNRYDzekxb64O_Ua1CNgrpxZiSUUh8b4nl-5oZQ9b0jhCXCoG1X/s320/ch3-Z-G-37.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290693814851235458" /></a>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjjTmGDDVYd5tLYPaGMKIXnyNpgTvDO5wX5ePpX3jCDTMMh3c4iWPE1Z3WO5HVrBA3lkAZXsOoVjun8QrnidSxVL4qB4fLsQivzD9_SAebOP5Edq1PGa-rpFhlAN9n13OnbYgUv/s1600-h/ch3-Z-G-38.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 218px; height: 32px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjjTmGDDVYd5tLYPaGMKIXnyNpgTvDO5wX5ePpX3jCDTMMh3c4iWPE1Z3WO5HVrBA3lkAZXsOoVjun8QrnidSxVL4qB4fLsQivzD9_SAebOP5Edq1PGa-rpFhlAN9n13OnbYgUv/s320/ch3-Z-G-38.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290693814537665746" /></a>
<br/><br/>
represented as infinite streams. We will represent the series a0 + a1 x + a2 x<sup>2</sup> + a3 x<sup>3</sup> + ··· as the stream whose elements are the coefficients a0, a1, a2, a3, ....
<br/><br/>
a. The integral of the series a0 + a1 x + a2 x<sup>2</sup> + a3 x<sup>3</sup> + ··· is the series
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEih9Bv6JOzXmjgeBJjLfZe4vyLNhSjm18aC5AFeLS4R0H7qVjH6EyZDaMGVypZPWZ_od4tJAJW8mHL9b50aJ5tBPbvF_gUuhzcbroaRHXuKdyj0KGHUV_BwrDc1AADZm_r4P3I0/s1600-h/ch3-Z-G-39.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 234px; height: 30px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEih9Bv6JOzXmjgeBJjLfZe4vyLNhSjm18aC5AFeLS4R0H7qVjH6EyZDaMGVypZPWZ_od4tJAJW8mHL9b50aJ5tBPbvF_gUuhzcbroaRHXuKdyj0KGHUV_BwrDc1AADZm_r4P3I0/s320/ch3-Z-G-39.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290693814676104322" /></a>
<br/><br/>
where c is any constant. Define a procedure integrate-series that takes as input a stream a0, a1, a2, ... representing a power series and returns the stream a0, (1/2)a1, (1/3)a2, ... of coefficients of the non-constant terms of the integral of the series. (Since the result has no constant term, it doesn't represent a power series; when we use integrate-series, we will cons on the appropriate constant.)
<br/><br/>
b. The function x |--> e<sup>x</sup> is its own derivative. This implies that ex and the integral of ex are the same series, except for the constant term, which is e0 = 1. Accordingly, we can generate the series for e<sup>x</sup> as
<br/>
<textarea name="code" class="sch" cols="60">
(define exp-series
(cons-stream 1 (integrate-series exp-series)))
</textarea>
<br/>
Show how to generate the series for sine and cosine, starting from the facts that the derivative of sine is cosine and the derivative of cosine is the negative of sine:
<br/>
<textarea name="code" class="sch" cols="60">
(define cosine-series
(cons-stream 1 <??>))
(define sine-series
(cons-stream 0 <??>))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
;; a.
(define (integrate-series s)
(stream-map / s integers))
;; b.
(define exp-series
(cons-stream 1 (integrate-series exp-series)))
(define cosine-series
(cons-stream 1 (integrate-series (scale-stream sine-series -1))))
(define sine-series
(cons-stream 0 (integrate-series cosine-series)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.60.</span> With power series represented as streams of coefficients as in exercise 3.59, adding series is implemented by add-streams. Complete the definition of the following procedure for multiplying series:
<br/>
<textarea name="code" class="sch" cols="60">
(define (mul-series s1 s2)
(cons-stream <??> (add-streams <??> <??>)))
</textarea>
<br/>
You can test your procedure by verifying that sin2 x + cos2 x = 1, using the series from exercise 3.59.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (mul-series s1 s2)
(cons-stream (* (stream-car s1) (stream-car s2))
(add-streams (scale-stream (stream-cdr s2) (stream-car s1))
(mul-series (stream-cdr s1) s2))))
(define S (add-streams
(mul-series sine-series sine-series)
(mul-series cosine-series cosine-series)))
(map (lambda (x) (stream-ref S x)) (enumerate-interval 0 10))
(1 0 0 0 0 0 0 0 0 0 0)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.61.</span> Let S be a power series (exercise 3.59) whose constant term is 1. Suppose we want to find the power series 1/S, that is, the series X such that S · X = 1. Write S = 1 + SR where SR is the part of S after the constant term. Then we can solve for X as follows:
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQ9vx_9SjVN2Va_omNeE_u_6sr7wjrc25F6ZzY_k8JZ3D1eMf1hwQ_6tFwldL6LVn516Yl-2i9AyuEbFysHzyDFMFE2XnJMog2cBa1u8-ktUKqM_3dP9ZwQDaty_kaKGXEYng7/s1600-h/ch3-Z-G-40.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 169px; height: 66px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhQ9vx_9SjVN2Va_omNeE_u_6sr7wjrc25F6ZzY_k8JZ3D1eMf1hwQ_6tFwldL6LVn516Yl-2i9AyuEbFysHzyDFMFE2XnJMog2cBa1u8-ktUKqM_3dP9ZwQDaty_kaKGXEYng7/s320/ch3-Z-G-40.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290695659580895186" /></a>
<br/><br/>
In other words, X is the power series whose constant term is 1 and whose higher-order terms are given by the negative of SR times X. Use this idea to write a procedure invert-unit-series that computes 1/S for a power series S with constant term 1. You will need to use mul-series from exercise 3.60.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (invert-unit-series s)
(cons-stream 1
(mul-series
(scale-stream (stream-cdr s) -1)
(invert-unit-series s))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.62.</span> Use the results of exercises 3.60 and 3.61 to define a procedure div-series that divides two power series. Div-series should work for any two series, provided that the denominator series begins with a nonzero constant term. (If the denominator has a zero constant term, then div-series should signal an error.) Show how to use div-series together with the result of exercise 3.59 to generate the power series for tangent.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (div-series s1 s2)
(let ((constant2 (stream-car s2)))
(if (= constant2 0)
(error "Constant term of denominator is 0 -- DIV-SERIES" s2)
(scale-stream (mul-series s1 (invert-unit-series (scale-stream s2 (/ 1 constant2))))
(/ 1 constant2)))))
(define tangent-series (div-series sine-series cosine-series))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.63.</span> Louis Reasoner asks why the sqrt-stream procedure was not written in the following more straightforward way, without the local variable guesses:
<br/>
<textarea name="code" class="sch" cols="60">
(define (sqrt-stream x)
(cons-stream 1.0
(stream-map (lambda (guess)
(sqrt-improve guess x))
(sqrt-stream x))))
</textarea>
<br/>
Alyssa P. Hacker replies that this version of the procedure is considerably less efficient because it performs redundant computation. Explain Alyssa's answer. Would the two versions still differ in efficiency if our implementation of delay used only (lambda () <exp>) without using the optimization provided by memo-proc (section 3.5.1)?
<br/><br/>
<span style="font-weight:bold;">Answer:</span> In Louis' version all <code>stream-cdr</code> calls to a given square root stream executes the procedure <code>sqrt-stream</code>. This in turn creates a new stream object each time. Calls to <code>sqrt-stream</code> and subsequent creation of new stream objects are avoided by using the local variable.
<br/><br/>
The two versions would still differ in efficiency as the difference is not dependent on the use of <code>memo-proc</code>.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.64. </span> Write a procedure stream-limit that takes as arguments a stream and a number (the tolerance). It should examine the stream until it finds two successive elements that differ in absolute value by less than the tolerance, and return the second of the two elements. Using this, we could compute square roots up to a given tolerance by
<br/>
<textarea name="code" class="sch" cols="60">
(define (sqrt x tolerance)
(stream-limit (sqrt-stream x) tolerance))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (stream-limit stream tolerance)
(define (iter stream v1)
(let ((v2 (stream-car stream)))
(if (<= (abs (- v2 v1)) tolerance)
v2
(iter (stream-cdr stream) v2))))
(iter (stream-cdr stream) (stream-car stream)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.65.</span> Use the series
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhCfHK3gobpXimjszG9JdIwn3GZfELEeUT263Ms6ftgPJBVXC8SDuo7fDGlOWqEhCXwB9inEqkbCxk2kCZcYSFu1sCbtuM58kfPBGWKemjH0meBE3qH5j9X-Q0bG3lpSV9jXjmS/s1600-h/ch3-Z-G-44.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 159px; height: 30px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhCfHK3gobpXimjszG9JdIwn3GZfELEeUT263Ms6ftgPJBVXC8SDuo7fDGlOWqEhCXwB9inEqkbCxk2kCZcYSFu1sCbtuM58kfPBGWKemjH0meBE3qH5j9X-Q0bG3lpSV9jXjmS/s320/ch3-Z-G-44.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290697593664994082" /></a>
<br/><br/>
to compute three sequences of approximations to the natural logarithm of 2, in the same way we did above for . How rapidly do these sequences converge?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
We'll start by defining the summands of the log2 stream.
<br/>
<textarea name="code" class="sch" cols="60">
(define (log2-summands n)
(cons-stream (/ 1.0 n)
(stream-map - (log2-summands (+ n 1)))))
</textarea>
<br/>
1. Straightforward summation using <code>partial-sums</code>. The value of log2 oscillates between 0.6687714031754279 and 0.7163904507944756 after 20 iterations.
<br/>
<textarea name="code" class="sch" cols="60">
(define log2-stream
(partial-sums (log2-summands 1)))
</textarea>
<br/>
2. Log2 using Euler Transformation. Value converges to 0.6932106782106783 after 10 iterations.
<br/>
<textarea name="code" class="sch" cols="60">
(define log2-stream-euler
(euler-transform log2-stream))
</textarea>
<br/>
3. Accelerated summation. Value converges to 0.6931488693329254 in 4 iterations.
<br/>
<textarea name="code" class="sch" cols="60">
(define log2-stream-accelerated
(accelerated-sequence euler-transform log2-stream))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.66.</span> Examine the stream (pairs integers integers). Can you make any general comments about the order in which the pairs are placed into the stream? For example, about how many pairs precede the pair (1,100)? the pair (99,100)? the pair (100,100)? (If you can make precise mathematical statements here, all the better. But feel free to give more qualitative answers if you find yourself getting bogged down.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
(1, 100) will be preceded by 197 pairs. (1, n) will be preceded by 2n-3 pairs.
<br/><br/>
(99, 100) will be preceded by 1 + 3(2^98 - 1) pairs. (n, n+1) preceded by 1 + 3(2^(n - 1) - 1) pairs.
<br/><br/>
(100, 100) will be preceded by 6 + (2^96 - 1) pairs. (n, n) will be preceded by 6 + (2^(n - 4) - 1) pairs.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.67.</span> Modify the pairs procedure so that (pairs integers integers) will produce the stream of all pairs of integers (i,j) (without the condition i <= j). Hint: You will need to mix in an additional stream.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (pairs-all s t)
(cons-stream
(list (stream-car s) (stream-car t))
(interleave
(interleave
(stream-map (lambda (x) (list (stream-car s) x))
(stream-cdr t))
(stream-map (lambda (x) (list x (stream-car t)))
(stream-cdr s)))
(pairs (stream-cdr s) (stream-cdr t)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.68.</span> Louis Reasoner thinks that building a stream of pairs from three parts is unnecessarily complicated. Instead of separating the pair (S0,T0) from the rest of the pairs in the first row, he proposes to work with the whole first row, as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (pairs s t)
(interleave
(stream-map (lambda (x) (list (stream-car s) x))
t)
(pairs (stream-cdr s) (stream-cdr t))))
</textarea>
<br/>
Does this work? Consider what happens if we evaluate (pairs integers integers) using Louis's definition of pairs.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
When <code>(pairs s t)</code> is evaluated a call is made to <code>stream-map</code> and <code>pairs</code> (arguments for <code>interleave</code>). The call to <code>pairs</code> in turn spawns another call to <code>pairs</code> and so on, causing an infinite loop.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.69.</span> Write a procedure triples that takes three infinite streams, S, T, and U, and produces the stream of triples (Si,Tj,Uk) such that i <= j <= k. Use triples to generate the stream of all Pythagorean triples of positive integers, i.e., the triples (i,j,k) such that i <= j and i<sup>2</sup> + j<sup>2</sup> = k<sup>2</sup>.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (triple s t u)
(cons-stream
(list (stream-car s) (stream-car t) (stream-car u))
(interleave
(stream-map (lambda (x) (cons (stream-car s) x))
(stream-cdr (pairs t u)))
(triple (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
(define py-triples
(stream-filter (lambda (t)
(= (+ (square (car t)) (square (cadr t)))
(square (caddr t))))
(triple integers integers integers)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.70.</span> It would be nice to be able to generate streams in which the pairs appear in some useful order, rather than in the order that results from an ad hoc interleaving process. We can use a technique similar to the merge procedure of exercise 3.56, if we define a way to say that one pair of integers is ``less than'' another. One way to do this is to define a ``weighting function'' W(i,j) and stipulate that (i1,j1) is less than (i2,j2) if W(i1,j1) < W(i2,j2). Write a procedure merge-weighted that is like merge, except that merge-weighted takes an additional argument weight, which is a procedure that computes the weight of a pair, and is used to determine the order in which elements should appear in the resulting merged stream.69 Using this, generalize pairs to a procedure weighted-pairs that takes two streams, together with a procedure that computes a weighting function, and generates the stream of pairs, ordered according to weight. Use your procedure to generate
<br/><br/>
a. the stream of all pairs of positive integers (i,j) with i <= j ordered according to the sum i + j
<br/><br/>
b. the stream of all pairs of positive integers (i,j) with i <= j, where neither i nor j is divisible by 2, 3, or 5, and the pairs are ordered according to the sum 2 i + 3 j + 5 i j.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (merge-weighted s1 s2 weight)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2)))
(let ((w1 (weight (car s1car) (cadr s1car)))
(w2 (weight (car s2car) (cadr s2car))))
(cond ((<= w1 w2)
(cons-stream s1car (merge-weighted (stream-cdr s1) s2 weight)))
(else
(cons-stream s2car (merge-weighted s1 (stream-cdr s2) weight)))))))))
(define (weighted-pairs s t weight)
(cons-stream
(list (stream-car s) (stream-car t))
(merge-weighted
(stream-map (lambda (x) (list (stream-car s) x))
(stream-cdr t))
(weighted-pairs (stream-cdr s) (stream-cdr t) weight)
weight)))
;; a
(define S1
(weighted-pairs integers integers (lambda (i j) (+ i j))))
;; b.
(define S2
(stream-filter
(lambda (pair)
(let ((ij (* (car pair) (cadr pair))))
(and (not (= (remainder ij 2) 0))
(not (= (remainder ij 3) 0))
(not (= (remainder ij 5) 0)))))
(weighted-pairs
integers
integers
(lambda (i j) (+ (* 2 i)
(* 3 j)
(* 5 i j))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.71.</span> Numbers that can be expressed as the sum of two cubes in more than one way are sometimes called Ramanujan numbers, in honor of the mathematician Srinivasa Ramanujan.70 Ordered streams of pairs provide an elegant solution to the problem of computing these numbers. To find a number that can be written as the sum of two cubes in two different ways, we need only generate the stream of pairs of integers (i,j) weighted according to the sum i<sup>3</sup> + j<sup>3</sup> (see exercise 3.70), then search the stream for two consecutive pairs with the same weight. Write a procedure to generate the Ramanujan numbers. The first such number is 1,729. What are the next five?
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (cube-weight . pair)
(+ (expt (car pair) 3)
(expt (cadr pair) 3)))
(define ramanujan-stream
(weighted-pairs
integers
integers
cube-weight))
(define (ramanujan-numbers stream)
(define (iter s1 s2)
(let ((w1 (apply cube-weight (stream-car s1)))
(w2 (apply cube-weight (stream-car s2))))
(if (= w1 w2)
(begin (newline)
(display w1)))
(iter s2 (stream-cdr s2))))
(iter stream (stream-cdr stream)))
</textarea>
<br/>
Next five after 1729 are 4104, 13832, 20683, 32832, 39312.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.72.</span> In a similar way to exercise 3.71 generate a stream of all numbers that can be written as the sum of two squares in three different ways (showing how they can be so written).
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (square-weight . pair)
(+ (square (car pair))
(square (cadr pair))))
(define square-stream
(weighted-pairs
integers
integers
square-weight))
(define (display-sum-of-squares sum . pairs)
(define (display-iter pair)
(display (car pair))
(display "^2")
(display " + ")
(display (cadr pair))
(display "^2")
(display ", "))
(newline)
(display sum)
(display " = ")
(for-each display-iter pairs))
(define (sum-of-squares stream)
(define (iter s1 s2 s3)
(let ((w1 (apply square-weight (stream-car s1)))
(w2 (apply square-weight (stream-car s2)))
(w3 (apply square-weight (stream-car s3))))
(if (= w1 w2 w3)
(display-sum-of-squares w1 (stream-car s1) (stream-car s2) (stream-car s3)))
(iter s2 (stream-cdr s2) (stream-cdr (stream-cdr s2)))))
(iter stream (stream-cdr stream) (stream-cdr (stream-cdr stream))))
(sum-of-squares square-stream)
325 = 1^2 + 18^2, 6^2 + 17^2, 10^2 + 15^2,
425 = 5^2 + 20^2, 8^2 + 19^2, 13^2 + 16^2,
...
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.73. </span>
<em>v</em> = <em>v</em><sub>0</sub> + (1/<em>C</em>)<sub>0</sub><sup><em>t</em></sup><em>i</em> <em>d</em><em>t</em> + <em>R</em> <em>i</em>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXcrjp0ctG-UKCmuW1LEW-eccz5HMtPvMSp_b2uvnbdHGyhW4NBfTrXkgyi3qsFthID9KdveCtkGNBHgpVFx_j4967hPJnCo6bzQywWq6I4aaO3VRV5YC7wdmMclVZHU5YngCZ/s1600-h/ch3-Z-G-50.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 142px; height: 55px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiXcrjp0ctG-UKCmuW1LEW-eccz5HMtPvMSp_b2uvnbdHGyhW4NBfTrXkgyi3qsFthID9KdveCtkGNBHgpVFx_j4967hPJnCo6bzQywWq6I4aaO3VRV5YC7wdmMclVZHU5YngCZ/s320/ch3-Z-G-50.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290702737969209906" /></a>
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjGII6PQpq3kFqZVr9SiQ2y7-KxBoDRqORzHQ8DYXilAjGpovsbgGxYgBDfTX2Brv6WRnYNf6wrJA48Oc28WoeGEAjVt7Z_ApLrP3x016Kvep4m2DiWVlLNgEQfH5airxwKehYD/s1600-h/ch3-Z-G-51.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 168px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjGII6PQpq3kFqZVr9SiQ2y7-KxBoDRqORzHQ8DYXilAjGpovsbgGxYgBDfTX2Brv6WRnYNf6wrJA48Oc28WoeGEAjVt7Z_ApLrP3x016Kvep4m2DiWVlLNgEQfH5airxwKehYD/s320/ch3-Z-G-51.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290702734880432786" /></a>
<br/><br/>
Figure 3.33: An RC circuit and the associated signal-flow diagram.
<br/><br/>
We can model electrical circuits using streams to represent the values of currents or voltages at a sequence of times. For instance, suppose we have an RC circuit consisting of a resistor of resistance R and a capacitor of capacitance C in series. The voltage response v of the circuit to an injected current i is determined by the formula in figure 3.33, whose structure is shown by the accompanying signal-flow diagram.
<br/><br/>
Write a procedure RC that models this circuit. RC should take as inputs the values of R, C, and dt and should return a procedure that takes as inputs a stream representing the current i and an initial value for the capacitor voltage v0 and produces as output the stream of voltages v. For example, you should be able to use RC to model an RC circuit with R = 5 ohms, C = 1 farad, and a 0.5-second time step by evaluating (define RC1 (RC 5 1 0.5)). This defines RC1 as a procedure that takes a stream representing the time sequence of currents and an initial capacitor voltage and produces the output stream of voltages.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (RC R C dt)
(define (proc i v0)
(add-streams
(scale-stream (integral i v0 dt)
(/ 1 C))
(scale-stream i R)))
proc)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.74.</span> Alyssa P. Hacker is designing a system to process signals coming from physical sensors. One important feature she wishes to produce is a signal that describes the zero crossings of the input signal. That is, the resulting signal should be + 1 whenever the input signal changes from negative to positive, - 1 whenever the input signal changes from positive to negative, and 0 otherwise. (Assume that the sign of a 0 input is positive.) For example, a typical input signal with its associated zero-crossing signal would be
<br/><br/>
...1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 ...... 0 0 0 0 0 -1 0 0 0 0 1 0 0 ...
<br/><br/>
In Alyssa's system, the signal from the sensor is represented as a stream sense-data and the stream zero-crossings is the corresponding stream of zero crossings. Alyssa first writes a procedure sign-change-detector that takes two values as arguments and compares the signs of the values to produce an appropriate 0, 1, or - 1. She then constructs her zero-crossing stream as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-zero-crossings input-stream last-value)
(cons-stream
(sign-change-detector (stream-car input-stream) last-value)
(make-zero-crossings (stream-cdr input-stream)
(stream-car input-stream))))
(define zero-crossings (make-zero-crossings sense-data 0))
</textarea>
<br/>
Alyssa's boss, Eva Lu Ator, walks by and suggests that this program is approximately equivalent to the following one, which uses the generalized version of stream-map from exercise 3.50:
<br/>
<textarea name="code" class="sch" cols="60">
(define zero-crossings
(stream-map sign-change-detector sense-data <expression>))
</textarea>
<br/>
Complete the program by supplying the indicated <expression>.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define zero-crossings
(stream-map sign-change-detector sense-data (stream-cdr sense-data)))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.75.</span> Unfortunately, Alyssa's zero-crossing detector in exercise 3.74 proves to be insufficient, because the noisy signal from the sensor leads to spurious zero crossings. Lem E. Tweakit, a hardware specialist, suggests that Alyssa smooth the signal to filter out the noise before extracting the zero crossings. Alyssa takes his advice and decides to extract the zero crossings from the signal constructed by averaging each value of the sense data with the previous value. She explains the problem to her assistant, Louis Reasoner, who attempts to implement the idea, altering Alyssa's program as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-zero-crossings input-stream last-value)
(let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
(cons-stream (sign-change-detector avpt last-value)
(make-zero-crossings (stream-cdr input-stream)
avpt))))
</textarea>
<br/>
This does not correctly implement Alyssa's plan. Find the bug that Louis has installed and fix it without changing the structure of the program. (Hint: You will need to increase the number of arguments to make-zero-crossings.)
<br><br/>
<span style="font-weight:bold;">Answer:</span> I couldn't come up with an answer. If you know the answer and can explain it, do let me know.
<br><br/>
<span style="font-weight:bold;">Exercise 3.76. </span> Eva Lu Ator has a criticism of Louis's approach in exercise 3.75. The program he wrote is not modular, because it intermixes the operation of smoothing with the zero-crossing extraction. For example, the extractor should not have to be changed if Alyssa finds a better way to condition her input signal. Help Louis by writing a procedure smooth that takes a stream as input and produces a stream in which each element is the average of two successive input stream elements. Then use smooth as a component to implement the zero-crossing detector in a more modular style.
<br><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (smooth stream)
(stream-map (lambda (x y) (average x y))
(cons-stream 0 stream)
stream))
(define (make-zero-crossings smoothened-stream last-avpt)
(cons-stream (sign-change-detector (stream-car smoothened-stream) last-avpt)
(make-zero-crossings (stream-cdr smoothened-stream) (stream-car smoothened-stream))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.77.</span> The integral procedure used above was analogous to the ``implicit'' definition of the infinite stream of integers in section 3.5.2. Alternatively, we can give a definition of integral that is more like integers-starting-from (also in section 3.5.2):
<br/>
<textarea name="code" class="sch" cols="60">
(define (integral integrand initial-value dt)
(cons-stream initial-value
(if (stream-null? integrand)
the-empty-stream
(integral (stream-cdr integrand)
(+ (* dt (stream-car integrand))
initial-value)
dt))))
</textarea>
<br/>
When used in systems with loops, this procedure has the same problem as does our original version of integral. Modify the procedure so that it expects the integrand as a delayed argument and hence can be used in the solve procedure shown above.
<br><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (integral delayed-integrand initial-value dt)
(cons-stream initial-value
(let ((integrand (force delayed-integrand)))
(if (stream-null? integrand)
the-empty-stream
(integral (delay (stream-cdr integrand))
(+ (* dt (stream-car integrand))
initial-value)
dt)))))
(define (solve f y0 dt)
(define y (integral (delay dy) y0 dt))
(define dy (stream-map f y))
y)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.78.</span>
<br><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgxQsE1NeUVyYbD3AVtCEkAXuSi0o1Fa4cewZLa8NDuZ4M5KQEQZzYIWjmYV0QxhmnWeuUlYh7c26PropDDkUsjX5kyC0XMZl3mPR3f8pCHWNESsRhB_BDPZf-JaCyQrVmV-vPd/s1600-h/ch3-Z-G-53.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 320px; height: 227px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgxQsE1NeUVyYbD3AVtCEkAXuSi0o1Fa4cewZLa8NDuZ4M5KQEQZzYIWjmYV0QxhmnWeuUlYh7c26PropDDkUsjX5kyC0XMZl3mPR3f8pCHWNESsRhB_BDPZf-JaCyQrVmV-vPd/s320/ch3-Z-G-53.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290705252144141858" /></a>
<br><br/>
Figure 3.35: Signal-flow diagram for the solution to a second-order linear differential equation.
<br><br/>
Consider the problem of designing a signal-processing system to study the homogeneous second-order linear differential equation
<br><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjL6gbVTUXx8zoUCD8bC-a69H-7hTS9cvrc1QNgP54GAcRp0XPKw-FEH8doJSsBRbciG9V6FUMzfR14gkIq9jiYA9nlOV8AGAHw4RSS8x5-Gf_3-7bCyM11T1h8ukmStcfmzRX3/s1600-h/ch3-Z-G-54.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 119px; height: 32px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEjL6gbVTUXx8zoUCD8bC-a69H-7hTS9cvrc1QNgP54GAcRp0XPKw-FEH8doJSsBRbciG9V6FUMzfR14gkIq9jiYA9nlOV8AGAHw4RSS8x5-Gf_3-7bCyM11T1h8ukmStcfmzRX3/s320/ch3-Z-G-54.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290705511340628354" /></a>
<br><br/>
The output stream, modeling <em>y</em>, is generated by a network that
contains a loop. This is because the value of <em>d</em><sup>2</sup><em>y</em>/<em>d</em><em>t</em><sup>2</sup> depends
upon the values of <em>y</em> and <em>d</em><em>y</em>/<em>d</em><em>t</em> and both of these are determined by
integrating <em>d</em><sup>2</sup><em>y</em>/<em>d</em><em>t</em><sup>2</sup>. The diagram we would like to encode is
shown in figure 3.35. Write a procedure <tt>solve-2nd</tt> that
takes as arguments the constants <em>a</em>, <em>b</em>, and <em>d</em><em>t</em> and the initial
values <em>y</em><sub>0</sub> and <em>d</em><em>y</em><sub>0</sub> for <em>y</em> and <em>d</em><em>y</em>/<em>d</em><em>t</em> and generates the
stream of successive values of <em>y</em>.
<br><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (solve-2nd a b dt y0 dy0)
(define y (integral (delay dy) y0 dt))
(define dy (integral (delay ddy) dy0 dt))
(define ddy
(add-streams (scale-stream dy a)
(scale-stream y b)))
y)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.79.</span> Generalize the solve-2nd procedure of exercise 3.78 so that it can be used to solve general second-order differential equations <em>d</em><sup>2</sup> <em>y</em>/<em>d</em><em>t</em><sup>2</sup> = <em>f</em>(<em>d</em><em>y</em>/<em>d</em><em>t</em>, <em>y</em>).
<br><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (solve-2nd f y0 dy0 dt)
(define y (integral (delay dy) y0 dt))
(define dy (integral (delay ddy) dy0 dt))
(define ddy (stream-map f dy y))
y)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.80.</span> A series RLC circuit consists of a resistor, a capacitor, and an inductor connected in series, as shown in figure 3.36. If R, L, and C are the resistance, inductance, and capacitance, then the relations between voltage (v) and current (i) for the three components are described by the equations
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiM05_ObIo62j-XwWwgspycajg7_2pQfV2jNr09xRZCVMkGI_vRmbBIpxZ9grDh8FppjEuOBGyoZmmwe6JB1GjEzO08MYCbaCO1p56Up96K3LEcg2j8kwW4cSo0sQHl0I5MHygL/s1600-h/ch3-Z-G-55.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 80px; height: 79px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiM05_ObIo62j-XwWwgspycajg7_2pQfV2jNr09xRZCVMkGI_vRmbBIpxZ9grDh8FppjEuOBGyoZmmwe6JB1GjEzO08MYCbaCO1p56Up96K3LEcg2j8kwW4cSo0sQHl0I5MHygL/s320/ch3-Z-G-55.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290707300441179618" /></a>
<br/><br/>
and the circuit connections dictate the relations
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg003uj-Q-vv_p1MRVKoDyjTAzhw0tZv2FNQReTfJGULJpnW8eh6Se0ixL4ix73UkoCWzi32juMvzVl0aaF9d3v_9bUGtpp1haNu1BB2MuYFapz0p_nldcV13UeUczaBkITyEk8/s1600-h/ch3-Z-G-56.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 100px; height: 32px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEg003uj-Q-vv_p1MRVKoDyjTAzhw0tZv2FNQReTfJGULJpnW8eh6Se0ixL4ix73UkoCWzi32juMvzVl0aaF9d3v_9bUGtpp1haNu1BB2MuYFapz0p_nldcV13UeUczaBkITyEk8/s320/ch3-Z-G-56.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290707301891074642" /></a>
<br/><br/>
Combining these equations shows that the state of the circuit (summarized by vC, the voltage across the capacitor, and iL, the current in the inductor) is described by the pair of differential equations
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhYrQRnWJ4t4OoeFx2AvacyaxwVuF6jVPo309yl6lpXCzN7VvaL_nD-xPPgo2ttHROBy52n2DAKp23GfwhQT-Z9Xx9NKcXWFi0xyZ0Sm97psqw25w8Oi4wmsfqZwqRDEusLjnXD/s1600-h/ch3-Z-G-57.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 123px; height: 63px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEhYrQRnWJ4t4OoeFx2AvacyaxwVuF6jVPo309yl6lpXCzN7VvaL_nD-xPPgo2ttHROBy52n2DAKp23GfwhQT-Z9Xx9NKcXWFi0xyZ0Sm97psqw25w8Oi4wmsfqZwqRDEusLjnXD/s320/ch3-Z-G-57.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290707304524233426" /></a>
<br/><br/>
The signal-flow diagram representing this system of differential equations is shown in figure 3.37.
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgIs4mEW-67__qMj9fcMGCjubjDasK3ihKaQt9K8ZODazjYlROXlO9z8UFTDvxkxq2EKxOxH7Ea6HHel9kOsODbEpmZNPX7Ti01nvLFMonngiRZp7lK6ukwphQAnW95G-pRxprs/s1600-h/ch3-Z-G-58.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 189px; height: 115px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEgIs4mEW-67__qMj9fcMGCjubjDasK3ihKaQt9K8ZODazjYlROXlO9z8UFTDvxkxq2EKxOxH7Ea6HHel9kOsODbEpmZNPX7Ti01nvLFMonngiRZp7lK6ukwphQAnW95G-pRxprs/s320/ch3-Z-G-58.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290707306666822210" /></a>
<br/><br/>
Figure 3.36: A series RLC circuit.
<br/><br/>
<a onblur="try {parent.deselectBloggerImageGracefully();} catch(e) {}" href="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiX8QqoGPnL7R9fpgb8mWmijbPp9JhrERzMGRuz3JK2edP9axo7uqvzJOISGr1xfB3YgqN2ItCpiZ5gfFItBRGwXBx9udAL2CJkaRp9FV0__6PEB5BG23ehUE7tZKrg0Kg5Pkkn/s1600-h/ch3-Z-G-59.gif"><img style="display:block; margin:0px auto 10px; text-align:center;cursor:pointer; cursor:hand;width: 234px; height: 281px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiX8QqoGPnL7R9fpgb8mWmijbPp9JhrERzMGRuz3JK2edP9axo7uqvzJOISGr1xfB3YgqN2ItCpiZ5gfFItBRGwXBx9udAL2CJkaRp9FV0__6PEB5BG23ehUE7tZKrg0Kg5Pkkn/s320/ch3-Z-G-59.gif" border="0" alt=""id="BLOGGER_PHOTO_ID_5290707304424207602" /></a>
<br/><br/>
Figure 3.37: A signal-flow diagram for the solution to a series RLC circuit.
<br/><br/>
Write a procedure RLC that takes as arguments the parameters R, L, and C of the circuit and the time increment dt. In a manner similar to that of the RC procedure of exercise 3.73, RLC should produce a procedure that takes the initial values of the state variables, vC0 and iL0, and produces a pair (using cons) of the streams of states vC and iL. Using RLC, generate the pair of streams that models the behavior of a series RLC circuit with R = 1 ohm, C = 0.2 farad, L = 1 henry, dt = 0.1 second, and initial values iL0 = 0 amps and vC0 = 10 volts.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (RLC R L C dt)
(define (proc vC0 iL0)
(define vC
(integral (delay dvC) vC0 dt))
(define iL
(integral (delay diL) iL0 dt))
(define dvC
(scale-stream iL (- (/ 1 C))))
(define diL
(add-streams
(scale-stream iL (- (/ R L)))
(scale-stream vC (/ 1 L))))
(cons vC iL))
proc)
(define RLC1 ((RLC 1 1 0.2 0.1) 10 0))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.81.</span> Exercise 3.6 discussed generalizing the random-number generator to allow one to reset the random-number sequence so as to produce repeatable sequences of ``random'' numbers. Produce a stream formulation of this same generator that operates on an input stream of requests to generate a new random number or to reset the sequence to a specified value and that produces the desired stream of random numbers. Don't use assignment in your solution.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (rand m)
(define (generate-random-stream initial-value)
(define random-numbers
(cons-stream initial-value
(stream-map rand-update random-numbers)))
random-numbers)
(cond ((eq? m 'generate)
(lambda () (generate-random-stream random-init)))
((eq? m 'reset)
(lambda (new-value) (generate-random-stream new-value)))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.82.</span> Redo exercise 3.5 on Monte Carlo integration in terms of streams. The stream version of estimate-integral will not have an argument telling how many trials to perform. Instead, it will produce a stream of estimates based on successively more trials.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (random-in-range low high)
(let ((range (- high low)))
(+ low (random range))))
(define (rect-area x1 x2 y1 y2)
(abs (* (- x2 x1) (- y2 y1))))
(define (monte-carlo experiment-stream passed failed)
(define (next passed failed)
(cons-stream
(/ passed (+ passed failed))
(monte-carlo
(stream-cdr experiment-stream) passed failed)))
(if (stream-car experiment-stream)
(next (+ passed 1) failed)
(next passed (+ failed 1))))
(define (estimate-integral P x1 x2 y1 y2)
(define (experiment)
(P (random-in-range x1 x2) (random-in-range y1 y2)))
(define (make-experiment-stream)
(cons-stream (experiment)
(make-experiment-stream)))
(define ratio-stream
(monte-carlo (make-experiment-stream) 0 0))
(define area
(rect-area x1 x2 y1 y2))
(stream-map (lambda (r) (* area r 1.0))
ratio-stream))
(define (in-unit-circle? x y)
(<= (+ (square x)
(square y))
1))
(define pi
(estimate-integral in-unit-circle? -1 1 -1 1))
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-25132708218750454082009-01-13T15:00:00.005+05:302009-01-13T16:43:23.289+05:30SICP Section 3.4 Concurrency: Time Is of the Essence<span style="font-weight:bold;">Exercise 3.38. </span> Suppose that Peter, Paul, and Mary share a joint bank account that initially contains $100. Concurrently, Peter deposits $10, Paul withdraws $20, and Mary withdraws half the money in the account, by executing the following commands:
<br/>
<textarea name="code" class="sch" cols="60">
Peter: (set! balance (+ balance 10))
Paul: (set! balance (- balance 20))
Mary: (set! balance (- balance (/ balance 2)))
</textarea>
<br/>
a. List all the different possible values for balance after these three transactions have been completed, assuming that the banking system forces the three processes to run sequentially in some order.
<br/><br/>
b. What are some other values that could be produced if the system allows the processes to be interleaved? Draw timing diagrams like the one in figure 3.29 to explain how these values can occur.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a. Processes run sequentially in some order <br/>
45 (Peter, Paul, Mary) <br/>
35 (Peter, Mary, Paul) <br/>
45 (Paul, Peter, Mary) <br/>
50 (Paul, Mary, Peter) <br/>
40 (Mary, Peter, Paul) <br/>
40 (Mary, Paul, Peter) <br/>
<br/>
<span style="font-weight:bold;">Exercise 3.40.</span> Give all possible values of x that can result from executing
<br/>
<textarea name="code" class="sch" cols="60">
(define x 10)
(parallel-execute (lambda () (set! x (* x x)))
(lambda () (set! x (* x x x))))
</textarea>
<br/>
Which of these possibilities remain if we instead use serialized procedures:
<br/>
<textarea name="code" class="sch" cols="60">
(define x 10)
(define s (make-serializer))
(parallel-execute (s (lambda () (set! x (* x x))))
(s (lambda () (set! x (* x x x)))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span> Possible values are 10^4, 10^5, 10^6. If serialized procedures are used only 10^6 remains.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.41.</span> Ben Bitdiddle worries that it would be better to implement the bank account as follows (where the commented line has been changed):
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-account balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
;; continued on next page
(let ((protected (make-serializer)))
(define (dispatch m)
(cond ((eq? m 'withdraw) (protected withdraw))
((eq? m 'deposit) (protected deposit))
((eq? m 'balance)
((protected (lambda () balance)))) ; serialized
(else (error "Unknown request -- MAKE-ACCOUNT"
m))))
dispatch))
</textarea>
<br/>
because allowing unserialized access to the bank balance can result in anomalous behavior. Do you agree? Is there any scenario that demonstrates Ben's concern?
<br/><br/>
<span style="font-weight:bold;">Answer:</span> There are no scenarios that call for Ben's changes. The set! command is the only one that affects balance. Anyone trying to view the balance will see the value before or after setting and nothing else.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.42.</span> Ben Bitdiddle suggests that it's a waste of time to create a new serialized procedure in response to every withdraw and deposit message. He says that make-account could be changed so that the calls to protected are done outside the dispatch procedure. That is, an account would return the same serialized procedure (which was created at the same time as the account) each time it is asked for a withdrawal procedure.
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-account balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(let ((protected (make-serializer)))
(let ((protected-withdraw (protected withdraw))
(protected-deposit (protected deposit)))
(define (dispatch m)
(cond ((eq? m 'withdraw) protected-withdraw)
((eq? m 'deposit) protected-deposit)
((eq? m 'balance) balance)
(else (error "Unknown request -- MAKE-ACCOUNT"
m))))
dispatch)))
</textarea>
<br/>
Is this a safe change to make? In particular, is there any difference in what concurrency is allowed by these two versions of make-account ?
<br/><br/>
<span style="font-weight:bold;">Answer:</span> This is a safe change to make. Serialization is not affected by whether the procedure is serialized inside dispatch or outside it.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.44.</span> Consider the problem of transferring an amount from one account to another. Ben Bitdiddle claims that this can be accomplished with the following procedure, even if there are multiple people concurrently transferring money among multiple accounts, using any account mechanism that serializes deposit and withdrawal transactions, for example, the version of make-account in the text above.
<br/>
<textarea name="code" class="sch" cols="60">
(define (transfer from-account to-account amount)
((from-account 'withdraw) amount)
((to-account 'deposit) amount))
</textarea>
<br/>
Louis Reasoner claims that there is a problem here, and that we need to use a more sophisticated method, such as the one required for dealing with the exchange problem. Is Louis right? If not, what is the essential difference between the transfer problem and the exchange problem? (You should assume that the balance in from-account is at least amount.)
<br/><br/>
<span style="font-weight:bold;">Answer:</span> ouis is wrong. Ben's procedure is sufficient to handle the requirement.
<br/><br/>
The difference between the transfer and exchange problems is that the latter calculates the difference in account balances before withdrawing/depositing. There is no way to guarantee that the account balances do not change between the calculation of the difference and the subsequent actions.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.45.</span> Louis Reasoner thinks our bank-account system is unnecessarily complex and error-prone now that deposits and withdrawals aren't automatically serialized. He suggests that make-account-and-serializer should have exported the serializer (for use by such procedures as serialized-exchange) in addition to (rather than instead of) using it to serialize accounts and deposits as make-account did. He proposes to redefine accounts as follows:
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-account-and-serializer balance)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(let ((balance-serializer (make-serializer)))
(define (dispatch m)
(cond ((eq? m 'withdraw) (balance-serializer withdraw))
((eq? m 'deposit) (balance-serializer deposit))
((eq? m 'balance) balance)
((eq? m 'serializer) balance-serializer)
(else (error "Unknown request -- MAKE-ACCOUNT"
m))))
dispatch))
</textarea>
<br/>
Then deposits are handled as with the original make-account:
<br/>
<textarea name="code" class="sch" cols="60">
(define (deposit account amount)
((account 'deposit) amount))
</textarea>
<br/>
Explain what is wrong with Louis's reasoning. In particular, consider what happens when serialized-exchange is called.
<br/><br/>
<span style="font-weight:bold;">Answer:</span> Louis's logic will lead to a deadlock situation when <code>serialized-exchange</code> is called. This procedure invokes a (doubly) serialized version of <code>exchange</code>. <code>Exchange</code> in turn invokes the serialized versions of <code>withdraw</code> and <code>deposit</code>. Exchange cannot finish until both these are completed; due to serializing neither <code>withdraw</code> nor <code>deposit</code> can start until <code>exchange</code> is over. This leads to a deadlock.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.47.</span> A semaphore (of size n) is a generalization of a mutex. Like a mutex, a semaphore supports acquire and release operations, but it is more general in that up to n processes can acquire it concurrently. Additional processes that attempt to acquire the semaphore must wait for release operations. Give implementations of semaphores
<br/><br/>
a. in terms of mutexes
<br/><br/>
b. in terms of atomic test-and-set! operations.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
a. Semaphore in terms of mutexes
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-semaphore n)
(let ((mutex (make-mutex))
(count 0))
(define (the-semaphore m)
(cond ((eq? m 'acquire)
(mutex 'acquire)
(if (< count n)
(set! count (+ count 1)))
(mutex 'release))
((eq? m 'release)
(mutex 'acquire)
(if (> count 0)
(set! count (- count 1)))
(mutex 'release))))
the-semaphore))
</textarea>
<br/>
b. Semaphore in terms of atomic test-and-set! operations
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-semaphore n)
(let ((cell (list false))
(count 0))
(define (the-semaphore m)
(cond ((eq? m 'acquire)
(test-and-set! cell)
(if (< count n)
(set! count (+ count 1)))
(clear! cell))
((eq? m 'release)
(test-and-set! cell)
(if (> count 0)
(set! count (- count 1)))
(clear! cell))))
the-semaphore))
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-36108998239026517422009-01-13T14:00:00.000+05:302009-01-13T16:42:50.389+05:30SICP Section 3.3 Modeling with Mutable Data<span style="font-weight:bold;">Exercise 3.12.</span> The following procedure for appending lists was introduced in section 2.2.1:
<br/>
<textarea name="code" class="sch" cols="60">
(define (append x y)
(if (null? x)
y
(cons (car x) (append (cdr x) y))))
</textarea>
<br/>
Append forms a new list by successively consing the elements of x onto y. The procedure append! is similar to append, but it is a mutator rather than a constructor. It appends the lists by splicing them together, modifying the final pair of x so that its cdr is now y. (It is an error to call append! with an empty x.)
<br/>
<textarea name="code" class="sch" cols="60">
(define (append! x y)
(set-cdr! (last-pair x) y)
x)
</textarea>
<br/>
Here last-pair is a procedure that returns the last pair in its argument:
<br/>
<textarea name="code" class="sch" cols="60">
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))))
</textarea>
<br/>
Consider the interaction
<br/>
<textarea name="code" class="sch" cols="60">
(define x (list 'a 'b))
(define y (list 'c 'd))
(define z (append x y))
z
(a b c d)
(cdr x)
<response>
(define w (append! x y))
w
(a b c d)
(cdr x)
<response>
</textarea>
<br/>
What are the missing <response>s? Draw box-and-pointer diagrams to explain your answer.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (append x y)
(if (null? x)
y
(cons (car x) (append (cdr x) y))))
(define (append! x y)
(set-cdr! (last-pair x) y)
x)
(define (last-pair x)
(if (null? (cdr x))
x
(last-pair (cdr x))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.13.</span> Consider the following make-cycle procedure, which uses the last-pair procedure defined in exercise 3.12:
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-cycle x)
(set-cdr! (last-pair x) x)
x)
</textarea>
<br/>
Draw a box-and-pointer diagram that shows the structure z created by
<br/>
<textarea name="code" class="sch" cols="60">
(define z (make-cycle (list 'a 'b 'c)))
</textarea>
<br/>
What happens if we try to compute (last-pair z)?
<br/><br/>
<span style="font-weight:bold;">Answer:</span> Terrible things happen! <code>Make-cycle</code> creates a circular list. This is not a bad thing to have and might actually come useful under some circumstances. However trying to compute <code>(last-pair z)</code> throws the interpreter into an infinite loop.
<br/><br/>
<span style="font-weight:bold;">Exercise 3.16.</span> Ben Bitdiddle decides to write a procedure to count the number of pairs in any list structure. ``It's easy,'' he reasons. ``The number of pairs in any structure is the number in the car plus the number in the cdr plus one more to count the current pair.'' So Ben writes the following procedure:
<br/>
<textarea name="code" class="sch" cols="60">
(define (count-pairs x)
(if (not (pair? x))
0
(+ (count-pairs (car x))
(count-pairs (cdr x))
1)))
</textarea>
<br/>
Show that this procedure is not correct. In particular, draw box-and-pointer diagrams representing list structures made up of exactly three pairs for which Ben's procedure would return 3; return 4; return 7; never return at all.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define length-3 (cons (list 'a) (list 'b)))
(count-pairs length-3)
3
(define length-4 (list (list 'a) (list 'b)))
(count-pairs length-4)
4
(define x (cons (list 'a) (list 'b)))
(define length-7 (cons x x))
(count-pairs length-7)
7
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.18.</span> Write a procedure that examines a list and determines whether it contains a cycle, that is, whether a program that tried to find the end of the list by taking successive cdrs would go into an infinite loop. Exercise 3.13 constructed such lists.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (is-circular? x)
(define (iter y)
(cond ((null? y) false)
((eq? (car x) (car y)) true)
(else (iter (cdr y)))))
(iter (cdr x)))
(define z (make-cycle (list 'a 'b 'c)))
(is-circular? z)
#t
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0tag:blogger.com,1999:blog-16889165.post-36769580525275284292009-01-13T11:18:00.008+05:302009-01-13T11:37:57.117+05:30SICP Section 3.1 Assignment and Local State<span style="font-weight:bold;">Exercise 3.1.</span> An accumulator is a procedure that is called repeatedly with a single numeric argument and accumulates its arguments into a sum. Each time it is called, it returns the currently accumulated sum. Write a procedure make-accumulator that generates accumulators, each maintaining an independent sum. The input to make-accumulator should specify the initial value of the sum; for example
<br/>
<textarea name="code" class="sch" cols="60">
(define A (make-accumulator 5))
(A 10)
15
(A 10)
25
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-accumulator initial)
(define (accumulator value)
(set! initial (+ initial value))
initial)
accumulator)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.2.</span> In software-testing applications, it is useful to be able to count the number of times a given procedure is called during the course of a computation. Write a procedure make-monitored that takes as input a procedure, f, that itself takes one input. The result returned by make-monitored is a third procedure, say mf, that keeps track of the number of times it has been called by maintaining an internal counter. If the input to mf is the special symbol how-many-calls?, then mf returns the value of the counter. If the input is the special symbol reset-count, then mf resets the counter to zero. For any other input, mf returns the result of calling f on that input and increments the counter. For instance, we could make a monitored version of the sqrt procedure:
<br/>
<textarea name="code" class="sch" cols="60">
(define s (make-monitored sqrt))
(s 100)
10
(s 'how-many-calls?)
1
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-monitored f)
(define count 0)
(define (mf arg)
(cond ((eq? arg 'reset-count)
(set! count 0))
((eq? arg 'how-many-calls?)
count)
(else
(begin (set! count (+ 1 count))
(f arg)))))
mf)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.3.</span> Modify the make-account procedure so that it creates password-protected accounts. That is, make-account should take a symbol as an additional argument, as in
<br/>
<textarea name="code" class="sch" cols="60">
(define acc (make-account 100 'secret-password))
</textarea>
<br/>
The resulting account object should process a request only if it is accompanied by the password with which the account was created, and should otherwise return a complaint:
<br/>
<textarea name="code" class="sch" cols="60">
((acc 'secret-password 'withdraw) 40)
60
((acc 'some-other-password 'deposit) 50)
"Incorrect password"
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-account balance password)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (dispatch p m)
(if (eq? p password)
(cond ((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT" m)))
(lambda (m) "Incorrect Password")))
dispatch)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.4.</span> Modify the make-account procedure of exercise 3.3 by adding another local state variable so that, if an account is accessed more than seven consecutive times with an incorrect password, it invokes the procedure call-the-cops.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-account balance password)
(define (withdraw amount)
(if (>= balance amount)
(begin (set! balance (- balance amount))
balance)
"Insufficient funds"))
(define (deposit amount)
(set! balance (+ balance amount))
balance)
(define (dispatch p m)
(if (eq? p password)
(cond ((eq? m 'withdraw) withdraw)
((eq? m 'deposit) deposit)
(else (error "Unknown request -- MAKE-ACCOUNT" m)))
deal-with-incorrect-password))
(define count 0)
(define (deal-with-incorrect-password m)
(if (< count 7)
(begin (set! count (+ 1 count))
"Incorrect Password")
(call-the-cops)))
(define (call-the-cops)
"Calling-the-cops!")
dispatch)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.5.</span> Monte Carlo integration is a method of estimating definite integrals by means of Monte Carlo simulation. Consider computing the area of a region of space described by a predicate P(x, y) that is true for points (x, y) in the region and false for points not in the region. For example, the region contained within a circle of radius 3 centered at (5, 7) is described by the predicate that tests whether (x - 5)2 + (y - 7)2< 32. To estimate the area of the region described by such a predicate, begin by choosing a rectangle that contains the region. For example, a rectangle with diagonally opposite corners at (2, 4) and (8, 10) contains the circle above. The desired integral is the area of that portion of the rectangle that lies in the region. We can estimate the integral by picking, at random, points (x,y) that lie in the rectangle, and testing P(x, y) for each point to determine whether the point lies in the region. If we try this with many points, then the fraction of points that fall in the region should give an estimate of the proportion of the rectangle that lies in the region. Hence, multiplying this fraction by the area of the entire rectangle should produce an estimate of the integral.
<br/><br/>
Implement Monte Carlo integration as a procedure estimate-integral that takes as arguments a predicate P, upper and lower bounds x1, x2, y1, and y2 for the rectangle, and the number of trials to perform in order to produce the estimate. Your procedure should use the same monte-carlo procedure that was used above to estimate . Use your estimate-integral to produce an estimate of by measuring the area of a unit circle.
<br/><br/>
You will find it useful to have a procedure that returns a number chosen at random from a given range. The following random-in-range procedure implements this in terms of the random procedure used in section 1.2.6, which returns a nonnegative number less than its input.8
<br/>
<textarea name="code" class="sch" cols="60">
(define (random-in-range low high)
(let ((range (- high low)))
(+ low (random range))))
</textarea>
<br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (rect-area x1 x2 y1 y2)
(abs (* (- x2 x1) (- y2 y1))))
(define (estimate-integral P x1 x2 y1 y2 trials)
(define (experiment)
(P (random-in-range x1 x2) (random-in-range y1 y2)))
(define ratio
(monte-carlo trials experiment))
(define area
(rect-area x1 x2 y1 y2))
(* ratio area 1.0))
(define (estimate-pi trials)
(define (in-unit-circle? x y)
(<= (+ (square x)
(square y))
1))
(estimate-integral in-unit-circle? -1 1 -1 1 trials))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.6.</span> It is useful to be able to reset a random-number generator to produce a sequence starting from a given value. Design a new rand procedure that is called with an argument that is either the symbol generate or the symbol reset and behaves as follows: (rand 'generate) produces a new random number; ((rand 'reset) <new-value>) resets the internal state variable to the designated <new-value>. Thus, by resetting the state, one can generate repeatable sequences. These are very handy to have when testing and debugging programs that use random numbers.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (rand message)
(let ((x (random-init)))
(cond ((eq? mesage 'generate)
(lambda ()
(set! x (rand-update x))
x))
((eq? message 'reset)
(lambda (new-value)
(set! x new-value))))))
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.7.</span> Consider the bank account objects created by make-account, with the password modification described in exercise 3.3. Suppose that our banking system requires the ability to make joint accounts. Define a procedure make-joint that accomplishes this. Make-joint should take three arguments. The first is a password-protected account. The second argument must match the password with which the account was defined in order for the make-joint operation to proceed. The third argument is a new password. Make-joint is to create an additional access to the original account using the new password. For example, if peter-acc is a bank account with password open-sesame, then
<br/>
<textarea name="code" class="sch" cols="60">
(define paul-acc
(make-joint peter-acc 'open-sesame 'rosebud))
</textarea>
<br/>
will allow one to make transactions on peter-acc using the name paul-acc and the password rosebud. You may wish to modify your solution to exercise 3.3 to accommodate this new feature.
<br/><br/>
<span style="font-weight:bold;">Answer:</span>
<br/>
<textarea name="code" class="sch" cols="60">
(define (make-joint account original-password joint-password)
(define (dispatch p m)
(if (eq? joint-password p)
(account original-password m)
(lambda (m) "Incorrect (Joint) Password")))
dispatch)
</textarea>
<br/>
<span style="font-weight:bold;">Exercise 3.8.</span> When we defined the evaluation model in section 1.1.3, we said that the first step in evaluating an expression is to evaluate its subexpressions. But we never specified the order in which the subexpressions should be evaluated (e.g., left to right or right to left). When we introduce assignment, the order in which the arguments to a procedure are evaluated can make a difference to the result. Define a simple procedure f such that evaluating (+ (f 0) (f 1)) will return 0 if the arguments to + are evaluated from left to right but will return 1 if the arguments are evaluated from right to left.
<br/><br/>
<span style="font-weight:bold;">Answer:</span> This problem set me thinking about how to translate a procedure from one form to another. you can find my thoughts (and unresolved questions) <a href="http://lawfulsamurai.blogspot.com/2008/10/sicp-thinking-aloud.html">here</a>.
<br/>
<textarea name="code" class="sch" cols="60">
(define f
(let ((state 1))
(lambda (x) (set! state (* state x)) state)))
</textarea>
<br/>
Here are the snippets to test the solution. The second simulates a right-to-left order of execution. The interpreter has to be reset after executing the first snippet.
<br/>
<textarea name="code" class="sch" cols="60">
(+ (f 0) (f 1))
0
;; After resetting interpreter.
(+ (f 1) (f 0))
1
</textarea>
<br/>Manoj Govindanhttp://www.blogger.com/profile/12734036974316245850noreply@blogger.com0