diff options
| author | elioat <elioat@tilde.institute> | 2023-08-23 07:52:19 -0400 |
|---|---|---|
| committer | elioat <elioat@tilde.institute> | 2023-08-23 07:52:19 -0400 |
| commit | 562a9a52d599d9a05f871404050968a5fd282640 (patch) | |
| tree | 7d3305c1252c043bfe246ccc7deff0056aa6b5ab /js/games/nluqo.github.io/~bh/61a-pages/Solutions | |
| parent | 5d012c6c011a9dedf7d0a098e456206244eb5a0f (diff) | |
| download | tour-562a9a52d599d9a05f871404050968a5fd282640.tar.gz | |
*
Diffstat (limited to 'js/games/nluqo.github.io/~bh/61a-pages/Solutions')
16 files changed, 7121 insertions, 0 deletions
diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=A b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=A new file mode 100644 index 0000000..96770c5 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=A @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=D">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=D b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=D new file mode 100644 index 0000000..97181b6 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=D;O=D @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=A b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=A new file mode 100644 index 0000000..b284eed --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=A @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=D">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=D b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=D new file mode 100644 index 0000000..56cfe86 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=M;O=D @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=A b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=A new file mode 100644 index 0000000..b8f2eb8 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=A @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=D">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=D b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=D new file mode 100644 index 0000000..97181b6 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/index.html?C=N;O=D @@ -0,0 +1,30 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/61a-pages/Solutions</title> + </head> + <body> +<h1>Index of /~bh/61a-pages/Solutions</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="index.html?C=N%3BO=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/?C=S;O=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../../61a-pages">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week15">week15</a> </td><td align="right">2004-05-12 12:53 </td><td align="right">9.6K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week14">week14</a> </td><td align="right">2005-12-07 22:53 </td><td align="right"> 42K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week13">week13</a> </td><td align="right">2004-04-21 15:51 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week12">week12</a> </td><td align="right">2004-04-21 15:49 </td><td align="right"> 32K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week11">week11</a> </td><td align="right">2004-04-21 15:46 </td><td align="right"> 25K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week10">week10</a> </td><td align="right">2005-04-08 10:37 </td><td align="right"> 36K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week9">week9</a> </td><td align="right">2004-03-30 15:37 </td><td align="right"> 20K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week8">week8</a> </td><td align="right">2003-02-14 18:30 </td><td align="right">4.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week7">week7</a> </td><td align="right">2004-08-06 15:53 </td><td align="right"> 21K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week6">week6</a> </td><td align="right">2005-10-04 15:17 </td><td align="right"> 31K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week5">week5</a> </td><td align="right">2004-02-26 19:30 </td><td align="right"> 19K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week4">week4</a> </td><td align="right">2003-05-16 13:20 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/week3">week3</a> </td><td align="right">2003-02-12 11:55 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week2">week2</a> </td><td align="right">2006-09-25 11:11 </td><td align="right"> 15K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="week1">week1</a> </td><td align="right">2007-05-03 20:57 </td><td align="right"> 11K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/61a-pages/Solutions/proj2">proj2</a> </td><td align="right">2010-03-05 03:48 </td><td align="right">5.9K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week1 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week1 new file mode 100644 index 0000000..0616593 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week1 @@ -0,0 +1,325 @@ +CS 61A Week 1 Lab and Homework Solutions + +FIRST LAB: + +No problems that required original solutions! + +SECOND LAB: + +1. Nothing original. + +2. If the last letter is Y, then we have to look at the next-to-last: + +(define (plural wd) + (if (and (equal? (last wd) 'y) + (not (vowel? (last (bl wd))))) + (word (bl wd) 'ies) + (word wd 's))) + +If you didn't think to use AND in that way, it can be done with nested IFs: + +(define (plural wd) + (if (equal? (last wd) 'y) + (if (vowel? (last (bl wd))) + (word wd 's) + (word (bl wd) 'ies)) + (word wd 's))) + +Or, if that's too messy, with a subprocedure: + +(define (plural wd) + (if (equal? (last wd) 'y) + (y-plural (bl wd)) + (word wd 's))) + +(define (y-plural prefix) + (if (vowel? (last prefix)) + (word prefix 'ys) + (word prefix 'ies))) + +All of these assume the definition of vowel? in the handout. + + +3. There are, of course, many possible ways to write this. None is +perfectly elegant. The difficulty is figuring out which of the three +arguments is smallest, so you can leave it out of the computation. +The way I like best, I think, is a little tricky: + +(define (sum-square-large papa mama baby) + (define (square x) (* x x)) + (cond ((> mama papa) (sum-square-large mama papa baby)) + ((> baby mama) (sum-square-large papa baby mama)) + (else (+ (square papa) (square mama))))) + +I think this way is pretty concise and easy to read. However, it's okay +if you did it more straightforwardly like this: + +(define (sum-square-large a b c) + (define (square x) (* x x)) + (define (sumsq x y) (+ (square x) (square y))) + (cond ((and (<= a b) (<= a c)) (sumsq b c)) + ((and (<= b a) (<= b c)) (sumsq a c)) + (else (sumsq a b)) )) + +If you didn't think of using AND to identify the conditions, it could also +be done using nested IFs: + +(define (sum-square-large a b c) + (define (square x) (* x x)) + (define (sumsq x y) (+ (square x) (square y))) + (if (>= a b) + (if (>= b c) + (sumsq a b) + (sumsq a c)) + (if (>= a c) + (sumsq a b) + (sumsq b c)))) + +Some people wanted to start by solving a subproblem: a function to find +the two largest numbers. This can be done, but it's harder: + +(define (sum-square-large a b c) + (define (square x) (* x x)) + (define (sumsq nums) (+ (square (first nums)) (square (last nums)))) + (define (two-largest a b c) + (cond ((and (<= a b) (<= a c)) (sentence b c)) + ((and (<= b a) (<= b c)) (sentence a c)) + (else (sentence a b)))) + (sumsq (two-largest a b c))) + +The trick here is that a function can't return two values, so two-largest +has to return a sentence containing the two numbers. This hardly seems +worth the effort, but the attempt to split the problem into logical pieces +was well-motivated. It's a good idea in general, but it didn't work out +well this time. + +See also: +http://code.google.com/p/jrm-code-project/wiki/ProgrammingArt + + +4. Since we are examining each word of a sentence, the solution will +involve a recursion of the form (dupls-removed (bf sent)). The base +case is an empty sentence; otherwise, there are two possibilities, +namely, (first sent) either is or isn't duplicated later in the sentence. + +(define (dupls-removed sent) + (cond ((empty? sent) '()) + ((member? (first sent) (bf sent)) + (dupls-removed (bf sent))) + (else (sentence (first sent) (dupls-removed (bf sent)))))) + +============================================================ + +HOMEWORK: + +1. The Scheme interpreter applies an ordinary procedure by first evaluating +all the argument expressions and then invoking the procedure. Consider first +one of the examples that worked: + +> (new-if (= 2 3) 0 5) + +Scheme evaluates this expression as follows: + +(a) Evaluate the symbol new-if. Its value turns out to be an ordinary +procedure. Therefore the rest of the combination is evaluated normally. + +(b) Evaluate the three argument expressions. Their values are #f [i.e., +false], 0, and 5 respectively. + +(c) Apply the procedure new-if to the argument values #f, 0, and 5. By the +substitution model, this means we must substitute "#f" for "predicate", +"0" for "then-clause", and "5" for "else-clause": + (cond (#f 0) (else 5)) + +(d) Evaluate this new expression, getting the value 5. + +By contrast, if we'd entered the expression + +> (if (= 2 3) 0 5) + +Scheme would evaluate it as follows: + +(a) Notice that the symbol IF is a keyword, the name of a special form. +Therefore the rest of the combination is evaluated specially. + +(b) Invoke the special form with the UNEVALUATED argument expressions +"(= 2 3)", "0", and "5". + +(c) The "if" evaluation rule then causes its first argument to be +evaluated. Since the value is #f, i.e. false, it then evaluates +the expression "5", whose value is the number 5. The expression "0" +is never evaluated. + +In the example above, it doesn't make any PRACTICAL difference that the +expression "5" was evaluated to produce the number 5. [By the way, +Scheme uses quotation marks for a special purpose, which isn't what I +mean here. I'm just using them to delimit something you're to imagine as +having typed into the computer.] + +Now, on to the square root program. In the body of sqrt-iter, the third and +final argument to new-if is the expression + (sqrt-iter (improve guess x) x) +Suppose we invoke sqrt-iter with an expression like + (sqrt-iter 1 4) +Since sqrt-iter and new-if are both ordinary procedures, they are applied +just like the new-if example I described earlier: + +(a) Evaluate the symbol sqrt-iter. Its value turns out to be an ordinary +procedure. Therefore the rest of the combination is evaluated normally. + +(b) Evaluate the two argument expressions. Their values are 1 and 4, +respectively. + +(c) Apply the procedure sqrt-iter to the argument values 1 and 4. By the +substitution model, this means we must substitute "1" for "guess" and +"4" for "x": + (new-if (good-enough? 1 4) + 1 + (sqrt-iter (improve 1 4) + 4)) + +(d) Evaluate this new expression. Here is where the problem comes in. +Since new-if is an ordinary procedure, we follow steps (a)-(d) for this +sub-evaluation also: + +(a) Evaluate the symbol new-if. Its value turns out to be an ordinary +procedure. Therefore the rest of the combination is evaluated normally. + +(b) Evaluate the three argument expressions. The first one turns out +(after a sequence of (a)-(d) steps) to have the value #f, i.e., false. +The second has the value 1. The third invokes sqrt-iter, so we start +another (a)-(d) sequence of steps just like the first one. But the first +one is still pending, waiting for us to finish down here. That is, the +evaluation of the original (sqrt-iter 1 4) is waiting for the evaluation +of the new-if expression, and that's waiting for the evaluation of the new +sqrt-iter expression. But THAT will involve evaluating another new-if +expression, which will... This is an infinite regress. You'll never get +any answer at all. + +This business of nested evaluations isn't all wrong. In the real +sqrt-iter the same thing happens, with sqrt-iter invoking if, and if +invoking sqrt-iter, and so on. The difference is that with the real +if, a special form, Scheme gets to test whether the good-enough? expression +is true or false BEFORE it evaluates the inner sqrt-iter expression. At +first the good-enough? expression is false, so if invokes sqrt-iter repeatedly +just as in the new-if version. But eventually good-enough? returns a true +[that is, #t] value, and then the inner sqrt-iter expression need not be +evaluated. With new-if, we needed to evaluate the inner sqrt-iter before +we had a chance to see if good-enough? came out true or false. Therefore +Scheme never finds out that it's time to stop iterating. + + +2. + +(define (squares nums) + (if (empty? nums) + '() + (se (square (first nums)) + (squares (bf nums)) ))) + + +3. The tricky part is that the first word of the sentence must be +treated specially, so there has to be a top-level procedure that handles +it and also invokes a recursive subprocedure for the rest of the words: + +(define (switch sent) + (se (switch-first (first sent)) + (switch-rest (bf sent)) )) + +(define (switch-first wd) + (cond ((equal? wd 'you) 'I) + ((equal? wd 'I) 'you) + ((equal? wd 'me) 'you) + (else wd) )) + +(define (switch-rest sent) + (if (empty? sent) + '() + (se (switch-one (first sent)) + (switch-rest (bf sent)) ))) + +(define (switch-one wd) + (cond ((equal? wd 'you) 'me) + ((equal? wd 'I) 'you) + ((equal? wd 'me) 'you) + (else wd) )) + +4. + +(define (ordered? sent) + (cond ((empty? (bf sent)) #t) + ((> (first sent) (first (bf sent))) #f) + (else (ordered? (bf sent))) )) + +This procedure is written assuming that the argument is a sentence that +contains at least one word, and that all of the words are numbers. + + +5. + +(define (ends-e sent) + (cond ((empty? sent) '()) + ((equal? (last (first sent)) 'e) + (se (first sent) (ends-e (bf sent)))) + (else (ends-e (bf sent))))) + + +6. Are "and" and "or" ordinary functions or special forms? The general idea +of the solution is to type in an expression that will produce an error if all +its subexpressions are evaluated, and see if they all are. For example, +supposing there is no definition for the symbol "x" you could say + +> (or 1 2 x) + +According to the ordinary evaluation rule, the expressions "1" "2" and "x" +should all be evaluated before "or" is invoked, so you should get an error +message complaining about the unbound symbol. On the other hand, if "or" +is a special form, you'd expect it to stop as soon as it evaluates the "1" +and give 1 as its result. + +If you try this in Scheme, you don't get an error message. +This means, most likely, that "or" is a special form whose arguments +are evaluated one by one. If there were an error message could you +conclude that "or" is ordinary? No! "Or" could be a special form +that evaluates its arguments right-to-left. For that matter there is +no reason that "or" couldn't evaluate the middle argument first. How +would you test for that? + +(Of course, in reality you know that they're special forms because +the textbook told you so.) + +Why might a special form be a good idea? Here are a few reasons: + +(a) Efficiency. Suppose instead of numbers or symbols I used combinations +as the arguments to "or", and each combination takes several minutes to +compute. If the first one happens to be true, it'd be a shame to waste all +that time computing the others. + +(b) Conditions that depend on each other. Consider the expression + +> (or (= x 0) (> 5 (/ y x))) + +This will work fine if "or" is special and evaluates left-to-right, +otherwise we may be dividing by zero. + +Reasons why an ordinary function might be preferred: + +(c) Fewer kludges. It's very easy to read and understand a Lisp program +if you can be sure that everything that looks like (blah glorp zilch) +is evaluated by evaluating the subexpressions and then applying the +procedure "blah" to the arguments "glorp" and "zilch". Everything that +looks like a procedure application but is really a special case just makes +things that much harder to understand. + +(d) Creeping featurism. Where do we stop? Maybe we should make +multiplication a special form; after all, in the expression + +> (* 0 x) + +there's no real reason to evaluate x because we know zero times anything +is zero. Pretty soon there are no real functions left in the language. + +(e) Functional objects. You're not expected to know this yet, but +next week you'll learn that procedures can be manipulated as data, +just as numbers can. But special forms aren't procedures and there are +some things we can't do to them. diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 new file mode 100644 index 0000000..53e4817 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 @@ -0,0 +1,977 @@ +CS 61A -- Week 10 Solutions + + +LAB ASSIGNMENT: + +3.12 append vs. append! + +exp1 is (b); exp2 is (b c d). Append (without the !) makes copies of the +two pairs that are part of the list x. (You can tell because it uses +cons, which is the constructor function that generates a brand new pair.) +Append! does not invoke cons; it mutates the existing pairs to combine +the two argument lists. + + +2. Set! vs. set-cdr! + +There are two ways to think about this, and you should understand both +of them: + +The syntactic explanation -- SET! is a special form; its first argument +must be a symbol, not a compound expression. So anything of the form + (set! (...) ...) +must be an error. + +The semantic explanation -- SET! and SET-CDR! are about two completely +different purposes. SET! is about the bindings of variables in an +environment. SET-CDR! is about pointers within pairs. SET! has nothing +to do with pairs; SET-CDR! has nothing to do with variables. There is +no situation in which they are interchangeable. + +(Note: The book says, correctly, that the two are *equivalent* in the +sense that you can use one to implement the other. But what that means +is that, for example, if we didn't have pairs in our language we could +use the oop techniques we've learned, including local state variables +bound in an environment, to simulate pairs. Conversely, we'll see in +Chapter 4 that we can write a Scheme interpreter, including environments +as an abstract data type, building them out of pairs. But given that +we are using the regular Scheme's built-in pairs and built-in environments, +those have nothing to do with each other.) + + + +3a. Fill in the blanks. + +> (define list1 (list (list 'a) 'b)) +list1 +> (define list2 (list (list 'x) 'y)) +list2 +> (set-cdr! ____________ ______________) +okay +> (set-cdr! ____________ ______________) +okay +> list1 +((a x b) b) +> list2 +((x b) y) + +The key point here is that if we're only allowed these two SET-CDR!s then +we'd better modify list2 first, because the new value for list1 uses the +sublist (x b) that we'll create for list2. + +So it's + +(set-cdr! (car list2) (cdr list1)) + +(set-cdr! (car list1) (car list2)) + + + +3b. Now do (set-car! (cdr list1) (cadr list2)). + +Everything that used to be "b" is now "y" instead: + +> list1 +((a x y) y) +> list2 +((x y) y) + +The reason is that there was only one appearance of the symbol B in +the diagram, namely as the cadr of list1; every appearance of B in the +printed representation of list1 or list2 came from pointers to the +pair (cdr list1). The SET-CAR! only makes one change to one pair, +but three different things point (directly or indirectly) to it. + + + +3.13 make-cycle + +The diagram is + + +----------------+ + | | + V | +---> XX--->XX--->XX---+ + | | | + V V V + a b c + +(last-pair z) will never return, because there is always a non-empty +cdr to look at next. + + + +3.14 Mystery procedure. + +This procedure is REVERSE!, that is to say, it reverses the list +by mutation. After + + (define v (list 'a 'b 'c 'd)) + (define w (mystery v)) + +the value of w is the list (d c b a); the value of v is the list (a) +because v is still bound to the pair whose car is a. (The procedure +does not change the cars of any pairs.) + + + +5a. We want Scheme-2 to accept both the ordinary form + (define x 3) +and the procedure-abbreviation form + (define (square x) (* x x)) +The latter should be treated as if the user had typed + (define square (lambda (x) (* x x))) +The hint says we can use data abstraction to achieve this. + +Here is the existing code that handles DEFINE: + +(define (eval-2 exp env) + (cond ... + ((define-exp? exp) (put (cadr exp) + (eval-2 (caddr exp) env) + env) + 'okay) + ...)) + +We're going to use selectors for the pieces of the DEFINE expression: + +(define (eval-2 exp env) + (cond ... + ((define-exp? exp) (put (DEFINE-VARIABLE exp) + (eval-2 (DEFINE-VALUE exp) env) + env) + 'okay) + ...)) + +To get the original behavior we would define the selectors this way: + +(define define-variable cadr) +(define define-value caddr) + +But instead we'll check to see if the cadr of the expression is a +symbol (so we use the ordinary notation) or a list (abbreviating +a procedure definition): + +(define (define-variable exp) + (if (pair? (cadr exp)) + (caadr exp) ;(define (XXXX params) body) + (cadr exp))) + +(define (define-value exp) + (if (pair? (cadr exp)) + (cons 'lambda + (cons (cdadr exp) ;params + (cddr exp))) ;body + (caddr exp))) + +Writing selectors like this is the sort of situation in which the compositions +like CAADR are helpful. That particular one is (car (cadr exp)), which is the +first element of the second element of the expression. (You should recognize +CADR, CADDR, and CADDDR as selectors for the second, third, and fourth +elements of a list.) The second element of the expression is a list such as +(SQUARE X), so the car of that list is the variable name. + +Since DEFINE-VALUE is supposed to return an expression, we have to construct +a LAMBDA expression, making explicit what this notation abbreviates. + + +5c. In a procedure call, parameters are processed from left to right, +and PUT adds each parameter to the front of the environment. So they +end up in reverse order. Similarly, top-level DEFINEs add things to +the global environment in reverse order. So the sequence of expressions +should be + +Scheme-2: (define b 2) +Scheme-2: (define a 1) +Scheme-2: ((lambda (c b) 'foo) 4 3) + +It doesn't matter what's in the body of the procedure, since we're +interested in the environments rather than in the values returned. + + + +HOMEWORK: + +3.16 incorrect count-pairs + +This procedure would work fine for any list structure that can be expressed +as (quote <anything>). It fails when there are two pointers to the same pair. + +(define a '(1 2 3)) (count-pairs a) --> 3 + +(define b (list 1 2 3)) +(set-car! (cdr b) (cddr b)) (count-pairs b) --> 4 + +(define x (list 1)) +(define y (cons x x)) +(define c (cons y y)) (count-pairs c) --> 7 + +(define d (make-cycle (list 1 2 3))) (count-pairs d) --> infinite loop + +Note from example c that it's not necessary to use mutators to create +a list structure for which this count-pairs fails, but it is necessary +to have a name for a substructure so that you can make two pointers to it. +The name needn't be global, though; I could have said this: + +(define c + (let ((x (list 1))) + (let ((y (cons x x))) + (cons y y) ))) + + +3.17 correct count-pairs + +(define (count-pairs lst) + (let ((pairlist '()) + (count 0)) + (define (mark-pair pair) + (set! pairlist (cons pair pairlist)) + (set! count (+ count 1))) + (define (subcount pair) + (cond ((not (pair? pair)) 'done) + ((memq pair pairlist) 'done) + (else (mark-pair pair) + (subcount (car pair)) + (subcount (cdr pair))))) + (subcount lst) + count)) + +The list structure in pairlist can get very complicated, especially if +the original structure is complicated, but it doesn't matter. The cdrs +of pairlist form a straightforward, non-circular list; the cars may point +to anything, but we don't follow down the deep structure of the cars. We +use memq, which sees if PAIR (a pair) is eq? (NOT equal?) to the car of some +sublist of pairlist. Eq? doesn't care about the contents of a pair; it just +looks to see if the two arguments are the very same pair--the same location +in the computer's memory. + +[Non-experts can stop here and go on to the next problem. The following +optional material is just for experts, for a deeper understanding.] + +It's not necessary to use local state and mutation. That just makes the +problem easier. The reason is that a general list structure isn't a sequence; +it's essentially a binary tree of pairs (with non-pairs as the leaves). So +you have to have some way to have the pairs you encounter in the left branch +still remembered as you traverse the right branch. The easiest way to do +this is to remember all the pairs in a variable that's declared outside the +SUBCOUNT procedure, so it's not local to a particular subtree. + +But another way to do it is to have a more complicated helper procedure +that takes PAIRLIST as an argument, but also sequentializes the traversal by +keeping a list of yet-unvisited nodes, sort of like the breadth-first tree +traversal procedure (although this goes depth-first because TODO is a stack, +not a queue): + +(define (count-pairs lst) + (define (helper pair pairlist count todo) + (if (or (not (pair? pair)) (memq pair pairlist)) ; New pair? + (if (null? todo) ; No. More pairs? + count ; No. Finished. + (helper (car todo) pairlist count (cdr todo))) ; Yes, pop one. + (helper (car pair) (cons pair pairlist) (+ count 1) ; Yes, count it, + (cons (cdr pair) todo)))) ; do car, push cdr + (helper lst '() 0 '())) + +As you're reading this code, keep in mind that all the calls to HELPER +are tail calls, so this is an iterative process, unlike the solution +using mutation, in which the call (SUBCOUNT (CAR PAIR)) isn't a tail call +and so that solution generates a recursive process. + +And after you understand that version, try this one: + +(define (count-pairs lst) + (define (helper pair pairlist count todo) + (if (or (not (pair? pair)) (memq pair pairlist)) ; New pair? + (todo pairlist count) ; No. Continue. + (helper (car pair) (cons pair pairlist) (+ count 1) ; Yes, count it, + (lambda (pairlist count) ; do car, push cdr + (helper (cdr pair) pairlist count todo))))) + (helper lst '() 0 (lambda (pairlist count) count))) + +Here, instead of being a list of waiting pairs, TODO is a procedure that +knows what tasks remain. The name for such a procedure is a "continuation" +because it says how to continue after doing some piece of the problem. +This is an example of "continuation-passing style" (CPS). Since TODO is +tail-called, you can think of it as the target of a goto, if you've used +languages with that feature. + + +3.21 print-queue + +The extra pair used as the head of the queue has as its car an ordinary +list of all the items in the queue, and as its cdr a singleton list of +the last element of the queue. Each of Ben's examples print as a list of +two members; the first member is a list containing all the items in the +queue, and the second member is just the last item in the queue. If you +look at what Ben printed, take its car and you'll get the queue items; +take its cdr and you'll get a list of one member, namely the last queue +item. The only exception is Ben's last example. In that case, the car of +what Ben prints correctly indicates that the queue is empty, but the cdr +still contains the former last item. This is explained by footnote 22 +on page 265, which says that we don't bother updating the rear-ptr when we +delete the last (or any) member of the queue because a null front-ptr is +good enough to tell us the queue is empty. + +It's quite easy to print the sequence of items in the queue: + +(define print-queue front-ptr) + + +3.25 multi-key table + +Several students generalized the message-passing table implementation +from page 271, which is fine, but it's also fine (and a little easier) +to generalize the simpler version of page 270: + +(define (lookup keylist table) + (cond ((not table) #f) + ((null? keylist) (cdr table)) + (else (lookup (cdr keylist) + (assoc (car keylist) (cdr table)))))) + +(define (insert! keylist value table) + (if (null? keylist) + (set-cdr! table value) + (let ((record (assoc (car keylist) (cdr table)))) + (if (not record) + (begin + (set-cdr! table + (cons (list (car keylist)) (cdr table))) + (insert! (cdr keylist) value (cadr table))) + (insert! (cdr keylist) value record))))) + +That solution assumes all the entries are compatible. If you say + (insert! '(a) 'a-value my-table) + (insert! '(a b) 'ab-value my-table) +the second call will fail because it will try to + (assoc 'b (cdr 'a-value)) +and the CDR will cause an error. If you'd like to be able to have +values for both (a) and (a b), the solution is more complicated; +each table entry must contain both a value and a subtable. In the +version above, each association list entry is a pair whose CAR is +a key and whose CDR is *either* a value or a subtable. In the version +below, each association list entry is a pair whose CAR is a key and +whose CDR is *another pair* whose CAR is a value (initially #f) and whose +CDR is a subtable (initially empty). Changes are in CAPITALS below: + +(define (lookup keylist table) + (cond ; *** the clause ((not table) #f) is no longer needed + ((null? keylist) (CAR table)) ; *** + (else (LET ((RECORD (assoc (car keylist) (cdr table)))) + (IF (NOT RECORD) + #F + (lookup (cdr keylist) (CDR RECORD))))))) ; *** + +(define (insert! keylist value table) + (if (null? keylist) + (SET-CAR! table value) ; *** + (let ((record (assoc (car keylist) (cdr table)))) + (if (not record) + (begin + (set-cdr! table + (cons (LIST (CAR keylist) #F) (cdr table))) ; *** + (insert! (cdr keylist) value (CDADR table))) + (insert! (cdr keylist) value (CDR RECORD)))))) ; *** + + +Note: In a sense, this problem can be solved without doing any work at all. +In a problem like + + (lookup '(red blue green) color-table) + +you can think of (red blue green) as a list of three keys, each of which is +a word, or as a single key containing three words! So the original +one-dimensional implementation will accept this as a key. However, for a +large enough table, this would be inefficient because you have to look +through a very long list of length Theta(n^3) instead of three lists each +Theta(n) long. + + + +3.27 Memoization + +Here's what happened when I tried it, with annotations in [brackets]. +In the annotations, (fib n) really means that (memo-fib n) is called! +I just said "fib" to save space. + +> (memo-fib 3) +"CALLED" memo-fib 3 [user calls (fib 3)] + "CALLED" lookup 3 (*table*) + "RETURNED" lookup #f + "CALLED" memo-fib 2 [(fib 3) calls (fib 2)] + "CALLED" lookup 2 (*table*) + "RETURNED" lookup #f + "CALLED" memo-fib 1 [(fib 2) calls (fib 1)] + "CALLED" lookup 1 (*table*) + "RETURNED" lookup #f + "CALLED" insert! 1 1 (*table*) + "RETURNED" insert! ok + "RETURNED" memo-fib 1 [(fib 1) returns 1] + "CALLED" memo-fib 0 [(fib 2) calls (fib 0)] + "CALLED" lookup 0 (*table* (1 . 1)) + "RETURNED" lookup #f + "CALLED" insert! 0 0 (*table* (1 . 1)) + "RETURNED" insert! ok + "RETURNED" memo-fib 0 [(fib 0) returns 0] + "CALLED" insert! 2 1 (*table* (0 . 0) (1 . 1)) + "RETURNED" insert! ok + "RETURNED" memo-fib 1 [(fib 2) returns 1] + "CALLED" memo-fib 1 [(fib 3) calls (fib 1) ****] + "CALLED" lookup 1 (*table* (2 . 1) (0 . 0) (1 . 1)) + "RETURNED" lookup 1 + "RETURNED" memo-fib 1 [(fib 1) returns 1] + "CALLED" insert! 3 2 (*table* (2 . 1) (0 . 0) (1 . 1)) + "RETURNED" insert! ok +"RETURNED" memo-fib 2 [(fib 3) returns 2] +2 + +The line marked **** above is the only call to memo-fib in this example in +which the memoization actually finds a previous value. We are computing +(fib 1) for the second time, so memo-fib finds it in the table. + +In general, calling memo-fib for some larger argument will result in two +recursive calls for each smaller argument value. For example: + + fib 6 ---> fib 5, fib 4 + fib 5 ---> fib 4, fib 3 + fib 4 ---> fib 3, fib 2 + +and so on. (memo-fib 4) is evaluated once directly from (memo-fib 6) and once +from (memo-fib 5). But only one of those actually requires any computation; +the other finds the value in the table. + +This is why memo-fib takes Theta(n) time: it does about 2n recursive calls, +half of which are satisfied by values found in the table. + +If we didn't use memoization, or if we defined memo-fib to be (memoize fib), +we would have had to compute (f 1) twice. In this case there would only be +one duplicated computation, but the number grows exponentially; for (fib 4) +we have to compute (fib 2) twice and (fib 1) three times. + +By the way, notice that if we try (memo-fib 3) a second time from the Scheme +prompt, we get a result immediately: + +> (memo-fib 3) +"CALLED" memo-fib 3 + "CALLED" lookup 3 (*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1)) + "RETURNED" lookup 2 +"RETURNED" memo-fib 2 +2 + + +Scheme-2 set!: This is actually tricky -- I got it wrong the first time +I tried it. The trouble is that the procedure PUT in scheme2.scm, which +was written for use by DEFINE, doesn't modify an existing binding, and +therefore isn't useful for implementing SET!. But it's not a good idea +to change PUT, because that breaks DEFINE. We want a DEFINE in an inner +environment (that is, a DEFINE in a procedure body) to make a new +variable, even if a variable with the same name exists in the global +environment. This is why PUT always adds a new binding, not checking +for an old one. But SET! should *only* modify an existing binding, +not create a new one. + +We change eval-2 like this: + +(define (eval-2 exp env) + (cond ... + ((define-exp? exp) (put (define-variable exp) + (eval-2 (define-value exp) env) + env) + 'okay) + ((SET!-EXP? EXP) (SET-PUT (CADR EXP) + (EVAL-2 (CADDR EXP) ENV) + ENV) + 'OKAY) + ...)) + +Then we define SET-PUT: + +(define (set-put var val env) + (let ((pair (assoc var (cdr env)))) + (if pair + (set-cdr! pair val) + (error "No such variable: " var)))) + + +Scheme-2 bug: This is a complicated diagram, and I'm going to +abbreviate it by not showing the pairs that are inside lambda +expressions. The notation (\x) below means (lambda (x) ...). + + +GLOBAL ENV ----> XX--->XX----------------->XX--------------------->X/ + +----/ ---^ | | | +-^ | + | +--/ V V V ! V + | | *TABLE* XX XX ! XX + | | | \ | \ ! | \ + | | V V V V ! V | + | | g XX--->XX--->X/ h XX--->XX--->X/ ! f | + | | | | | | | | ! | + | | V V | V V | ! | + | | PROC (\z) | PROC (\y) | ! | + | | | | ! | + | +-----------------------------+ | ! | + | +-+ ! | + | | ! | + | | ! | + | V ! | + | env for (f 3)----------> XX--->XX | + | | +-^| | + | V | V | + | *TABLE*| XX | + | | / \ | + | env for (h 4)--------> XX--->XX------------+ V V | + | | | x 3 | + | V V +-----------------+ + | *TABLE* XX V + | / \ XX--->XX--->X/ + | V V | | | + | y 4 PROC (\x) | + +----------------------------------------------------------+ + +The problem is with the vertical arrow made of exclamation points near +the right of the picture. It tells us that the environment created by +the call (f 3) extends the global environment *as it exists at the +time of this procedure call*! So the new environment has a new +binding for X, and the existing binding for F. This is the environment +that procedure H remembers, so when we call (h 4), within the body of H +the bindings of G and H are invisible. + +The whole point of this exercise is to convince you that it's not +good enough to represent an environment as a list of bindings. We +have to represent it as a list of frames, each of which is a list +of bindings. This is how the textbook does it, in week 12. + + +Vector exercises: + +1. VECTOR-APPEND is basically like VECTOR-CONS in the notes, +except that we need two loops, one for each source vector: + +(define (vector-append vec1 vec2) + (define (loop newvec vec n i) + (if (>= n 0) + (begin (vector-set! newvec i (vector-ref vec n)) + (loop newvec vec (- n 1) (- i 1))))) + (let ((result (make-vector (+ (vector-length vec1) (vector-length vec2))))) + (loop result vec1 (- (vector-length vec1) 1) (- (vector-length vec1) 1)) + (loop result vec2 (- (vector-length vec2) 1) (- (vector-length result) 1)) + result)) + + +2. VECTOR-FILTER is tough because we have to do the filtering twice, +first to get the length of the desired result vector, then again to +fill in the slots: + +(define (vector-filter pred vec) + (define (get-length n) + (cond ((< n 0) 0) + ((pred (vector-ref vec n)) + (+ 1 (get-length (- n 1)))) + (else (get-length (- n 1))))) + (define (loop newvec n i) + (cond ((< n 0) newvec) + ((pred (vector-ref vec n)) + (vector-set! newvec i (vector-ref vec n)) + (loop newvec (- n 1) (- i 1))) + (else (loop newvec (- n 1) i)))) + (let ((newlen (get-length (- (vector-length vec) 1)))) + (loop (make-vector newlen) (- (vector-length vec) 1) (- newlen 1)))) + + +3. Bubble sort is notorious because nobody ever uses it in practice, +because it's slow, but it always appears in programming course +exercises, because the operation of swapping two neighboring elements +is relatively easy to write. + +(a) Here's the program: + +(define (bubble-sort! vec) + (let ((len (vector-length vec))) + (define (loop n) + (define (bubble k) + (if (= k n) + 'one-pass-done + (let ((left (vector-ref vec (- k 1))) + (right (vector-ref vec k))) + (if (> left right) + (begin (vector-set! vec (- k 1) right) + (vector-set! vec k left))) + (bubble (+ k 1))))) + (if (< n 2) + vec + (begin (bubble 1) + (loop (- n 1))))) + (loop len))) + +(b) As the hint says, we start by proving that after calling (bubble 1) inside +the call to (loop n), element number n-1 is greater than any element to its +left. + +(Bubble 1) reorders elements 0 and 1 so that vec[0] is less than or equal to +vec[1] (I'm using C/Java notation for elements of vectors), then reorders +elements 1 (the *new* element 1, which is the larger of the original first +two elements) and element 2 so that vec[1] is less than or equal to vec[2]. +It continues, but let's stop here for the moment. After those two steps, +the new vec[2] is at least as large as vec[1]. But the intermediate value +of vec[1] was larger than the new vec[0], so vec[2] must be the largest. + +This might be clearer with a chart. There are six possible original +orderings of the first three elements; here they are, with the ordering +after the 0/1 swap and the ordering after the 1/2 swap. (To make the +table narrower, I've renamed VEC as V. Also, I'm calling the three +values 0, 1, and 2; it doesn't matter what the actual values are, as +long as they are in the same order as a particular line in the table.) + +original after 0/1 swap after 1/2 swap +-------------- -------------- -------------- +v[0] v[1] v[2] v[0] v[1] v[2] v[0] v[1] v[2] +---- ---- ---- ---- ---- ---- ---- ---- ---- + + 0 1 2 0 1 2 0 1 2 + 0 2 1 0 2 1 0 1 2 + 1 0 2 0 1 2 0 1 2 + 1 2 0 1 2 0 1 0 2 + 2 0 1 0 2 1 0 1 2 + 2 1 0 1 2 0 1 0 2 + +After the first swap, we have v[0] <= v[1]. After the second swap, +we have v[1] <= v[2]. But note that there is no guarantee about the +order of the final v[0] and v[1]! All that's guaranteed is that +the largest of the three values is now in v[2]. + +Similarly, after the 2/3 swap, we know that vec[3] is the largest +of the first four values, because either the original vec[3] was +already largest, in which case there is no swap, or the value of +vec[2] just before the 2/3 swap is the largest of the original +vec[0] through vec[2], so it's the largest of vec[0] through vec[3] +and will rightly end up as the new vec[3]. + +Subprocedure BUBBLE calls itself recursively until k=n, which means +that vec[n-1] is the largest of the first n elements. QED. + +Now, if that's true about a single pass, then the first pass +"bubbles" the largest number to the end of the vector (this is why +it's called bubble sort), and then we call LOOP recursively to +sort the remaining elements. The second pass gets vec[len-2] to +be the largest of the first len-1 elements, etc. After LEN passes, +the entire vector is sorted. + +This was a handwavy proof. To make it rigorous, it'd be done by +mathematical induction -- two inductions, one for the swaps in a +single pass, and one for the multiple passes. + +(c) It's Theta(N^2), for the usual reason: N passes, each of which +takes time Theta(N). + + +Extra for experts +----------------- + +3.19 constant-space cycle? predicate + +Just to make sure you understand the issue, let me first do 3.18, which +asks us to write cycle? without imposing a constant-space requirement. +It's a lot like the correct version of count-pairs; it has to keep track +of which pairs we've seen already. + +(define (cycle? lst) + (define (iter lst pairlist) + (cond ((not (pair? lst)) #f) + ((memq lst pairlist) #t) + (else (iter (cdr lst) (cons lst pairlist))))) + (iter lst '())) + +This is simpler than count-pairs because we only have to chase down pointers +in one direction (the cdr) instead of two, so it can be done iteratively. +I check (not (pair? lst)) rather than (null? lst) so that the program won't +blow up on a list structure like (a . b) by trying to take the cdr of b. + +The trouble is that the list pairlist will grow to be the same size as the +argument list, if the latter doesn't contain a cycle. What we need is to +find a way to keep the auxiliary list of already-seen pairs without using +up any extra space. + +Here is the very cleverest possible solution: + +(define (cycle? lst) + (define (iter fast slow) + (cond ((not (pair? fast)) #f) + ((not (pair? (cdr fast))) #f) + ((eq? fast slow) #t) + (else (iter (cddr fast) (cdr slow))) )) + (if (not (pair? lst)) + #f + (iter (cdr lst) lst) )) + +This solution runs in Theta(1) space and Theta(n) time. We send two +pointers CDRing down the list at different speeds. If the list is not a +cycle, the faster one will eventually hit the end of the list, and we'll +return false. If the list is a cycle, the faster one will eventually +overtake the slower one, and we'll return true. (You may think that this +will only work for odd-length cycles, or only for even-length cycles, +because in the opposite case the fast pointer will leapfrog over the slow +one, but if that happens the two pointers will become equal on the next +iteration.) + +If you didn't come up with this solution, don't be upset; most folks don't. +This is a classic problem, and struggling with it is a sort of initiation +ritual in the Lisp community. Here's a less clever solution that runs in +Theta(1) space but needs Theta(n^2) time. It is like the first solution, the +one that uses an auxiliary pairlist, but the clever idea is to use the +argument list itself as the pairlist. This can be done by clobbering its cdr +pointers temporarily. It's important to make sure we put the list back +together again before we leave! The idea is that at any time we will have +looked at some initial sublist of the argument, and we'll know for sure that +that part is cycle-free. We keep the tested part and the untested part +separate by changing the cdr of the last tested pair to the empty list, +remembering the old cdr in the single extra pointer variable that this +algorithm requires. + +(define (cycle? lst) + (define (subq? x list) + (cond ((null? list) #f) + ((eq? x list) #t) + (else (subq? x (cdr list))))) + (define (iter lst pairlist pairlist-tail) + (cond ((not (pair? lst)) + (set-cdr! pairlist-tail lst) + #f) + ((subq? lst pairlist) + (set-cdr! pairlist-tail lst) + #t) + (else + (let ((oldcdr (cdr lst))) + (set-cdr! pairlist-tail lst) + (set-cdr! lst '()) + (iter oldcdr pairlist lst) )))) + (cond ((null? lst) #f) + (else (let ((oldcdr (cdr lst))) + (set-cdr! lst '()) + (iter oldcdr lst lst))))) + +Be wary of computing (cdr lst) before you've tested whether or not lst is +empty. + + +3.23 Double-ended queue + +The only tricky part here is rear-delete-deque!. All the other deque +operations can be performed in Theta(1) time using exactly the same structure +used for the queue in 3.3.2. The trouble with rear-delete is that in order +to know where the new rear is, we have to be able to find the next-to-last +member of the queue. In the 3.3.2 queue, the only way to do that is to cdr +down from the front, which takes Theta(n) time for an n-item queue. To +avoid that, each item in the queue must point not only to the next item but +also to the previous item: + ++---+---+ +| | | --------------------------------------------+ ++-|-+---+ | + | | + V V ++---+---+ +---+---+ +---+---+ +---+--/+ +| | | --------->| | | --------->| | | --------->| | | / | ++-|-+---+ +-|-+---+ +-|-+---+ +-|-+/--+ + | ^ | ^ | ^ | + | +-----+ | +-----+ | +-----+ | + V | V | V | V ++--/+---+ | +---+---+ | +---+---+ | +---+---+ +| / | | | +------ | | | +------ | | | +------ | | | ++/--+-|-+ +---+-|-+ +---+-|-+ +---+-|-+ + | | | | + V V V V + a b c d + + +Whew! The first pair, at the top of the diagram, is the deque header, just +like the queue header in 3.3.2. The second row of four pairs is a regular +list representing the deque entries, again just like 3.3.2. But instead of +each car in the second row pointing to a queue item, each car in this +second row points to another pair, whose car points to the previous element +on the second row and whose cdr points to the actual item. + +;; data abstractions for deque members + +;; we use front-ptr, rear-ptr, set-front-ptr!, and set-rear-ptr! from p. 263 + +(define deque-item cdar) +(define deque-fwd-ptr cdr) +(define deque-back-ptr caar) +(define set-deque-fwd-ptr! set-cdr!) +(define (set-deque-back-ptr! member new-ptr) + (set-car! (car member) new-ptr)) + +;; Now the things we were asked to do: + +(define (make-deque) (cons '() '())) + +(define (empty-deque? deque) (null? (front-ptr deque))) + +(define (front-deque deque) + (if (empty-deque? deque) + (error "front-deque called with empty queue") + (deque-item (front-ptr deque)))) + +(define (rear-deque deque) + (if (empty-deque? deque) + (error "rear-deque called with empty queue") + (deque-item (rear-ptr deque)))) + +(define (front-insert-deque! deque item) + (let ((new-member (list (cons '() item)))) + (cond ((empty-deque? deque) + (set-front-ptr! deque new-member) + (set-rear-ptr! deque new-member) + "done") + (else + (set-deque-fwd-ptr! new-member (front-ptr deque)) + (set-deque-back-ptr! (front-ptr deque) new-member) + (set-front-ptr! deque new-member) + "done")))) + +(define (rear-insert-deque! deque item) + (let ((new-member (list (cons '() item)))) + (cond ((empty-deque? deque) + (set-front-ptr! deque new-member) + (set-rear-ptr! deque new-member) + "done") + (else + (set-deque-back-ptr! new-member (rear-ptr deque)) + (set-deque-fwd-ptr! (rear-ptr deque) new-member) + (set-rear-ptr! deque new-member) + "done")))) + +(define (front-delete-deque! deque) + (cond ((empty-deque? deque) + (error "front-delete-deque! called with empty queue")) + ((null? (deque-fwd-ptr (front-ptr deque))) + (set-front-ptr! deque '()) + (set-rear-ptr! deque '()) + "done") + (else + (set-deque-back-ptr! (deque-fwd-ptr (front-ptr deque)) '()) + (set-front-ptr! deque (deque-fwd-ptr (front-ptr deque))) + "done"))) + +(define (rear-delete-deque! deque) + (cond ((empty-deque? deque) + (error "rear-delete-deque! called with empty queue")) + ((null? (deque-back-ptr (rear-ptr deque))) + (set-front-ptr! deque '()) + (set-rear-ptr! deque '()) + "done") + (else + (set-deque-fwd-ptr! (deque-back-ptr (rear-ptr deque)) '()) + (set-rear-ptr! deque (deque-back-ptr (rear-ptr deque))) + "done"))) + +I could also have gotten away with leaving garbage in the rear-ptr of +an emptied deque, but the ugliness involved outweighs the slight time +saving to my taste. Notice an interesting property of the use of data +abstraction here: at the implementation level, set-deque-back-ptr! and +set-deque-fwd-ptr! are rather different, but once that difference is +abstracted away, rear-delete-deque! is exactly like front-delete-deque! +and ditto for the two insert procedures. + +The reason these procedures return "done" instead of returning deque, +like the single-end queue procedures in the book, is that the deque is a +circular list structure, so if we tried to print it we'd get in trouble. +We should probably invent print-deque: + +(define (print-deque deque) + (define (sub member) + (if (null? member) + '() + (cons (deque-item member) + (sub (deque-fwd-ptr member))))) + (sub (front-ptr deque))) + +But I'd say it's a waste of time to cons up this printable list every time +we insert or delete something. + + +2. cxr-name + +This is a harder problem than its inverse function cxr-function! We are +given a function as a black box, not knowing how it was defined; the only +way we can get any information about it is to invoke it on a cleverly +chosen argument. + +We need three ideas here. The first one is this: Suppose we knew that we +were given either CAR or CDR as the argument. We could determine which +of them by applying the mystery function to a pair with the word CAR as its +car, and the word CDR as its cdr: + +(define (simple-cxr-name fn) + (fn '(car . cdr))) + +You might think to generalize this by building a sort of binary tree with +function names at the leaves: + +(define (two-level-cxr-name fn) + (fn '((caar . cdar) . (cadr . cddr)))) + +But there are two problems with this approach. First, note that this +version *doesn't* work for CAR or CDR, only for functions with exactly +two CARs or CDRs composed. Second, the argument function might be a +composition of *any* number of CARs and CDRs, so we'd need an infinitely +deep tree. + +So the second idea we need is a way to attack the mystery function one +component at a time. We'd like the first CAR or CDR applied to our argument +(that's the rightmost one, don't forget) to be the only one that affects the +result; once that first choice has been made, any CARs or CDRs applied to the +result shouldn't matter. The clever idea is to make a pair whose CAR and CDR +both point to itself! So any composition of CARs and CDRs of this pair will +still just be the same pair. + +Actually we'll make two of these pairs, one for the CAR of our argument pair +and one for the CDR: + +(define car-pair (cons '() '())) +(set-car! car-pair car-pair) +(set-cdr! car-pair car-pair) + +(define cdr-pair (cons '() '())) +(set-car! cdr-pair cdr-pair) +(set-cdr! cdr-pair cdr-pair) + +(define magic-argument (cons car-pair cdr-pair)) + +(define (rightmost-part fn) + (if (eq? (fn magic-argument) car-pair) + 'car + 'cdr)) + +It's crucial that we're using EQ? rather than EQUAL? here, since car-pair +and cdr-pair are infinite (circular) lists. + +Okay, we know the rightmost component. How do we get all but the rightmost +component? (Given that, we can recursively find the rightmost part of that, +etc.) Our third clever idea is a more-magic argument that will give us +magic-argument whether we take its car or its cdr: + +(define more-magic-arg (cons magic-argument magic-argument)) + +(define (next-to-rightmost-part fn) + (if (eq? (fn more-magic-arg) car-pair) + 'car + 'cdr)) + +We're going to end up constructing a ladder of pairs whose car and cdr are +both the next pair down the ladder. We also need a base case; if we apply +fn to magic-argument and get magic-argument itself, rather than car-pair +or cdr-pair, we've run out of composed CAR/CDR functions. + +Here's how it all fits together: + +(define (cxr-name fn) + (word 'c (cxr-name-help fn magic-argument) 'r)) + +(define (cxr-name-help fn arg) + (let ((result (fn arg))) + (cond ((eq? result car-pair) + (word (cxr-name-help fn (cons arg arg)) 'a)) + ((eq? result cdr-pair) + (word (cxr-name-help fn (cons arg arg)) 'd)) + (else "")))) ; empty word if result is magic-argument diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week12 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week12 new file mode 100644 index 0000000..7b8c5a3 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week12 @@ -0,0 +1,1008 @@ +CS 61A Week 12 solutions + +LAB EXERCISES +============= + +3. Why doesn't make-procedure call eval? + +Because none of the arguments to lambda should be evaluated. +In particular, the expressions that make up the body of the procedure are +not evaluated until the procedure is *invoked*! + + +4.1, left-to-right + +(define (list-of-values exps env) ;; left to right + (if (no-operands? exps) + '() + (let ((left (eval (first-operand exps) env))) + (cons left (list-of-values (rest-operands exps) env))))) + +(define (list-of-values exps env) ;; right + (if (no-operands? exps) + '() + (let ((right (list-of-values (rest-operands exps) env))) + (cons (eval (first-operand exps) env) right)))) + + +4.2, Louis reordering + +(a) The trouble is that APPLICATION? cheats. The book has + +(define (application? exp) (pair? exp)) + +It really should be something like + +(define (application? exp) + (and (pair? exp) + (not (member (car exp) '(quote set! define if lambda begin cond))))) + +They get away with the shorter version precisely because EVAL doesn't +call APPLICATION? until after it's checked for all the possible special +forms. Louis (quite reasonably, I think) wants to rely on APPLICATION? +behaving correctly no matter when it's called. + +(b) All we are changing is the syntax of an application, so we +change the procedures that define the "application" abstract data type. +These are on page 372 of the text. The new versions are: + +(define (application? exp) + (tagged-list? exp 'call)) + +(define (operator exp) (cadr exp)) + +(define (operands exp) (cddr exp)) + + +4.4 AND and OR special forms + +The book suggests two solutions: make them primitive special forms +or make them derived expressions. We'll do both. + +As primitive special forms: + +Change the COND clause in EVAL by adding + + (cond ... + ((and? exp) (eval-and exp env)) + ((or? exp) (eval-or exp env)) + ...) + +(define (eval-and exp env) + (define (iter tests) + (cond ((null? tests) #t) + ((null? (cdr tests)) (eval (car tests) env)) + ((true? (eval (car tests) env)) (iter (cdr tests))) + (else #f))) + (iter (cdr exp))) + +(define (eval-or exp env) + (define (iter tests) + (if (null? tests) + #f + (let ((result (eval (car tests) env))) + (if (true? result) + result + (iter (cdr tests)))))) + (iter (cdr exp))) + +Now for the derived expression technique. Modify the COND clause +in EVAL this way instead: + + (cond ... + ((and? exp) (eval (and->if (cdr exp)) env)) + ((or? exp) (eval (or->if (cdr exp)) env)) + ...) + +(define (and->if exps) + (cond ((null? exps) #t) + ((null? (cdr exps)) (car exps)) + (else (make-if (car exps) + (and->if (cdr exps)) + #f)))) + +(define (or->if exps) + (if (null? exps) + #f + (make-if (car exps) + (car exps) + (or->if (cdr exps))))) + +This version is elegant but has the disadvantage that you end up +computing the first true value twice. + + +4.5 Cond => notation + +(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 "...")) + (IF (COND-ARROW-CLAUSE? FIRST) + (LIST (MAKE-LAMBDA '(COND-FOO) + (MAKE-IF 'COND-FOO + (LIST (COND-ARROW-DOER FIRST) + 'COND-FOO) + (EXPAND-CLAUSES REST))) + (COND-PREDICATE FIRST)) + (make-if (cond-predicate first) + (sequence->exp (cond-actions first)) + (expand-clauses rest))))))) + +(define (cond-arrow-clause? clause) + (and (pair? clause) + (= (length clause) 3) + (eq? (cadr clause) '=>))) + +(define (cond-arrow-doer clause) + (caddr clause)) + +This may be a little confusing. What it does is to turn a clause like + + (test => recipient) + +into + + ((lambda (cond-foo) + (if cond-foo + (recipient cond-foo) + <expanded-rest-of-clauses>)) + test) + +Using the name cond-foo here is a kludge, because what if the user +has used the same name for some other purpose within the clause? +The right thing would be to generate an otherwise-untypable symbol +each time. But this is complicated enough already. + +By the way, this is really trying to do + + (let ((cond-foo test)) + (if ...)) + +but we don't yet have LET in the metacircular Scheme. + +It might be easier to do this by abandoning the whole idea of +cond->if and just implementing cond directly. + + +5b. In Logo there are no internal definitions; all procedures are global. +So we need a situation with two procedures, one of which calls the other: + +to outer :var +inner +end + +to inner +print :var +end + +? outer 23 +23 + +To see that this result is different from what would happen with lexical +scope, try the same example in Scheme: + +(define (outer var) + (inner)) + +(define (inner) + (print var)) + +> (outer 23) +Error -- unbound variable: var + +(Or you could define a global variable var whose value is something other +than 23, and then (outer 23) would print that other value. + + +5c. + +Logo " is like Scheme ' -- it's the quoting symbol. But in Logo it is used +only with words, not with lists, and there is no QUOTE special form which the +quotation character abbreviates. + +Logo [ ] are like '( ) in Scheme -- the brackets both delimit and quote a +list. But within a list, brackets are used to delimit sublists, and don't +imply an extra level of quotation, so Logo [a [b c] d] means '(a (b c) d), +not '(a '(b c) d). So, how do you get the effect of Scheme's ( ) without +quotation? In Scheme that means to call a procedure; in Logo you don't +need any punctuation to call a procedure! You just give the procedure name +and its arguments. But in Logo you *can* use parentheses around a procedure +call just as you would in Scheme. + +Logo : means that you want the value of the variable whose name follows the +colon. In Scheme the name by itself means this -- if you want the value of +variable X, you just say X. The reason this doesn't work in Logo is that +in Logo procedures aren't just another data type, and a procedure name isn't +just the name of a variable whose value happens to be a procedure. (In other +words, Logo procedures are not first-class.) In Logo there can be a procedure +and a variable with the same name, so FOO means the procedure and :FOO means +the variable. + + +HOMEWORK +======== + +4.3 data-directed eval + +The table itself could be done in several ways; perhaps the easiest +is to use the built-in table from chapter 2. So we say: + +(put 'quote 'eval text-of-quotation) +(put 'define 'eval eval-definition) +(put 'set! 'eval eval-assignment) + +Where the original eval does something other than (foo exp env) we +have to write an interface procedure. For example: + +(define (eval-lambda exp env) + (make-procedure (lambda-parameters exp) (lambda-body exp) env)) + +(put 'lambda 'eval eval-lambda) + + +(define (eval exp env) + (cond ((self-evaluating? exp) exp) + ((variable? exp) (lookup-variable-value exp env)) + (else (let ((form (get (operator exp) 'eval))) + (if form ;; IT'S A SPECIAL FORM + (form exp env) ;; SO form IS THE PROCEDURE TO CALL + (apply (eval (operator exp) env) + (list-of-values (operands exp) env) )))))) + +The first two COND clauses deal with atomic expressions: numbers (which +are self-evaluating) and symbols (which represent variables). If the +expression is neither of those, then it's a list, and we look at its +CAR. We look that up in the table; if we find it, the expression is a +special form, and we invoke the particular procedure that knows about +that special form. Otherwise, it's a regular procedure. +We're neglecting various kinds of errors that might occur with mal-formed +input. + +We also have to rewrite text-of-quotation so that it accepts an extra +input, the environment, even though it doesn't need it: + +(define (text-of-quotation exp env) + (cadr exp)) + +And we have to write a new "front end" to cond->if: + +(define (eval-cond exp env) + (eval (cond->if exp) env)) + +and put that in the table. + +It would also be possible to include the atomic expressions in the +general data-directed mechanism by assigning them implicit types just as +we assigned Scheme numbers an implicit type in exercise 2.78, page 193: + +(define (expression-type exp) + (cond ((self-evaluating? exp) '(() SELF-EVALUATING)) + ((symbol? exp) '(() SYMBOL)) + ((pair? exp) (car exp)) + (else (error "Unknown expression type" exp)))) + +(define (eval exp env) + (let ((handler (get (expression-type exp) 'eval))) + (if handler + (handler exp env) + (apply (eval (operator exp) env) + (list-of-values (operands exp) env))))) + +(put '(() self-evaluating) 'eval (lambda (exp env) exp)) +(put '(() symbol) 'eval lookup-variable-value) + +The reason for using (() SYMBOL) instead of just SYMBOL as the type tag +is that otherwise we'd get in trouble if an expression tried to call a +procedure named SYMBOL. These type tags aren't valid Scheme expressions, +so they shouldn't get us in trouble. + + +4.6 Implementing LET + +;; In eval's big cond we put + + ((let? exp) (eval (let->combination exp) env)) + +;; Now for the guts of the problem: + +(define (let->combination exp) + (cons (make-lambda (let-formals exp) + (let-body exp)) + (let-actuals exp))) + +;; And now for the data abstraction stuff: + +(define (let? exp) + (tagged-list? exp 'let)) + +(define (let-formals exp) + (map car (cadr exp))) + +(define (let-actuals exp) + (map cadr (cadr exp))) + +(define (let-body exp) + (cddr exp)) + + +Please note that this problem becomes MUCH easier if you ruthlessly separate +the semantics (let->combination) from the mickey mouse work of extracting +the syntactic components. I actually wrote this in the order in which it +appears here; in essence I solved the problem completely before I thought at +all about syntactic issues. + + +4.7 Implementing Let* + +(define (let*->nested-lets exp) + (if (null? (let-bindings exp)) + (make-let '() (let-body exp)) + (make-let (list (car (let-bindings exp))) + (list (make-let* (cdr (let-bindings exp)) + (let-body exp)))))) + +(define (let-bindings exp) + (cadr exp)) + +(define (make-let bindings body) + (cons 'let (cons bindings body))) + +(define (make-let* bindings body) + (cons 'let* (cons bindings body))) + +I'm cheating slightly by using LET-BODY for a LET* expression instead +of inventing a whole new abstract data type. In principle someone +might want to change Scheme so that the syntax of LET* looks different +from the syntax of LET. + + +4.10 new syntax + +Okay, let's make the syntax of IF look like it does in those other bad +languages. (After all, any change we make to Scheme's syntax *has* to make +it worse!) The new syntax will be (if ... then ... else ...). + +(define (if? exp) + (and (tagged-list? exp 'if) + (eq? (caddr exp) 'then) + (or (= (length exp) 4) + (eq? (list-ref exp 4) 'else)))) + +(define (if-predicate exp) (cadr exp)) + +(define (if-consequent exp) (cadddr exp)) + +(define (if-alternative exp) (list-ref exp 5)) + +Of course you can do lots of other changes too, so if you're copying +last semester's answers next semester, the reader will be suspicious +if you come up with this choice! :-) + + +4.11 changed frame representation + +(define (make-frame variables values) + (attach-tag 'frame (map cons variables values))) + +(define (frame-variables frame) + (map car (contents frame))) + +(define (frame-values frame) + (map cdr (contents frame))) + +(define (add-binding-to-frame! var val frame) + (set-cdr! frame (cons (cons var val) (contents frame)))) + +As explained in footnote 14 on page 378, the procedures lookup-variable-value, +set-variable-value!, and define-variable! aren't just above-the-line users of +the frame ADT, because the latter two use SET-CAR! to modify frames. +Lookup-variable-value could actually work exactly as written, but the others +have to be changed, and that one should also be changed, to use ASSOC in +their SCAN internal procedures. Basically these will look like the table +procedures from chapter 3: + +(define (lookup-variable-value var env) + (define (env-loop env) + (DEFINE (SCAN ALIST) + (LET ((RESULT (ASSOC VAR ALIST))) + (IF RESULT + (CDR RESULT) + (ENV-LOOP (ENCLOSING-ENVIRONMENT ENV))))) + (if (eq? env the-empty-environment) + (error "Unbound variable" var) + (let ((frame (first-frame env))) + (SCAN (CONTENTS FRAME))))) + (env-loop env)) + +(define (set-variable-value! var val env) + (define (env-loop env) + (DEFINE (SCAN ALIST) + (LET ((RESULT (ASSOC VAR ALIST))) + (IF RESULT + (SET-CDR! RESULT VAL) + (ENV-LOOP (ENCLOSING-ENVIRONMENT ENV))))) + (if (eq? env the-empty-environment) + (error "Unbound variable -- SET!" var) + (let ((frame (first-frame env))) + (SCAN (CONTENTS FRAME))))) + (env-loop env)) + +(define (define-variable! var val env) + (let ((frame (first-frame env))) + (DEFINE (SCAN ALIST) + (LET ((RESULT (ASSOC VAR ALIST))) + (IF RESULT + (SET-CDR! RESULT VAL) + (ADD-BINDING-TO-FRAME! VAR VAL FRAME)))) + (SCAN (CONTENTS FRAME)))) + +If I hadn't attached a tag to the frames, this would be harder. +I wouldn't be able to have an add-binding-to-frame! procedure +because there wouldn't be anything in an empty frame to mutate. +Instead, define-variable! would have to get more complicated. + + +4.13 make-unbound + +First, about the design issues: I see three possibilities. You can +require that the symbol be bound in the current environment and remove +that binding only; you can remove the nearest single binding; or you can +remove all bindings of that symbol. Perhaps the best solution in any case +where it's not obvious what the right semantics is would be to provide +all three versions: unbind-this-frame, unbind-nearest, and unbind-all. +That way the user can decide for herself what best suits the application +at hand. Failing that, I vote for the second choice: removing the nearest +binding. Here's why. First of all, the third version can be written in +terms of the second: + +(define (unbind-all sym) + (cond ((bound? sym) + (unbind-nearest sym) + (unbind-all sym)) + (else '()))) + +(This assumes we have a predicate bound? that returns true if there is +an accesible binding for the symbol. If we provide any form of unbinding +we should probably provide that too.) But the second can't be written in +terms of the third. So if we're only having one we should have the more +flexible one. I rule out the first (current frame only) because I can +easily imagine wanting to write a procedure like + +(define (cleanup) + (make-unbound 'a) + (make-unbound 'b) + (make-unbound 'c)) + +that removes global variables at the end of a computation, but this +wouldn't be possible under the first option. (Why not?) + +I have also implicitly decided another design question: should this be +a special form that requires an unevaluated symbol, like set!, or should +it be an ordinary procedure whose actual parameter is evaluated? In +order to make things like unbind-all (above) work, it should be an ordinary +procedure. (What I want to get unbound is the actual argument to +unbind-all, not the symbol "sym" itself.) Then again, I think set! should +be an ordinary procedure, too, so perhaps you're asking the wrong person. + +Trouble is, we can't REALLY make make-unbound an ordinary procedure +because it has to have access to the environment. If Scheme were +dynamically scoped, any procedure in the evaluator could just make a +free reference to "env" to get the current user environment, but as it +is we have to have eval treat make-unbound specially. So we'll make +it a special form but still have it evaluate everything. + +(define (eval-make-unbound exp env) + (define (unbind-in-frame sym frame) + (define (remove-not-first-binding vars vals) + (if (eq? sym (cadr vars)) + (begin (set-cdr! vars (cddr vars)) + (set-cdr! vals (cddr vals))) + (remove-not-first-binding (cdr vars) (cdr vals)))) + (if (eq? sym (car (frame-variables frame))) + (begin (set-car! frame (cdr (frame-variables frame))) + (set-cdr! frame (cdr (frame-values frame)))) + (remove-not-first-binding (frame-variables frame) + (frame-values frame)))) + (define (env-iter sym env) + (cond ((eq? env the-empty-environment) 'okay) + ((memq sym (frame-variables (first-frame env))) + (unbind-in-frame sym (first-frame env))) + (else (env-iter sym (enclosing-environment env))))) + (env-iter (eval (cadr exp) env) env)) + +This is rather messier than one might wish, because if the binding in +question is the first one in a frame, we have to remove it differently from +if it's not the first in a frame. In the first case we mutate the header +pair of the frame; in the second case we splice elements out of two lists. +Had this evaluator been written with unbinding in mind, they might have +picked a different data structure. Env-iter looks for the first frame in +which the symbol is bound, then unbinds it in that frame. Unbind-in-frame +first checks the first binding specially, then uses remove-not-first-binding +to check the other bindings. + +Strictly speaking, I should have made mutators for the frame +abstraction. The obvious choice would be set-frame-variables! and +set-frame-values!, but actually that only makes sense if we know that +the frame is represented as two parallel lists. If the frame is +represented as an a-list, as in exercise 4.11, then a better choice +would be set-frame-bindings!. So the really right thing, to keep +the abstraction barrier solid, is to have a mutator frame-remove-binding! +that would be like the unbind-in-frame part of the code above. It would +be different for different representations, but would have the same +effect above the abstraction barrier. + +Finally, we have to modify eval, adding + + ((make-unbound? exp) (eval-make-unbound exp env)) + +to the big cond. + +(define (make-unbound? exp) + (tagged-list? exp 'make-unbound)) + + + +4.14 why doesn't map work? + +This question is about level confusion. Let's talk about meta-Scheme, +the one implemented by the metacircular evaluator, and under-Scheme, the +regular Scheme in which the MCE is written. + +Eva defines MAP in meta-Scheme. In particular, when MAP tries to invoke +a meta-Scheme procedure for each element of the list, it's doing a +meta-Scheme invocation. + +Louis uses the MAP that's defined in under-Scheme. When he calls MAP, +he is giving it a meta-Scheme procedure as its first argument, but it's +expecting an under-Scheme procedure. From the point of view of under-Scheme, +a meta-Scheme procedure isn't a procedure at all -- it's a list whose car +is the word PROCEDURE. + + +4.15 the halting problem + +This is the most famous problem in automata theory, the most elegant proof that +some things can't be done no matter how sophisticated our computers become. +The proof was first given using the "Turing machine," an abstract machine +that's used only for proving theorems. But the same idea works in any +formal system that's capable of representing a procedure as data; the key +element of the proof is the fact that the hypothetical HALTS? is a +higher-order function. + +Suppose that (HALTS? TRY TRY) returns #T. Then when we call (TRY TRY) +it says, after argument substitution, + + (if (halts? try try) + (run-forever) + 'halted) + +But this will run forever, and so (TRY TRY) runs forever, and so +(HALTS? TRY TRY) should have returned #F. + +Similarly, suppose that (HALTS? TRY TRY) returns #F. Then (TRY TRY) +turns into the same IF expression shown above, but this time the +value of that expression is the word HALTED -- that is, it halts. +So (HALTS? TRY TRY) should have returned #T. + + +4.22 LET in analyzing evaluator + +This is easy, given the hint about 4.6. We don't have to change the +procedure LET->COMBINATION we wrote for that exercise; since it deals +entirely with the expression, and not with the values of variables, +all of its work can be done in the analysis phase. All we do is +change this COND clause in EVAL: + + ((let? exp) (eval (let->combination exp) env)) + +to this COND clause in ANALYZE: + + ((let? exp) (analyze (let->combination exp))) + + +4.23 Efficiency of analyze-sequence + +For a sequence with just one expression, the book's version does the +following analysis: First, the body of analyze-sequence is the LET. +Suppose that the result of analyzing the one expression is PROC. +Then the variable PROCS will have as its value a list whose only +element is PROC. That's not null, so (still in the analysis part) +we call (LOOP PROC '()). In LOOP, since (in this case) REST-PROCS +is null, LOOP just returns PROC. So if the analysis of EXP gives +PROC, then the analysis of (BEGIN EXP) also gives PROC. + +In the same one-expression case, Alyssa's version returns + (lambda (env) (execute-sequence (list PROC) env)) +So every time this execution procedure is called, execute-sequence +will check that (cdr procs) is empty, which it is, and then +calls PROC with the environment as its argument. This test of +(null? (cdr procs)) is done for every execution, whereas in the +book's version it was done just once. + +How about the two-expression case. Suppose that the analysis of +EXP1 gives PROC1, and the anaylsis of EXP2 gives PROC2. The book's +version will call, in effect, (loop PROC1 (list PROC2)). This +in turn calls (sequentially PROC1 PROC2), which returns + (lambda (env) (PROC1 env) (PROC2 env)) +as the execution procedure. (There is a recursive call to LOOP, +but it doesn't change the result, because this time the second +argument is null.) + +Alyssa's version makes the execution procedure be + (lambda (env) (execute-sequence (list PROC1 PROC2) env))) +which in effect means + (lambda (env) + (cond ((null? (list PROC2)) ...) + (else (PROC1 env) + (cond ((null? '()) (PROC2 env)) ...)))) +Each time this is executed, we do two unnecessary checks for +the nullness of a list -- unnecessary because we already knew +while doing the analysis how many expressions are in the sequence. + + +4.24 How fast? + +Hint: You'll get the most dramatic results when an expression +is evaluated over and over, i.e., with a recursive procedure. + + + +2. Type checking + +When we define a procedure, we don't even look at the parameter +list; it's just stored as part of the procedure. That doesn't +need to be changed. When do we have to check the type? We do it +when we're invoking a procedure, as part of the process of +binding names to values. This happens in extend-environment +and make-frame. The only change to extend-environment is that it +has to supply the environment that we're extending to make-frame, +because make-frame will have to look up the type predicates: + +(define (extend-environment vars vals base-env) + (if (= (length vars) (length vals)) + (cons (make-frame vars vals BASE-ENV) base-env) + (if (< (length vars) (length vals)) + (error "Too many arguments supplied" vars vals) + (error "Too few arguments supplied" vars vals)))) + +Make-frame, which was trivial before this change, now has some +real work to do: + +(define (make-frame variables values BASE-ENV) + (DEFINE (TYPE-CHECK VAR VAL) + (IF (AND (PAIR? VAR) + (NOT (APPLY (EVAL (CAR VAR) BASE-ENV) + (LIST VAL)))) + (ERROR "WRONG ARGUMENT TYPE" VAL))) + (DEFINE (SCAN VARS VALS) + (COND ((NULL? VARS) #T) + (ELSE (TYPE-CHECK (CAR VARS) (CAR VALS)) + (SCAN (CDR VARS) (CDR VALS))))) + (SCAN VARIABLES VALUES) + (cons (JUST-NAMES variables) values)) + +(DEFINE (JUST-NAMES VARS) + (COND ((NULL? VARS) '()) + ((PAIR? (CAR VARS)) + (CONS (CADAR VARS) (JUST-NAMES (CDR VARS)))) + (ELSE (CONS (CAR VARS) (JUST-NAMES (CDR VARS)))))) + +Another approach would be to try to modify the procedure as it's being +created (therefore, in make-procedure, called from eval) so that the type +checks become part of the procedure's body. This can be done, but it's +quite tricky to get it right. For example, in what environment should the +names of the type predicates be looked up? + +It's a real misunderstanding of the problem to write a solution in which +specific type predicates such as INTEGER? are built into the evaluator. +If there's a type checking system, it should work for user-defined types +as well as for primitive types. For example, I should be able to say +that an argument must be a prime number, or must be a three-letter word. + + + +Extra for Experts +================= + +4.16 + +(a) + +(define (lookup-variable-value var env) + (define (env-loop env) + (define (scan vars vals) + (cond ((null? vars) + (env-loop (enclosing-environment env))) + ((eq? var (car vars)) + (LET ((RESULT (car vals))) ;; *** + (IF (EQ? RESULT '*UNASSIGNED*) ;; *** + (ERROR "UNBOUND VARIABLE" (CAR VARS)) ;; *** + RESULT))) ;; *** + (else (scan (cdr vars) (cdr vals))))) + (if (eq? env the-empty-environment) + (error "Unbound variable" var) + (let ((frame (first-frame env))) + (scan (frame-variables frame) + (frame-values frame))))) + (env-loop env)) + + +(b) + +(define (scan-out-defines body) + (cond ((null? body) '()) + ((definition? (car body)) + (list ; body is a list of expressions, we make one-element list + (cons 'let + (cons (make-let-variables (definitions body)) + (append (make-setbangs (definitions body)) + (non-definitions body)))))) + (else body))) + +(define (definitions body) + (cond ((null? body) '()) + ((definition? (car body)) + (cons (car body) (definitions (cdr body)))) + (else '()))) + +(define (non-definitions body) + (cond ((null? body) '()) + ((definition? (car body)) + (non-definitions (cdr body))) + (else body))) + +(define (make-let-variables definitions) + (map (lambda (def) + (list (definition-variable def) '(quote *unassigned*))) + definitions)) + +(define (make-setbangs definitions) + (map (lambda (def) + (list 'set! (definition-variable def) (definition-value def))) + definitions)) + + +(c) It should be in make-procedure, because then the scanning is done only +once, when the procedure is created, rather than every time the procedure +is called. (On the other hand, if Scheme printed procedures in a way that +showed the body, the user might wonder why the body isn't what s/he wrote.) + +(define (make-procedure parameters body env) + (list 'procedure parameters (scan-out-defines body) env)) + + +4.17 + +The extra frame is created by the LET we introduced into the procedure body. +The frame itself would matter only if some expressions were evaluated in the +outer frame rather than the inner one. But there are no such expressions, +except for the (QUOTE *UNASSIGNED*) ones we put in the LET, and those don't +depend on the environment for their values. + +We could do it without the extra frame by scanning + +(lambda (args...) + (define u e1) + (define v e2) + ...) + +into + +(lambda (args) + (define u '*unassigned*) + (define v '*unassigned*) + (set! u e1) + (set! v e2) + ...) + +and continuing to use the sequential version of internal DEFINE already in the +metacircular evaluator. (This may seem to have no benefit at all, but it does, +because the local variables U and V are bound before the expressions E1 and E2 +are evaluated, so we can be sure they won't refer to global variables.) + + +4.18 + +You can't actually experiment with this question unless you define DELAY +and CONS-STREAM as special forms in the metacircular evaluator. + +The SOLVE procedure would work using the scan-out approach of 4.16, but not +using the version proposed in this exercise. The body of SOLVE would be + + (let ((y '*unassigned*) (dy '*unassigned*)) + (let ((gensym1 (integral (delay dy) y0 dt)) + (GENSYM2 (STREAM-MAP F Y))) + (set! y gensym1) + (set! dy gensym2) + y) + +In the line in capital letters, stream-map is an ordinary procedure, so its +argument expressions are evaluated before stream-map is called. One of the +arguments is Y, whose value at this point is *unassigned*, so an error will +result. This is consistent with the definition of LETREC in the Scheme +standard. (Internal DEFINE is defined by the standard to be equivalent to +LETREC. See page 16 of the standard, in the course reader, section 5.5.2. +Then see pages 11-12 for the discussion of LETREC, especially the last +paragraph of that section.) + + +4.19 + +This is answered in the footnote: the authors support Alyssa. + +One possible way to get what Eva wants is to use the approach of exercise +4.16, but instead of giving an error if one of the SET! expressions fails, +move it to the end of the line, so you keep trying until every variable has a +value or until no further progress can be made. So in this example it'd be + + (let ((b '*unassigned*) (a '*unassigned*)) + (set!-ignoring-errors b (+ a x)) + (set!-ignoring-errors a 5) + (if (unassigned? b) (set! b (+ a x))) + (if (unassigned? a) (set! a 5)) + (+ a b)) + +using pseudo-special-forms SET!-IGNORING-ERRORS and UNASSIGNED? that aren't +defined but whose meanings should be obvious. You'd have to repeat the IF +expressions as many times as you have variables, to be sure that any +dependency order would work. + +Even so, an expression such as + + (define (f x) + (define a (+ b 3)) + (define b (+ a 4)) + (+ a b)) + +won't work no matter how many times you try the assignments. + + +4.20 + +(a) + +(define (letrec? exp) + (tagged-list? exp 'letrec)) + +(define (letrec->let exp) + (cons 'let + (cons (map (lambda (var) (list var '(quote *unassigned*))) + (let-formals exp)) + (append (map (lambda (var val) (list 'set! var val)) + (let-formals exp) + (let-actuals exp)) + (let-body exp))))) + +Then add a cond clause to EVAL: + + ((letrec? exp) (eval (letrec->let exp) env)) + + +(b) In the correct version, after transforming the LETREC as on page 389, +we have + +(define (f x) + (let ((even? '*unassigned*) (odd? '*unassigned*)) + (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>)) + +Evaluating that gives + + global env: F -> procedure P1 + + procedure P1: params (x), body (let ...), global env + +When evaluating (F 5), we add + + E1: X -> 5, extends G + +The LET expands to a LAMBDA and an invocation: + + procedure P2: params (even? odd?), body (set! ...)..., env E1 + + E2: EVEN? -> *unassigned*, ODD? -> *unassigned*, extends E1 + +With E2 as the current environment we evaluate the two SET! expressions, +which create procedures (because of the LAMBDA expressions inside them) and +change the bindings in E2: + + procedure P3: params (n), body (if (= n 0) true (odd? ...)), env E2 + procedure P4: params (n), body (if (= n 0) false (even? ...)), env E2 + + E2: EVEN? -> procedure P3, ODD? -> procedure P4, extends E1 + +Note that P3 and P4 are created in E2, so they have access to the bindings +for EVEN? and ODD?. + +Then we evaluate the remaining expression in the body of F, which can use +EVEN? and ODD? successfully. + +By contrast, Louis wants us to evaluate + +(define (f x) + (let ((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>)) + +This time, when evaluating (F 5), we still add + + E1: X -> 5, extends G + +The LET expands to a LAMBDA and an invocation with procedures as arguments: + + ((lambda (even? odd?) <rest of body>) + (lambda (n) (if (= n 0) true (odd? (- n 1)))) + (lambda (n) (if (= n 0) false (even? (- n 1))))) + +The three LAMBDA expressions give us + + procedure P2: params (even? odd?), body <rest of body>, env E1 + procedure P3: params (n), body (if (= n 0) true (odd? ...)), env E1 + procedure P4: params (n), body (if (= n 0) false (even? ...)), env E1 + +We can then invoke P2 with P3 and P4 as its arguments: + + E2: EVEN? -> procedure P3, ODD? -> procedure P4, extends E1 + +In this environment we evaluate <rest of body>. Suppose it's a simple +expression: (EVEN? X). First we evaluate the subexpressions. In E2 we +find the binding EVEN? -> P3. There's no binding for X in frame E2, but +it extends E1, where we find X -> 5. Now we invoke P3 by making a new +environment: + + E3: N -> 5, extends E1 + +Note that E3 extends E1, not E2, because E1 is where P3 was created. + +With E3 as the current environment we evaluate the body of P3, which is + + (if (= n 0) true (odd? (- n 1))) + +We easily evaluate (= N 0) and get the answer #F. We then try to evaluate + + (odd? (- n 1)) + +But there is no binding for ODD? in E3, including the frames it extends. +That's why LET instead of LETREC isn't sufficient. + + +4.21 + +We've actually seen this idea before, in the Extra for Experts in week 2. + +(a) FIB without DEFINE/LETREC + +((lambda (n) + ((lambda (fib) (fib fib n)) + (lambda (fb k) + (if (< k 2) + k + (+ (fb fb (- k 1)) + (fb fb (- k 2))))))) + 10) + + +(b) EVEN?/ODD? ditto + +(define (f x) + ((lambda (even? odd?) + (even? even? odd? x)) + (lambda (ev? od? n) ; This is EVEN? + (if (= n 0) true (OD? EV? OD? (- N 1)))) + (lambda (ev? od? n) ; This is ODD? + (if (= n 0) false (EV? EV? OD? (- N 1)))))) diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week14 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week14 new file mode 100644 index 0000000..53486bd --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week14 @@ -0,0 +1,1404 @@ +CS61A Week 11 solutions + +LAB: +---- + +4.27 Lazy vs. mutation + +The first time you type COUNT you get 1; the second time you get 2. +Why? When you say + (define w (id (id 10))) +the DEFINE special form handler eval-definition EVALs its second +argument (id (id 10)). Given an application, EVAL calls APPLY +to invoke ID for the outer invocation, but the inner invocation +is providing an argument to a compound procedure, so it's delayed. +That's why COUNT is 1 -- the outer call to ID has actually happened, +but not the inner one. + +The value of W is therefore a promise to compute (id 10), since +ID returns its argument. When you ask the evaluator to print W, +that promise is fulfilled, and so COUNT becomes 2. + + +4.29 Memoizing or not + +You'd expect a program that uses the same argument repeatedly to +be most strongly affected. For example, I wrote + +(define (n-copies n stuff) + (if (= n 0) + '() + (cons stuff (n-copies (- n 1) stuff)))) + +Then if you use n-copies with something requiring a fair amount +of computation, such as + +(n-copies 6 (factorial 7)) + +you can see a dramatic difference. + +About their square/id example, remember to (set! count 0) before +each experiment. Then the memoizing version leaves count at 1, +whereas the non-memoizing version sets count to 2. + + + +4.35 an-integer-between + +(define (an-integer-between low high) + (if (> low high) + (amb) + (amb low (an-integer-between (+ low 1) high)))) + + +4.38 adjacent floors + +Remove the line (require (not (= (abs (- smith fletcher)) 1))) + + +[The continuation part of the lab was just try-this.] + + + +HOMEWORK: +--------- + + +4.25 UNLESS in normal vs. applicative order + +In ordinary (applicative order) Scheme, this version of FACTORIAL +will be an infinite loop, because the argument subexpression +(* n (factorial (- n 1))) is evaluated before UNLESS is called, +whether or not n is 1. + +In normal order Scheme it'll work fine, because the argument +subexpressions aren't evaluated until they're needed. What +will actually happen is that each use of the special form IF +within UNLESS will force the computation of (= n 1), but +no multiplications will happen until the evaluator tries to +print the result. In effect, (factorial 5) returns the thunk + (lambda () (* 5 (* 4 (* 3 (* 2 (* 1 1)))))) +and that gets evaluated just in time to print the answer. + + +4.26 Normal order vs. special forms + +For Ben's side of the argument we must implement UNLESS as a +derived expression: + +(define (unless->if exp) + (make-if (unless-predicate exp) + (unless-consequent exp) + (unless-alternative exp))) + +(define unless-predicate cadr) +(define unless-alternative caddr) +(define unless-consequent cadddr) + +Notice that we reversed the order of the last two subexpressions in +the call to make-if. + +Then we just add a clause + ((unless? exp) (eval (unless->if exp) env)) +to the ordinary metacircular evaluator, or + ((unless? exp) (analyze (unless->if exp))) +to the analyzing evaluator. + +For Alyssa's side of the argument, we need a case in which it's useful to +have a Scheme special form available as an ordinary procedure. The only +thing we can do with ordinary procedures but not with special forms is use +them as arguments to higher-order procedures. An example using UNLESS will +be a little strained, so first we'll look at a more common situation +involving a different special form, namely AND. We'd like to be able to say + +(define (all-true? tf-list) + (accumulate and tf-list)) + +Now, here's the strained example using UNLESS: Suppose we have a list of +true-false values and we'd like to add up the number of true ones. Here's a +somewhat strange way to do it: + +(define zero-list (cons 0 '())) +(set-cdr! zero-list zero-list) + +(define one-list (cons 1 '())) +(set-cdr! one-list one-list) + +(define (howmany-true tf-list) + (apply + (map unless tf-list zero-list one-list))) + +Zero-list is an infinite list of zeros; one-list is an infinite list +of ones. We make use of the fact that MAP's end test is that its +first argument is empty, so MAP will return a list the same size as +the argument tf-list. For example, if tf-list is + (#t #t #f #t) +then map will return + (1 1 0 1) +created, in effect, this way: + (list (unless #t 0 1) + (unless #t 0 1) + (unless #f 0 1) + (unless #t 0 1)) +And so + will return 3, the number of trues in the list. + + +4.28 Why force the operator of a combination? + +Thunks are made by APPLY, representing arguments to defined procedures. +So we need a case in which the operator of an expression is the returned +argument of a defined procedure. Here's an example: + +(((lambda (a b) a) + -) 2 3) + + +4.30 Side effects vs. lazy evaluation + +(a) Why is Ben right about for-each? + +For-each includes the expression (proc (car items)). As we +discussed in ex. 4.28, the lazy evaluator will force the +operator of that expression, i.e., PROC. The resulting +procedure has two invocations of primitives, NEWLINE and +DISPLAY. Evaluating those invocations will actually call +the procedures, and the argument X to DISPLAY will be +evaluated because DISPLAY is primitive. + +(b) What happens in Cy's example? + +First of all, in ordinary Scheme both (p1 1) and (p2 1) give +the result (1 2). + +With the book's version of eval-sequence, (p1 1) is still (1 2) +but (p2 1) is 1, because the SET! will never happen. The +subprocedure P has a two-expression sequence as its body, and +the first expression will never be evaluated. + +With Cy's version both (p1 1) and (p2 1) are (1 2), as in +ordinary Scheme. + +(c) Why doesn't Cy's version change part (a)? + +The change isn't as dramatic as it may seem. Don't think that +the original eval-sequence calls delay-it! It calls EVAL, and +most of the time EVAL does return a value, not a thunk. In +particular, a procedure call is carried out right away; it's +only the *arguments* to the procedure that are delayed. That's +why Cy had to use a weird example in which a SET! expression +is used as an argument to a procedure in order to get the wrong +result. + +(d) What's the right thing to do? + +The combination of lazy evaluation and mutation in the same language +is so confusing that programmers would be surprised no matter which +choice we made. That's why, in the real world, the languages that +use normal order evaluation are *functional* languages in which +there is no mutation or other side effects. In such a language, +there are no sequences (if there are no side effects, what would +be the point?) and the problem doesn't arise. + +But if we really wanted to have a normal-order Scheme, we'd +probably want to change the semantics of the language as little +as possible -- programs that work in ordinary Scheme should work +in lazy Scheme too. So I think Cy is right. + + +4.32 Lazy trees + +One possibility is to use doubly-lazy lists as an alternative to +interleaving, when dealing with a naturally two-dimensional problem. +For example, to get pairs of integers, we could say + +(define (pairs a b) + (cons (map (lambda (x) (cons (car a) x)) b) + (pairs (cdr a) b))) + +Then we could use this data structure with two-dimensional versions +of the usual higher order procedures. For example: + +(define (2dfilter pred s) + (if (null? s) + '() + (cons (filter pred (car s)) + (2dfilter pred (cdr s))))) + + +4.33 Quoted lazy lists + +Instead of + ((quoted? exp) (text-of-quotation exp)) +we need a more complicated treatment to turn the ordinary lists +of the underlying Scheme into lazy lists. + + ((quoted? exp) (process-quotation (text-of-quotation exp) env)) + +(define (process-quotation quoted env) + (if (pair? quoted) + (lazy-cons (process-quotation (car quoted) env) + (process-quotation (cdr quoted) env) + env) + quoted)) + +(define (lazy-cons x y env) + (make-procedure '(m) (list (list 'm x y)) env)) + +or alternatively + +(define (lazy-cons x y env) + (apply (lookup-variable-value 'cons env) + (list x y))) + +This lazy-cons is the below-the-line equivalent of the above-the-line +CONS on page 409. + + + +4.36 all Pythagorean triples + +Replacing an-integer-between with an-integer-starting-from won't +work because the AMB that provides the value for K will never fail, +and so I and J will always be 1 forever. + +To make this work, we note that K must always be larger than I or J, +so I and J can be restricted to finite ranges if we choose a value +for K first: + +(define (a-pythgorean-triple) + (let ((k (an-integer-starting-from 1))) + (let ((i (an-integer-between 1 (- k 1)))) + (let ((j (an-integer-between i (- k 1)))) + (require (= (+ (* i i) (* j j)) (* k k))) + (list i j k))))) + + +4.42 liars + +(define (liars) + (define (onetrue? x y) + (if x (if y #f #t) y)) + (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 (distinct? (list betty ethel joan kitty mary))) + (require (onetrue? (= kitty 2) (= betty 3))) + (require (onetrue? (= ethel 1) (= joan 2))) + (require (onetrue? (= joan 3) (= ethel 5))) + (require (onetrue? (= kitty 2) (= mary 4))) + (require (onetrue? (= mary 4) (= betty 1))) + (list (list 'betty betty) (list 'ethel ethel) (list 'joan joan) + (list 'kitty kitty) (list 'mary mary)))) + +As in the multiple dwelling puzzle, this program can be made much more +efficient by checking for distinct values as we go along instead of +after all values have been assigned: + +(let ((betty (amb 1 2 3 4 5)) + (ethel (amb 1 2 3 4 5))) + (require (distinct? (list betty ethel))) + (let ((joan (amb 1 2 3 4 5))) + (require (distinct? (list betty ethel joan))) + ... + + +4.45 ambiguous sentence + +(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))))))))) + +This version means that a cat is a student in the class, and the professor +lectures to another student in the class. + +(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) (noun student)) + (prep-phrase (prep in) + (simple-noun-phrase (article the) (noun class)))) + (prep-phrase (prep with) + (simple-noun-phrase (article the) + (noun cat))))))) + +This version means that the professor lectures to a student, and that that +student is in the class and has a cat, which may or may not be present. + +(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) (noun student)) + (prep-phrase (prep in) + (simple-noun-phrase (article the) (noun class)))))) + (prep-phrase (prep with) + (simple-noun-phrase (article the) + (noun cat))))) + +This version means that the professor brings a cat along while lecturing +to the student who is in the class. + +(sentence + (simple-noun-phrase (article the) (noun professor)) + (verb-phrase + (verb-phrase + (verb-phrase + (verb lectures) + (prep-phrase (prep to) + (noun-phrase + (simple-noun-phrase (article the) (noun student))))) + (prep-phrase (prep in) + (simple-noun-phrase (article the) (noun class)))) + (prep-phrase (prep with) + (simple-noun-phrase (article the) + (noun cat))))) + +This version means that the professor does the lecturing in the class, +bringing a cat along, to some student about whom we know nothing. + +(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) (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))))))) + +This version means that the professor does the lecturing in a class +that includes a cat as a member, to a student about whom we know nothing. + + +4.47 left-recursive grammar + +As Louis' programs go, this one is pretty successful! It does generate +the two correct parsings for "The professor lectures to the student +with the cat," in the opposite order from what's shown in the book. +But if you say try-again again, instead of reporting that there are +no more values, the parser gets in an infinite loop. + +What happens is this: (parse-word verbs) fails, so parse-verb-phrase +is called recursively. In that recursive call, (parse-word verbs) fails, +so parse-verb-phrase is called recursively. In that recursive call... +and so on. + +Interchanging the order of expressions in the AMB just makes things +worse; this infinite recursion happens the *first* time, so you don't +even see the correct parsings before it loops. + + +4.48 grammar extensions + +For compound sentences, first rename parse-sentence as parse-simple-sentence: + +(define (parse-simple-sentence) + (list 'simple-sentence + (parse-noun-phrase) + (parse-verb-phrase))) + +(define (parse-sentence) + (define (maybe-extend sentence) + (amb sentence + (maybe-extend (list 'sentence + sentence + (parse-word connectors) + (parse-simple-sentence))))) + (maybe-extend (parse-simple-sentence))) + +(define connectors '(connector and or but)) + +For adjectives, we have to provide for the possibility of them +between the article and the noun: + +(define (parse-simple-noun-phrase) + (cons 'simple-noun-phrase + (append (list (parse-word articles)) + (maybe-some adjectives) + (list (parse-word nouns))))) + +(define adjectives '(adjective big tiny silly robust enthusiastic)) + +(define (maybe-some words) + (amb (cons (parse-word words) + (maybe-some words)) + '())) + +Note that unlike most of the parsing procedures, maybe-some doesn't fail if +it can't find what it wants. If it can't find any adjectives it just +returns an empty list. That's why parse-simple-noun-phrase has to use +append, to avoid seeing + + (simple-noun-phrase (article the) () (noun cat)) + +Adverbs are similar except that they go into parse-verb-phrase. + + +4.49 generating sentences + +(define (parse-word word-list) + (define (iter words) + (if (null? words) + (amb) + (amb (car words) (iter (cdr words))))) + (list (car word-list) (iter (cdr word-list)))) + +Here are the first several sentences it creates: +(sentence (noun-phrase (article the) (noun student)) (verb studies)) +(sentence (noun-phrase (article the) (noun student)) (verb lectures)) +(sentence (noun-phrase (article the) (noun student)) (verb eats)) +(sentence (noun-phrase (article the) (noun student)) (verb sleeps)) +(sentence (noun-phrase (article the) (noun professor)) (verb studies)) +(sentence (noun-phrase (article the) (noun professor)) (verb lectures)) +(sentence (noun-phrase (article the) (noun professor)) (verb eats)) +(sentence (noun-phrase (article the) (noun professor)) (verb sleeps)) +(sentence (noun-phrase (article the) (noun cat)) (verb studies)) + + +4.50 random choice + +We must write ANALYZE-RAMB, a variant on the ANALYZE-AMB of p. 434: + +(define (analyze-ramb exp) + (let ((cprocs (map analyze (amb-choices exp)))) + (lambda (env succeed fail) + (define (try-next choices) + (if (null? choices) + (fail) + (let ((random-order (rotate choices (random (length choices))))) + ((car random-order) env + succeed + (lambda () + (try-next (cdr random-order))))))) + (try-next cprocs)))) + +(define (rotate seq num) + (if (= num 0) + seq + (rotate (append (cdr seq) (list (car seq))) + (- num 1))) + +Then we must add a clause to ANALYZE to check for and handle RAMB, +similar to the one for AMB. + + +It's not actually so easy to use RAMB to get good sentences. The problem +is that we really don't want a more complicated choice to be just as likely +as a simple choice, or our sentences will be too long. If we change +every AMB in the parser to RAMB, I get these results: + +[Note: The second one is really long! I suggest reading this in emacs +and using control-meta-F to skip over it.] + +(sentence + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun cat)) + (prep-phrase (prep for) + (simple-noun-phrase (article a) (noun student)))))) + (verb studies)) + +(sentence + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun cat)) + (prep-phrase (prep for) + (simple-noun-phrase (article a) + (noun student)))))) + (verb-phrase + (verb-phrase + (verb studies) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep in) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep by) + (noun-phrase + (simple-noun-phrase (article a) (noun class)) + (prep-phrase + (prep with) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep to) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep with) + (simple-noun-phrase (article the) (noun professor)))))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun professor)))))) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) + (noun student)))))))))))))))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep in) + (simple-noun-phrase (article the) (noun cat)))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun student)))) + (prep-phrase + (prep with) + (simple-noun-phrase (article a) + (noun professor)))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep to) + (simple-noun-phrase (article the) + (noun class)))))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun student)))))))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))))))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun class)))))) + (prep-phrase + (prep to) + (simple-noun-phrase (article the) (noun class)))) + (prep-phrase + (prep in) + (simple-noun-phrase (article a) (noun student)))))))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep in) + (simple-noun-phrase (article a) (noun student)))) + (prep-phrase + (prep with) + (noun-phrase + (simple-noun-phrase (article a) (noun class)) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun professor)))))))) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun student)))))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun professor)))))) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) + (noun professor)) + (prep-phrase + (prep to) + (simple-noun-phrase + (article a) + (noun class)))))))))))))))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun cat)) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun student)))))) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun class)))))))) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun professor)))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep by) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep to) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun professor)))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))) + (prep-phrase + (prep in) + (simple-noun-phrase (article the) (noun professor)))) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun student)))))) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun student)))) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep with) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun class)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun professor)))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun cat)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun professor)))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep with) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep with) + (simple-noun-phrase (article a) (noun student)))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun student)))) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) + (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun student)))) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) + (noun class)))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) + (noun class)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun class)))) + (prep-phrase + (prep in) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) + (noun professor)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) + (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase + (article the) + (noun student)))))) + (prep-phrase + (prep by) + (simple-noun-phrase (article a) + (noun class)))))))) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) + (noun professor)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article the) + (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase + (article the) + (noun student)))))))))))) + (prep-phrase + (prep with) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep by) + (simple-noun-phrase (article a) + (noun student)))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep to) + (simple-noun-phrase + (article the) + (noun professor)))))))))))))))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun class)))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun student)))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) + (noun professor)) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep by) + (noun-phrase + (simple-noun-phrase (article a) + (noun student)) + (prep-phrase + (prep in) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) + (noun student)) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article the) + (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase + (article a) + (noun professor)))))) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) + (noun cat)))))))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) + (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun student)))))))) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article a) (noun cat)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) + (noun professor)))) + (prep-phrase + (prep by) + (simple-noun-phrase (article a) + (noun professor)))))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun cat)) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article a) (noun professor)) + (prep-phrase + (prep with) + (simple-noun-phrase (article the) (noun cat)))))))) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun cat)))))) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))))) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun professor)))))))) + (prep-phrase + (prep to) + (noun-phrase + (simple-noun-phrase (article a) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun student)))))))))))) + (prep-phrase + (prep with) + (simple-noun-phrase (article a) (noun student)))))) + (prep-phrase + (prep for) + (noun-phrase + (simple-noun-phrase (article the) (noun professor)) + (prep-phrase + (prep in) + (noun-phrase + (simple-noun-phrase (article the) (noun class)) + (prep-phrase + (prep to) + (simple-noun-phrase (article a) (noun student)))))))))) + (prep-phrase + (prep to) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun cat)) + (prep-phrase + (prep for) + (noun-phrase + (noun-phrase + (simple-noun-phrase (article the) (noun student)) + (prep-phrase + (prep for) + (simple-noun-phrase (article the) (noun professor)))) + (prep-phrase + (prep for) + (simple-noun-phrase (article a) (noun student)))))) + (prep-phrase + (prep in) + (simple-noun-phrase (article a) (noun student))))))) + +We can improve on this by making the addition of a prepositional +phrase less likely. For example, we could rewrite PARSE-NOUN-PHRASE +and PARSE-VERB-PHRASE this way: + +(define (parse-noun-phrase) + (define (maybe-extend noun-phrase) + (ramb noun-phrase + noun-phrase + noun-phrase + noun-phrase + noun-phrase + (maybe-extend (list 'noun-phrase + noun-phrase + (parse-prepositional-phrase))))) + (maybe-extend (parse-simple-noun-phrase))) + +(define (parse-verb-phrase) + (define (maybe-extend verb-phrase) + (ramb verb-phrase + verb-phrase + verb-phrase + verb-phrase + verb-phrase + (maybe-extend (list 'verb-phrase + verb-phrase + (parse-prepositional-phrase))))) + (maybe-extend (parse-word verbs))) + +With these changes, here are the first few sentences I get: + +(sentence (simple-noun-phrase (article a) (noun professor)) (verb sleeps)) + +(sentence (simple-noun-phrase (article a) (noun professor)) (verb sleeps)) + +(sentence (simple-noun-phrase (article a) (noun professor)) + (verb-phrase + (verb sleeps) + (prep-phrase (prep for) + (simple-noun-phrase (article a) (noun student))))) + +(sentence + (simple-noun-phrase (article a) (noun professor)) + (verb-phrase (verb sleeps) + (prep-phrase (prep for) + (simple-noun-phrase (article a) (noun student))))) + +This is still not quite what we want, but with more fine tuning we can +probably get to a reasonable sentence generator. + + +4.52 if-fail + +To add a new special form we add a clause to ANALYZE, which should call +this new procedure: + +(define (analyze-if-fail exp) + (let ((trial (analyze (if-fail-trial exp))) + (failure (analyze (if-fail-failure exp)))) + (lambda (env succeed fail) + (trial env + succeed + (lambda () (failure env succeed fail)))))) + +(define if-fail-trial cadr) +(define if-fail-failure caddr) + +Here's a version to go with vambeval, the ambeval without analysis: + +(define (eval-if-fail exp env succeed fail) + (vambeval (if-fail-trial exp) + env + succeed + (lambda () (vambeval (if-fail-failure exp) + env + succeed + fail)))) + + +Extra for Experts +================= + +4.31 + +Despite what the exercise says, there's no need to change the procedures that +determine the DEFINE syntax, because it doesn't check that the formal +parameters are symbols. Even MAKE-PROCEDURE doesn't check. + +The hard part is in procedure invocation. The original metacircular evaluator +has this in the big COND in EVAL: + + ((application? exp) + (mc-apply (MC-EVAL (operator exp) env) + (LIST-OF-VALUES (operands exp) env))) + +The lazy evaluator in the book changes that to + + ((application? exp) + (mc-apply (ACTUAL-VALUE (operator exp) env) + (operands exp) ; no LIST-OF-VALUES + ENV)) ; added argument + +(For this exercise, it's easier to work with the book's version than with +the slightly different alternative shown in the lecture notes.) + +So now we're giving APPLY expressions rather than values, and we're also +giving APPLY an environment in which to evaluate or thunkify the values. +We don't have to make any change to the book's EVAL; the hard part is in +APPLY, in which we have to decide whether to evaluate or thunkify. + +Here's the book's lazy APPLY: + +(define (mc-apply procedure arguments env) + (cond ((primitive-procedure? procedure) + (apply-primitive-procedure + procedure + (LIST-OF-ARG-VALUES ARGUMENTS ENV))) ; *** + ((compound-procedure? procedure) + (eval-sequence + (procedure-body procedure) + (extend-environment + (procedure-parameters procedure) + (LIST-OF-DELAYED-ARGS ARGUMENTS ENV) ; *** + (procedure-environment procedure)))) + (else + (error + "Unknown procedure type -- APPLY" procedure)))) + +The two commented lines handle evaluation, for primitive procedures, and +thunking, for non-primitive procedures. It's the latter we have to change; +the args may be evaluated, thunked with memoization, or thunked without +memoization. To make this decision, we have to look at the formal parameters +of the procedure we're calling. So the second commented line above will +change to + + (PROCESS-ARGS arguments (PROCEDURE-PARAMETERS PROCEDURE) env) + +Two things have changed; we're calling a not-yet-written procedure +PROCESS-ARGS instead of LIST-OF-DELAYED-ARGS, and we're giving that procedure +the formal parameters as well as the actual argument expressions. + +One more thing has to change in APPLY: Since the list returned by +PROCEDURE-PARAMETERS is no longer a list of symbols, but can now include +sublists such as (B LAZY), we have to extract the real formal parameter +names from it. So the final version of APPLY is this: + +(define (mc-apply procedure arguments env) + (cond ((primitive-procedure? procedure) + (apply-primitive-procedure + procedure + (list-of-arg-values arguments env))) + ((compound-procedure? procedure) + (eval-sequence + (procedure-body procedure) + (extend-environment + (EXTRACT-NAMES (procedure-parameters procedure)) ; *** + (PROCESS-ARGS arguments (PROCEDURE-PARAMETERS PROCEDURE) env) ; *** + (procedure-environment procedure)))) + (else + (error + "Unknown procedure type -- APPLY" procedure)))) + +Now comes the actual work, in EXTRACT-NAMES and in PROCESS-ARGS. + +EXTRACT-NAMES takes as its argument a list such as + (A (B LAZY) C (D LAZY-MEMO)) +and returns a list with just the variable names: + (A B C D) + +(define (extract-names formals) + (cond ((null? formals) '()) + ((pair? (car formals)) ; CAR is (VAR TYPE), so keep CAAR in result + (cons (caar formals) (extract-names (cdr formals)))) + (else (cons (car formals) (extract-names (cdr formals)))))) + +PROCESS-ARGS takes an argument list, let's say + ((+ 2 3) (- 4 5) (* 6 7) (/ 8 9)) +and a parameter list, such as + (A (B LAZY) C (D LAZY-MEMO)) +and matches them up. It pays no attention to the variable names in the +parameter list; it's only looking for LAZY or LAZY-MEMO type tags. It returns +a list of argument values-and-thunks: + (5 (THUNK-NOMEMO (- 4 5) <env>) 42 (THUNK-MEMO (/ 8 9) <env>)) +where <env> represents an actual environment, not the word ENV. The argument +expressions (+ 2 3) and (* 6 7) correspond to non-lazy parameters A and C, +so they've been evaluated; the other arguments have been turned into thunks +by combining them with a type-tag (THUNK-NOMEMO or THUNK-MEMO as appropriate) +and an environment. Instead of the book's DELAY-IT procedure we have to use +two different procedures, DELAY-NOMEMO and DELAY-MEMO, to construct the thunks. + +(define (process-args args formals env) + (cond ((null? args) '()) + ((null? formals) + (error "Too many arguments")) + ((pair? (car formals)) + (cond ((eq? (cadar formals) 'lazy) + (cons (delay-nomemo (car args) env) + (process-args (cdr args) (cdr formals) env))) + ((eq? (cadar formals) 'lazy-memo) + (cons (delay-memo (car args) env) + (process-args (cdr args) (cdr formals) env))) + (else (error "Unrecognized parameter type" (cadar formals))))) + (else (cons (EVAL (car args)) + (process-args (cdr args) (cdr formals) env))))) + +Note the call to EVAL in capital letters two lines up. Should that be EVAL +or ACTUAL-VALUE? The issue is what behavior we want when a procedure with a +non-lazy parameter is called with a thunk (created by calling some other +non-primitive procedure) as the argument: + + (define (foo x) + x) + + (define (baz (lazy x)) + x) + + (define p (foo (baz (/ 1 0)))) + +What should happen? FOO's argument is non-lazy, so we evaluate the argument +expression (BAZ (/ 1 0)). BAZ's argument is lazy, so we make a thunk that +promises to compute (/ 1 0) later, and that becomes the argument to FOO. +If we use EVAL up there, as written, then FOO will get a thunk as its +argument, and will return the thunk, which will become the value of P. If +we make it ACTUAL-VALUE, then the thunk will be forced, and we'll get an +error dividing by zero, and P won't get a value. + +I think the procedure FOO probably doesn't care whether or not its argument is +a thunk, and therefore the argument shouldn't be forced. If the return value +from FOO is used in some context where a real value is needed (for example, +if we said + (foo (baz (/ 1 0))) +at the Scheme prompt instead of inside a DEFINE, then the value will be +forced.) But you'd like to be able to write something like + + (define (cadr seq) (car (cdr seq))) + +and if this is applied to a list of thunks, the result should be a +thunk, not the value promised by the thunk. + +Perhaps there should be a third parameter type tag, so you could say + + (define (f a (b lazy) c (d lazy-memo) (e forced)) + ...) + +allowing the user to choose between EVAL and ACTUAL-VALUE here. This would +add a COND clause in APPLY: + + ((eq? (cadar formals) 'forced) + (cons (actual-value (car args) env) + (process-args (cdr args) (cdr formals) env))) + + +Now we have to do a little data abstraction: + +(define (delay-nomemo exp env) + (list 'THUNK-NOMEMO exp env)) + +(define (delay-memo exp env) + (list 'THUNK-MEMO exp env)) + +Note that the thunk constructors don't have to do any real memoization or +non-memoization work; they just construct thunks that "know" which kind they +are. It's when the thunks are forced that we have to take the difference +into account: + +(define (force-it obj) + (cond ((THUNK-MEMO? obj) ; two kinds of thunk testers + (let ((result (actual-value + (thunk-exp obj) + (thunk-env obj)))) + (set-car! obj 'evaluated-thunk) + (set-car! (cdr obj) result) ; replace exp with its value + (set-cdr! (cdr obj) '()) ; for memoized thunk + result)) + ((THUNK-NOMEMO? OBJ) ; nomemo thunk is EVALed each time it's forced + (ACTUAL-VALUE (THUNK-EXP OBJ) (THUNK-ENV OBJ))) + ((evaluated-thunk? obj) + (thunk-value obj)) + (else obj))) + +(define (thunk-memo? exp) + (tagged-list? exp 'thunk-memo)) + +(define (thunk-nomemo? exp) + (tagged-list exp 'thunk-nomemo)) + +Note that for both kinds of thunks we call ACTUAL-VALUE to cash in the promise; +the difference is that for a memoized thunk we remember the result, whereas for +a non-memoized thunk we don't. + + + +Handle-infix: See proj4b solutions. diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week15 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week15 new file mode 100644 index 0000000..4d67123 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week15 @@ -0,0 +1,325 @@ +CS 61A Week 15 Solutions + +LAB +=== + +4.55 + +(supervisor ?x (Bitdiddle Ben)) + +(job ?x (accounting . ?y)) + +(address ?x (Slumerville . ?y)) + +The dots are needed because (accounting ?y), for example, would match +only entries in which there was a single element after the word "accounting." +That is, (accounting ?y) would match (accounting scrivener) but not +(accounting chief accountant). + + +4.62 +The base case here involves a 1-element list, not the empty list. + +(rule (last-pair (?x) (?x))) + +(rule (last-pair (?y . ?z) ?x) + (last-pair ?z ?x)) + + +HOMEWORK +======== + +4.56 + +(and (supervisor ?x (Bitdiddle Ben)) + (address ?x ?y)) + +(and (salary ?x ?s1) + (salary (Bitdiddle Ben) ?s2) + (lisp-value < ?s1 ?s2)) + +(and (supervisor ?who ?boss) + (not (job ?boss (computer . ?y))) + (job ?boss ?z)) + +The key point here is that we use the same variable name twice if we want +it to match the same item both times. + + +4.57 + +(rule (same ?x ?x)) ;; Don't use (lisp-value eq? ....) + +(rule (replace ?p1 ?p2) + (and (or (and (job ?p1 ?x) (job ?p2 ?x)) + (and (job ?p1 ?x) (job ?p2 ?y) (can-do-job ?x ?y))) + (not (same ?p1 ?p2)))) + +(replace ?x (Fect Cy D)) + +(and (replace ?x ?y) + (salary ?x ?s1) + (salary ?y ?s2) + (lisp-value < ?s1 ?s2)) + + +4.58 +Note the definition of a sub-rule to make things more manageable. + +(rule (sup-in-div ?p ?x) + (and (supervisor ?p ?boss) + (job ?boss (?x . ?z)))) + +(rule (big-shot ?person ?division) + (and (job ?person (?division . ?x)) + (not (sup-in-div ?person ?division)))) + + +4.65 +This problem requires understanding the basic idea of how the +query system works (read Section 4.4.3). +To respond to a query, the query system generates +a stream of frames which are then used to "instantiate" the query. +In this case, the stream will include frames containing all bindings of +?middle-manager, ?person and ?x satisfying the body of the rule, +and also with ?who bound to ?person. +Since Warbucks supervises Bitdiddle and Scrooge, each of who manages +other people, there will be more than one of these frames. +Hence Warbucks appears more than once in the output. + + +Extra for Experts +================= + +Here's the REVERSE from lecture: + + (assert! (rule (reverse (?a . ?x) ?y) + (and (reverse ?x ?z) + (append ?z (?a) ?y) ))) + + (assert! (reverse () ())) + +Why won't this run backwards? It's important to understand this, in order to +solve the problem. Unfortunately there are a lot of details, so here's a +preview of the punch line: It'll turn out that the query system tries to use +the recursive rule over and over, in effect constructing longer and longer +lists whose elements aren't known, and never realizing that they can't +possibly be the reverse of the given list. + +Let's try to work out what happens if we give the simplest possible +backwards query: + + (reverse ?b (3)) + +The answer we want is (reverse (3) (3)). QEVAL starts with the stream of +frames containing one empty frame: + + {[]} + +it matches the query against everything in the database. Only two are +relevant -- the ones about REVERSE. Starting with the base case assertion + + (reverse () ()) + +we see that this doesn't match the query, because (3) in the third element of +the query is not () and neither of them is a variable. That leaves the +recursive rule. We unify the query against the conclusion of the rule, +after renaming the variables in the rule: + + (reverse ?b (3)) + (reverse (?1a . ?1x) ?1y) + +This succeeds, and the empty frame is extended with new bindings: + + [?b = (?1a . ?1x), ?1y = (3)] + +Now we use this frame as the starting point for a new query, the rule's body: + + (and (reverse ?1x ?1z) (append ?1z (?1a) ?1y)) + +Now it gets a little complicated. QEVAL of an AND query starts by +evaluating the first part in the current frame. We match + + (reverse ?1x ?1z) + +against all rules and assertions. Again, let's start with the base case, +so we are matching + + (reverse ?1x ?1z) + (reverse () ()) + +This extends the frame with new bindings for ?1X and ?1Z: + + [?b = (?1a . ?1x), ?1y = (3), ?1x = (), ?1z = ()] + +With these bindings we have to evaluate the second part of the AND: + + (append ?1z (?1a) ?1y) + +Substituting values from the frame, this is equivalent to + + (append () (?1a) (3)) + +which will work fine (leaving out the details about APPEND), giving a +final extended frame of + + [?b = (?1a . ?1x), ?1y = (3), ?1x = (), ?1z = (), ?1a = 3] + +So ?b = (?1a . ?1x) = (3 . ()) = (3). + +This is a fine solution, and if the query system looks at assertions +before rules, it may even be printed before the evaluator gets into an +infinite loop. The problem is with the recursive REVERSE rule. + +Remember that we are trying to evaluate the query + + (and (reverse ?1x ?1z) (append ?1z (?1a) ?1y)) + +and that the first step is to evaluate + + (reverse ?1x ?1z) + +in the frame + + [?b = (?1a . ?1x), ?1y = (3)] + +We've matched the query against the base case for REVERSE, and now we are +trying the recursive rule. Here are the query and the conclusion (with +variables again renamed) of the rule: + + (reverse ?1x ?1z) + (reverse (?2a . ?2x) ?2y) + +This succeeds; the resulting frame is + + [?b = (?1a . ?1x), ?1y = (3), ?1x = (?2a . ?2x), ?1z = ?2y] + +In this frame we must evaluate the body of the rule, namely + + (and (reverse ?2x ?2z) (append ?2z (?2a) ?2y)) + +Match the REVERSE part against the conclusion of the REVERSE rule +with variables renamed: + + (reverse ?2x ?2z) + (reverse (?3a . ?3x) ?3y) + +This extends the frame some more: + + [?b = (?1a . ?1x), ?1y = (3), ?1x = (?2a . ?2x), ?1z = ?2y, + ?2x = (?3a . ?3x), ?2z = ?3y] + +We human beings can see that this is all nonsense. Combining some of the +bindings we see that + + ?b = (?1a . (?2a . (?3a . ?3x))) + +which is a list of at least three elements. So if we ever got to the +APPEND part of the rule, it wouldn't match -- the result of reversing (3) +can't be more than one element long! But QEVAL will never get around to +the second half of the AND query, because it keeps finding longer and +longer lists to try to reverse. + +Why isn't this a problem when running the REVERSE rules forward? Let's +take the query + + (reverse (35) ?d) + +This doesn't match the base case, so we try the recursive case renamed: + + (reverse (35) ?d) + (reverse (?4a . ?4x) ?4y) + +We can see a difference right away: It's the known list, (35), that we +divide into its car and its cdr, giving determined values for some of +the variables in the new frame: + + [?4a = 35, ?4x = (), ?d = ?4y] + +We must now evaluate the body of the rule: + + (and (reverse ?4x ?4z) (append ?4z (?4a) ?4y)) + +I'll skip the part about matching the new REVERSE query against the base +case, which again gives a correct result. Instead let's see what happens +when we try to use the recursive rule again: + + (reverse ?4x ?4z) + (reverse (?5a . ?5x) ?5y) + +This unification fails! We want ?4x = (?5a . ?5x), but the frame tells us +that ?4x is empty. + +This is why forward reverse doesn't get into an infinite loop: QEVAL notices +that the recursive rule can't apply when we get past the number of elements +in the original list. + +---------- + +That's the end of the analysis of what's wrong. The recursive rule is +supposed to say "the reverse of my known length-N list (?a . ?x) can be +computed if we first take the reverse of a list of length N-1, namely ?x." +But when run backwards it instead says "the reverse of my known list ?y +consists of a (first) element ?1a followed by a list consisting of an +element ?2a followed by a list consisting of an element ?3a followed ..." + +We don't have this problem running the rules forwards because the rule +takes our known list and divides it into car and cdr, so we find out as +soon as we run out of list elements. The algorithm doesn't require us +to divide the second list, ?y, into pieces, and the cdr of ?y isn't useful +in doing the recursion -- we need all of ?y. So we'll add an extra +variable whose only purpose is to count down the length of ?y: + +(assert! (rule (reverse ?x ?y) + (reverse-help ?x ?y ?y))) + +(assert! (rule (reverse-help (?a . ?x) ?y (?ignore . ?counter)) + (and (reverse-help ?x ?z ?counter) + (append ?z (?a) ?y)))) + +(assert! (rule (reverse-help () () ()))) + +On each recursive invocation of the REVERSE-HELP rule, ?COUNTER gets +smaller. When it's empty, no more recursions are possible, because an +empty list can't match (?ignore . ?counter). + +For forwards queries, the whole counter mechanism is unhelpful, but it +doesn't hurt. It's the (?a . ?x) that prevents infinite recursion for +forwards queries; the ?counter situation is just like the ?x situation +we saw before for backwards queries -- in effect we get + + ?1counter = (?2ignore . (?3ignore . (?4ignore . ?4counter))) + +after three invocations of the rule. That could keep going on forever, +but the values of ?1x, ?2x, etc., are *known* and therefore eventually +one of them is empty and won't match the recursive rule. + +---------- + +This solution, like the partial solution in the lecture notes, is based on +the recursive-process Scheme procedure + + (define (reverse seq) + (if (null? seq) + '() + (append (reverse (cdr seq)) (list (car seq))))) + +What if we start instead with the iterative-process version: + + (define (reverse seq) + (define (iter seq result) + (if (null? seq) + result + (iter (cdr seq) (cons (car seq) result))))) + +We still have to add an extra counter variable to make this work as a +both-ways logic program, in addition to the Scheme program's extra +result variable: + + (assert! (rule (reverse ?x ?y) + (reverse-iter ?x () ?y ?y))) + + (assert! (rule (reverse-iter (?a . ?x) ?result ?y (?b . ?counter)) + (reverse-iter ?x (?a . ?result) ?y ?counter))) + + (assert! (rule (reverse-iter () ?y ?y ()))) diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week2 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week2 new file mode 100644 index 0000000..6cd2999 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week2 @@ -0,0 +1,509 @@ +CS 61A Week 2 Lab and Homework Solutions + +FIRST LAB: + +Problem 1: + +f Any definition at all will do: + (define f 'hello) f is hello + (define f (+ 2 3)) f is 5 + (define (f x) (+ x 7)) f is #<procedure f> + +(f) This expression says to invoke f as a procedure with no + arguments. For that to work, we must DEFINE f as a procedure + with no arguments: + (define (f) 'hello) (f) is hello + (define (f) (+ 2 3)) (f) is 5 + Each of these is shorthand for an explicit use of lambda: + (define f (lambda () 'hello)) + (define f (lambda () (+ 2 3)) + +(f 3) This expression says to invoke f as a procedure with an + argument, so we have to define it that way: + (define (f x) (+ x 5)) (f 3) is 8 + (define (f x) 'hello) (f 3) is hello + (define (f x) (word x x)) (f 3) is 33 + Again, these definitions are shorthand for lambda expressions: + (define f (lambda (x) (+ x 5))) + (define f (lambda (x) 'hello)) + (define f (lambda (x) (word x x))) + +((f)) This expression says, first of all, to compute the subexpression + (f), which invokes f as a procedure with no arguments. Then, the + result of that invocation must be another procedure, which is + also invoked with no arguments. So, we have to define f as a + procedure that returns a procedure: + (define (f) (lambda () 'hello)) ((f)) is hello + (define (f) (lambda () (+ 2 3))) ((f)) is 5 + Or without the shorthand, + (define f (lambda () (lambda () 'hello))) + (define f (lambda () (lambda () (+ 2 3)))) + Alternatively, we can let the procedure f return some procedure + we already know about, supposing that that procedure can be + invoked with no arguments: + (define (f) +) ((f)) is 0 + (define f (lambda () +)) + As a super tricky solution, for hotshots only, try this: + (define (f) f) ((f)) is #<procedure f> + (((f))) is.... ? + +(((f)) 3) Sheesh! F has to be a function. When we invoke it with no + arguments, we should get another function (let's call it G). + When we invoke G with no arguments, we get a third function + (call it H). We have to be able to call H with the argument 3 + and get some value. We could spell this out as a sequence of + definitions like this: + (define (h x) (* x x)) + (define (g) h) + (define (f) g) (((f)) 3) is 9 + Alternatively, we can do this all in one: + (define (f) (lambda () (lambda (x) (* x x)))) + or without the abbreviation: + (define f (lambda () (lambda () (lambda (x) (* x x))))) + +By the way, you haven't yet learned the notation for functions that accept +any number of arguments, but if you did know it, you could use + (define (f . args) f) +as the answer to *all* of these problems! + + +Problem 2: + +This is a "do something to every word of a sentence" problem, like +PL-SENT or SQUARES, but with two extra arguments. But it +also has a decision to make for each word (is this word equal to the +one we're replacing), like the filtering procedures EVENS, ENDS-E, etc., +so it takes the form of a three-branch COND: + +(define (substitute sent old new) + (cond ((empty? sent) '()) + ((equal? (first sent) old) + (se new (substitute (butfirst sent) old new))) + (else (se (first sent) (substitute (butfirst sent) old new))))) + + +Problem 3: + +Of course you could just try this on the computer, but you should understand +the results. + +(t 1+) means that we should substitute the actual argument, which is the +function named 1+, for t's formal parameter, which is f, in t's body, +which is (lambda (x) (f (f (f x)))). The result of the substitution is + + (lambda (x) (1+ (1+ (1+ x)))) + +Evaluating this produces a function that adds three to its argument, so +((t 1+) 0) is 3. + +(t (t 1+)) means to substitute (t 1+) for f in t's body. If we actually +substituted the lambda expression above for f three times, we'd get a +horrible mess: + + (lambda (x) ((lambda (x) (1+ (1+ (1+ x)))) + ((lambda (x) (1+ (1+ (1+ x)))) + ((lambda (x) (1+ (1+ (1+ x)))) + 0)))) + +but what's important is the function, not the expression that produced +the function, so we can just mentally give (t 1+) the name 3+ and then +the result we want is + + (lambda (x) (3+ (3+ (3+ x)))) + +and if we apply that function to 0 we'll get 9. + +For the final piece of the problem, we have to begin by computing (t t), which +is what we get when we substitute t for f in t's body: + + (lambda (x) (t (t (t x)))) + +Don't be confused! Even though this lambda expression has x as its formal +parameter, not f, the argument has to be a function, because we're going to +end up invoking t on that argument. In other words, (t t) returns as its +value a function that takes a function as argument. + +Now, ((t t) 1+) means to apply the function just above to the argument 1+ +which, in turn, means to substitute 1+ for x in the body: + + (t (t (t 1+))) + +Well, this isn't so hard; we've really already done it. (t 1+) turned +out to be 3+, and (t (t 1+)) turned out to be 9+. By the same reasoning, +this will turn out to be 27+ (that is, 9+ three times), so when we apply +this to 0 we get 27. + +Problem 4: + +This is actually the same as problem 2! The function S is identical to +1+, so the answers have to be the same. It's more work if you actually +substitute values into the body of s, but you can avoid all that if you +realize that these problems are identical in meaning. + +Problem 5: + +If (g) is a legal expression, then g takes ZERO arguments. +If ((g) 1) has the value 3, then (g) has a PROCEDURE as its value. +(If we'd asked for more than one word, you could say "a procedure +of one numeric argument that returns a number" or something.) + + +Problem 6: + +(define (make-tester who) + (lambda (x) (equal? x who))) + + + +HOMEWORK: + +Exercise 1.31(a): + +;; you only needed to hand in one version +;; but by now you're ready to understand both: + +;; recursive version: + +(define (product term a next b) + (if (> a b) + 1 ;; Note multiplicative identity is 1 not 0 + (* (term a) + (product term (next a) next b)))) + +;; iterative version: + +(define (product term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (* result (term a))))) + (iter a 1)) + +;; factorial + +(define (! n) (product (lambda (x) x) 1 1+ n)) + +;; pi +;; You have to run a few hundred terms to get a good approximation. +;; There are several possible ways to arrange the terms. Here is one +;; way, in which the first term is 2/3, the second is 4/3, etc. + +(define (pi terms) (* 4 (product + (lambda (x) (/ (* 2 (1+ (floor (/ x 2)))) + (1+ (* 2 (ceiling (/ x 2)))))) + 1 1+ terms))) + +;; Here is another way, in which the first term is (2/3)*(4/3), the +;; second is (4/5)*(6/5), etc. Notice that the value of a starts at +;; 3 and is increased by 2 for each new term. + +(define (pi terms) (* 4 (product + (lambda (x) (/ (* (-1+ x) (1+ x)) + (* x x) )) + 3 + (lambda (x) (+ x 2)) + terms ))) + +;; If you try to make it 2 * (4/3) * (4/3) * (6/5) * (6/5) * ... you'll +;; get the wrong answer, because you'll have one more number in the +;; numerator than in the denominator. + + + +Exercise 1.32(a): + +;; you only needed to hand in one version + +;; recursive form + +(define (accumulate combiner null-value term a next b) + (if (> a b) + null-value + (combiner (term a) + (accumulate combiner null-value term (next a) next b)))) + +;; iterative form + +(define (accumulate combiner null-value term a next b) + (define (iter a result) + (if (> a b) + result + (iter (next a) (combiner (term a) result)))) + (iter a null-value)) + +;; sum and product + +(define (sum term a next b) (accumulate + 0 term a next b)) + +(define (product term a next b) (accumulate * 1 term a next b)) + + + +Exercise 1.33: + +;; The problem only requires one version but this too can be +;; recursive or iterative. Recursive version: + +(define (filtered-accumulate combiner null-value term a next b predicate) + (cond ((> a b) null-value) + ((predicate a) + (combiner (term a) + (filtered-accumulate combiner + null-value + term + (next a) + next + b + predicate))) + (else (filtered-accumulate combiner + null-value + term + (next a) + next + b + predicate)))) + +;; Iterative version: + +(define (filtered-accumulate combiner null-value term a next b predicate) + (define (iter a result) + (cond ((> a b) result) + ((predicate a) (iter (next a) (combiner (term a) result))) + (else (iter (next a) result)))) + (iter a null-value)) + +;; (a) sum of squares of primes + +(define (sum-sq-prime a b) + (define (square x) (* x x)) + (filtered-accumulate + 0 square a 1+ b prime?)) + +;; (b) product of blah blah, using gcd from page 49 + +(define (prod-of-some-numbers n) + (filtered-accumulate * + 1 + (lambda (x) x) + 1 + 1+ + n + (lambda (x) (= 1 (gcd x n))))) + + +Exercise 1.40: + +(define (cubic a b c) + (lambda (x) (+ (* x x x) (* a x x) (* b x) c))) + + +Exercise 1.41: + +(define (double f) + (lambda (x) (f (f x)))) + + +Why does (((double (double double)) inc) 5) return 21 and not 13? +The crucial point is that DOUBLE is not associative. + +> (((double (double double)) inc) 5) +21 +> ((double (double (double inc))) 5) +13 + +DOUBLE turns a function into one that applies the function twice. +(DOUBLE DOUBLE) turns a function into one that applies the function +four times. +(DOUBLE (DOUBLE DOUBLE)) makes a function that applies (DOUBLE DOUBLE) +twice -- that is, make a function that applies the argument function +four times four times! + + + +Exercise 1.43: + +(define (repeated f n) + (lambda (x) + (if (= n 0) + x + (f ((repeated f (- n 1)) x))))) + +or + +(define (repeated f n) + (lambda (x) + (if (= n 0) + x + ((repeated f (- n 1)) (f x))))) + +or + +(define (repeated f n) + (if (= n 0) + (lambda (x) x) + (lambda (x) (f ((repeated f (- n 1)) x))))) + + +We didn't assign 1.42, but if you followd the hint about it in 1.43, +you'd end up with this: + +(define (repeated f n) + (if (= n 0) + (lambda (x) x) + (compose f (repeated f (- n 1))))) + + +1.46 + +This problem is a little complicated in its details because there are so +many different procedures involved, with different domains and ranges. +But don't let that keep you from seeing the beauty of this extremely +general method! + +(define (iterative-improve good-enough? improve) + (define (iterate guess) + (if (good-enough? guess) + guess + (iterate (improve guess)))) + iterate) + +(define (sqrt x) ;; compare to bottom of page 30 of SICP + ((iterative-improve (lambda (guess) (< (abs (- (square guess) x)) 0.001)) + (lambda (guess) (average guess (/ x guess)))) + 1.0)) + +Some people were confused about sqrt because the original good-enough? takes +two arguments, and iterative-improve only allows for one. But we are using +lexical scope so that the lambda expressions used as arguments to +iterative-improve have access to the starting value x. + +(define (fixed-point f first-guess) ;; compare to page 69 + ((iterative-improve (lambda (guess) (< (abs (- guess (f guess))) tolerance)) + f) + first-guess)) + +Here the structure is a little different from what's in the book, because +there is no variable NEXT to hold the next guess. The solution above computes +(f guess) twice for each guess. If you don't like that, you could use a more +complicated solution in which the argument to the good-enough procedure is a +sentence containing both old and new guesses: + +(define (fixed-point f first-guess) + ((iterative-improve (lambda (guesses) + (< (abs (- (first guesses) (last guesses))) tolerance)) + (lambda (guesses) + (sentence (last guesses) (f (last guesses))))) + (sentence first-guess (f first-guess)))) + +but I don't think the constant-factor efficiency improvement is worth the +added complexity of the code. + + +-------- + +2. EVERY: + +(define (every f sent) + (if (empty? sent) + '() + (se (f (first sent)) + (every f (butfirst sent)) ))) + + +-------- + +Extra for experts: + +This is a really hard problem! But its solution comes up enough in the +literature that it has a name: the Y combinator. First here's the +combinator alone: + +(lambda (f) (lambda (n) (f f n))) + +And here's the factorial function using it: + +( (lambda (f) (lambda (n) (f f n))) + (lambda (fun x) + (if (= x 0) + 1 + (* x (fun fun (- x 1))))) ) + +And now here's (fact 5): + +( ( (lambda (f) (lambda (n) (f f n))) + (lambda (fun x) + (if (= x 0) + 1 + (* x (fun fun (- x 1))))) ) + 5) + +The trick is that instead of the factorial function taking a number as an +argument, it takes TWO arguments, a function (which will really be itself when +called) and a number. The recursive call is done using the function provided +as argument. + +The job of the Y combinator is to provide the function with itself as an +argument. + +If that seems like a rabbit out of a hat, here's a longer explanation: + +The problem we're trying to solve is that factorial wants to be able to call +itself recursively, and to do that it has to have a name for itself. We have +two ways to give something a name, and one of them, DEFINE, is ruled out in +this problem. That leaves procedure invocation, which associates formal +parameters (the names) with actual arguments (the values). So we could +do this: + +((lambda (f n) (if (= n 0) 1 (* n (f f (- n 1))))) + (lambda (f n) (if (= n 0) 1 (* n (f f (- n 1))))) + 5) + +to get the factorial of 5. Ordinarily we think of factorial as a function +of one argument (N); here we've added a formal parameter F whose value is +another copy of the same function. If you work through this expression, +you'll see that the first copy is called only for N=5; the other calls for +all smaller values of N use the second copy, because (unlike the first) it +is called with *itself* (the very same lambda-created procedure) as its +argument. + +Now, it's a little ugly having to type the procedure twice. Also, I sort of +half lied when I said there are only two ways to give something a name. +There's a kind of third way, LET, although that's really the same as creating +and calling a procedure; and LET is good at avoiding having to type something +twice. So you might be tempted to say + +(let ((fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1))))))) + (fact 5)) + +But this doesn't work, because the name "fact" doesn't mean that lambda- +created procedure when the lambda expression is evaluated; that association +holds only in the body of the let. If that isn't clear, we can expand it: + +((lambda (fact) (FACT 5)) + (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))) + +The capitalized FACT above is inside the lambda of which fact is the formal +parameter, so the (lambda (n) ...) procedure is substituted for it. But the +name "fact" also appears on the second line of the expression, in the actual +argument expression, and *that* isn't inside the (lambda (fact) ...), so +there is no substitution; it will look for a global name fact. Thus we have +to have F (in the original solution above) take *itself* as an argument, so +that the substitution happens in the right place. We could do that with a +LET form equivalent to the original solution: + +(let ((f (lambda (f n) (if (= n 0) 1 (* n (f f (- n 1))))))) + (f f 5)) + +This one does work. Notice that the body of the let, (f f 5), is almost +like the Y combinator's body, except that the latter generalizes to a +function of N instead of having 5 built in, like this LET expression: + +(let ((f (lambda (f n) (if (= n 0) 1 (* n (f f (- n 1))))))) + (lambda (n) (f f n))) + +Now just rearrange this to eliminate the LET abbreviation: + +((LAMBDA (F) (LAMBDA (N) (F F N))) + (lambda (f n) (if (= n 0) 1 (* n (f f (- n 1)))))) + +This returns a function of N, the factorial function. And the capitalized +part is the Y combinator. diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week4 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week4 new file mode 100644 index 0000000..996c4ab --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week4 @@ -0,0 +1,152 @@ +CS 61A Week 4 solutions + +LAB EXERCISES: + +1. Error message hunt + ++: not a number: foo +unbound variable: zot +eval: bad function in : (3) +too many arguments to: (bf 3 5) +random: bad number: -7 +sqrt: number is negative: -6 +Invalid argument to FIRST: () +Argument to SENTENCE not a word or sentence:#f +define: bad variable name: 5 + +2. Tracing + +In a base-case call, the return value comes right after the call: + +STk> (fib 5) +.. -> fib with n = 5 +.... -> fib with n = 4 +...... -> fib with n = 3 +........ -> fib with n = 2 +.......... -> fib with n = 1 <=== Here's a base case +.......... <- fib returns 1 <=== with its return value +.......... -> fib with n = 0 +.......... <- fib returns 0 +........ <- fib returns 1 +........ -> fib with n = 1 +........ <- fib returns 1 +...... <- fib returns 2 +...... -> fib with n = 2 +........ -> fib with n = 1 +........ <- fib returns 1 +........ -> fib with n = 0 +........ <- fib returns 0 +...... <- fib returns 1 +.... <- fib returns 3 +.... -> fib with n = 3 +...... -> fib with n = 2 +........ -> fib with n = 1 +........ <- fib returns 1 +........ -> fib with n = 0 +........ <- fib returns 0 +...... <- fib returns 1 +...... -> fib with n = 1 +...... <- fib returns 1 +.... <- fib returns 2 +.. <- fib returns 5 +5 + +I count eight base-case calls. + + +HOMEWORK: +--------- + +1. Start by tracing it out (mentally or online): + +(fact 5) +(iter 1 1) +(iter 1 2) +(iter 2 3) +(iter 6 4) +(iter 24 5) +(iter 120 6) + +What jumps out is that the first argument to ITER is always the factorial +of something. Of what? One less than the second argument. So the +invariant is + + product = (counter-1)! + +2. Tracing again: + +(fact 5) +(helper 1 5) +(helper 5 4) +(helper 20 3) +(helper 60 2) +(helper 120 1) +(helper 120 0) + +This time, RESULT isn't the factorial of anything until the end. The +invariant is a little harder to find, but at each step, the work still +undone is the factorial of COUNTER, so the invariant turns out to be + + n! = result * counter! + +3. Trace: + +(pigl 'scheme) +(pighelp 'scheme) +(pighelp 'chemes) +(pighelp 'hemesc) +(pighelp 'emesch) + +What's invariant is that all of these words have the same translation +into Pig Latin: + + (pigl wd) = (pigl wrd) + +4. In question 3, we had the name WD for our original argument, and the +name WRD for the current argument to the helper. In the simpler procedure, +there is no helper, and there's only one formal parameter, WD, to talk +about. So we have to say something like + + (pigl of currnt wd) = (pigl of original wd) + + +5. The domain of pigl is words that contain a vowel. + + +6. Here's something else we can say about each iteration: + + The number of initial non-vowels in WD is reduced by one. + +For words in the domain, the number of initial non-vowels is a nonnegative +integer, and there is always a vowel following them. If the number of +initial non-vowels is N, then after N iterations, the first letter is a +vowel. So the process reaches the base case. + +But, by the invariant, we know that the value returned in the base case +is equal to the Pig Latin translation of the original WD. + + +7. REST-OF-DECK is of type HAND; it's a sentence of cards. + +There are two approaches to documenting this. One is to say, in the initial +listing of data types, that the names HAND and DECK are equivalent, and both +refer to a sentence of cards. Then the name REST-OF-DECK is self-documenting. +The other is to put a comment in the procedure saying that REST-OF-DECK is +a hand. + + +Extra for experts: +------------------ + +; SORT carries out a bubble sort algorithm. +; SENT is a sentence of numbers. +; +; Subprocedure BUBBLE returns a sentence of the same numbers as in its +; argument, but reordered so that the largest number is at the end. +; There is no guarantee about the order of other numbers in the sentence. +; +; SORT calls BUBBLE repeatedly. Each time one number bubbles to the end, +; and then SORT recursively bubble-sorts the remaining numbers. + +I didn't use any invariants, etc., although that could be done. I just +found it more helpful to explain the algorithm in general terms. diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week6 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week6 new file mode 100644 index 0000000..61b274c --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week6 @@ -0,0 +1,1008 @@ +CS 61A Week 6 solutions + +LAB EXERCISES: + +2.25. Extract 7 + +(cadr (caddr '(1 3 (5 7) 9))) + +I did that one by knowing that "cadr" means "the second element" and +"caddr" means "the third element," and the seven is the second element +of the third element of the overall list. + +(car (car '((7))) + +(cadr (cadr (cadr (cadr (cadr (cadr '(1 (2 (3 (4 (5 (6 7)))))))))))) + + + +2.53. Finger exercises. +Note that it matters how many parentheses are printed! + +> (list 'a 'b 'c) +(a b c) + +> (list (list 'george)) +((george)) + +> (cdr '((x1 x2) (y1 y2))) +((y1 y2)) + +> (cadr '((x1 x2) (y1 y2))) +(y1 y2) + +> (pair? (car '(a short list))) +#f + +> (memq 'red '((red shoes) (blue socks))) +#f + +> (memq 'red '(red shoes blue socks)) +(red shoes blue socks) + + + +2.55 (car ''abracadabra) + +When you write + + 'foo + +it's just an abbreviation for + + (quote foo) + +no matter what foo is, and no matter what the context is. So + + ''foo + +is an abbreviation for + + (quote (quote foo)) + +If you enter the expression + + (car ''abracadabra) + +you are really saying + + (car (quote (quote abracadabra))) + +Using the usual evaluation rules, we start by evaluating the subexpressions. +The symbol car evaluates to a function. The expression + + (quote (quote abracadabra)) + +evaluates to the unevaluated argument to (the outer) quote, namely + + (quote abracadabra) + +That latter list is the actual argument to car, and so car returns the first +element of that list, i.e., the word quote. + + +Another example: + + (cdddr '(this list contains '(a quote))) + +is the same as + + (cdddr '(this list contains (quote (a quote)))) + +which comes out to + + ((quote (a quote))) + + +P.S.: Don't think that (car ''foo) is a quotation mark! First of all, +the quotation mark has already been turned into the list for which it +is an abbreviation before we evaluate the CAR; secondly, even if the +quotation mark weren't an abbreviation, CAR isn't FIRST, so it doesn't +take the first character of a quoted word! + + + +2.27. Deep-reverse. + +This is a tough problem to think about, although you can write a really +simple program once you understand how. One trick is to deep-reverse a +list yourself, by hand, without thinking about it too hard, and THEN ask +yourself how you did it. It's pretty easy for you to take a list like + +((1 2 3) (4 5 6) (7 8 9)) + +and instantly write down + +((9 8 7) (6 5 4) (3 2 1)) + +How'd you do it? The answer probably is, "I reversed the list and then I +deep-reversed each of the sublists." So: + +(define (deep-reverse lst) ;; Almost working version + (map deep-reverse (reverse lst))) + +But this doesn't QUITE work, because eventually you get down to the level +of atoms (symbols or numbers) and you can't map over an atom. So: + +(define (deep-reverse lst) + (if (pair? lst) + (map deep-reverse (reverse lst)) + lst)) + +If you tried to define deep-reverse without using map, you'll appreciate +the intellectual power it gives you. You probably got completely lost in +cars and cdrs, none of which are used in this program. + +Now that you understand the algorithm, it's possible to do what the problem +asked us to do, namely "modify your reverse procedure": + +(define (deep-reverse lst) + (define (iter old new) + (cond ((null? old) new) + ((not (pair? old)) old) + (else (iter (cdr old) (cons (deep-reverse (car old)) new))))) + (iter lst '())) + +This program will repay careful study, especially if you've fallen into the +trap of thinking that there is an iterative form and a recursive form in which +any problem can be expressed. Deep-reverse combines two subproblems. The +top-level reversal is one that can naturally be expressed iteratively, and +in this procedure the invocation of iter within itself does express an +iteration. But the deep-reversal of the sublists is an inherently recursive +problem; there is no way to do it without saving a lot of state information +at each level of the tree. So the call to deep-reverse within iter is truly +recursive, and necessarily so. Can you express the time and space requirements +of this procedure in Theta(...) notation? + + +5. Scheme-1 AND form. + +Special forms are handled by clauses in the COND inside EVAL-1, so we +start by adding one for this new form: + +(define (eval-1 exp) + (cond ((constant? exp) exp) + ((symbol? exp) (error "Free variable: " exp)) + ((quote-exp? exp) (cadr exp)) + ((if-exp? exp) + (if (eval-1 (cadr exp)) + (eval-1 (caddr exp)) + (eval-1 (cadddr exp)))) + ((lambda-exp? exp) exp) + ((AND-EXP? EXP) (EVAL-AND (CDR EXP))) ;; added + ((pair? exp) (apply-1 (car exp) + (map eval-1 (cdr exp)))) + (else (error "bad expr: " exp)))) + +Note that the new clause has to come before the PAIR? test, because special +forms are also pairs, and must be caught before we try to interpret them as +ordinary procedure calls. + +We also need the helper that checks for a list starting with the word AND: + +(define and-exp? (exp-checker 'and)) + +That was the easy part. Now we have to do the actual work, in the +procedure EVAL-AND. I chose to give it (CDR EXP) as its argument because +I'm envisioning a recursive loop through the subexpressions, and we want +to leave out the word AND itself, which isn't to be evaluated. + +What AND is supposed to do is to go through the subexpressions from left +to right, evaluating each in turn until either some expression's value is +#F (in which case we return #F) or we run out (in which case we return, +to get exactly Scheme's behavior, the value of the last expression, which +might be some true value other than #T). + +(define (eval-and subexps) + (if (null? subexps) ; Trivial case: (AND) + #T ; returns #T + (let ((result (eval-1 (car subexps)))) ; else eval first one. + (cond ((null? (cdr subexps)) result) ; Last one, return its value. + ((equal? result #F) #F) ; False, end early. + (else (eval-and (cdr subexps))))))) ; else do the next one. + +The LET here is used so that there is only one recursive call to EVAL-1, +but the program can be written without it, and turns out only to call +EVAL-1 once anyway, even though the call appears in two different places +in the code, because only one of them will be carried out (per invocation +of EVAL-AND, of course). + +(define (eval-and subexps) + (cond ((null? subexps) #T) + ((null? (cdr subexps)) (eval-1 (car subexps))) + ((equal? (eval-1 (car subexps)) #F) #F) + (else (eval-and (cdr subexps))))) + +Note that the first NULL? test is not really a base case; unless the +entire expression given to us was exactly (AND), the second NULL? test +will always become true before the first one does. It's that second +one that's the base case. + +(If we wanted AND always to return either #T or #F, rather than return +the value of the last expression, then we'd leave out the second NULL? +test, and the first one *would* be the base case of the recursion.) + + + +HOMEWORK: + +2.24. (list 1 (list 2 (list 3 4))) + +The printed result is (1 (2 (3 4))). + +The box and pointer diagram (in which XX represents a pair, and +X/ represents a pair whose cdr is the empty list): + +--->XX--->X/ + | | + | | + V V + 1 XX--->X/ + | | + | | + V V + 2 XX--->X/ + | | + | | + V V + 3 4 + + +[NOTE: The use of XX to represent pairs, as above, is a less-readable +form of box-and-pointer diagram, leaving out the boxes, because there's +no "box" character in the ASCII character set. This is okay for +diagrams done on a computer, but when you are asked to *draw* a diagram, +on a midterm exam for example, you should use actual boxes, as in the +text and the reader.] + + +The tree diagram: + + + + / \ + / \ + 1 + + / \ + / \ + 2 + + / \ + / \ + 3 4 + + + +2.26. Finger exercises. Given + +(define x (list 1 2 3)) +(define y (list 4 5 6)) + +> (append x y) +(1 2 3 4 5 6) + +> (cons x y) +((1 2 3) 4 5 6) ;; Equivalent to ((1 2 3) . (4 5 6)) but that's not how + ;; it prints! + +> (list x y) +((1 2 3) (4 5 6)) + + + +2.29 Mobiles. + +Many people find this exercise very difficult. As you'll see, the solutions +are quite small and elegant when you approach the problem properly. The key +is to believe in data abstraction; in this problem some procedures take a +MOBILE as an argument, while others take a BRANCH as an argument. Even though +both mobiles and branches are represented "below the line" as two-element +lists, you won't get confused if you use the selectors consistently instead +of trying to have one procedure that works for both data types. + +(a) Selectors. They give us the constructor + +(define (make-mobile left right) + (list left right)) + +The corresponding selectors have to extract the left and right components +from the constructed list: + +(define (left-branch mobile) + (car mobile)) + +(define (right-branch mobile) + (cadr mobile)) + +Note that the second element of a list is its CADR, not its CDR! +Similarly, the other selectors are + +(define (branch-length branch) + (car branch)) + +(define (branch-structure branch) + (cadr branch)) + + +(b) Total weight: The total weight is the sum of the weights of the +two branches. The weight of a branch may be given explicitly, as a +number, or may be the total-weight of a smaller mobile. + +(define (total-weight mobile) + (+ (branch-weight (left-branch mobile)) + (branch-weight (right-branch mobile)) )) + +(define (branch-weight branch) + (let ((struct (branch-structure branch))) + (if (number? struct) + struct + (total-weight struct) ))) + +The LET isn't entirely necessary, of course; we could just say +(branch-structure branch) three times inside the IF. + + +(c) Predicate for balance. It looks like we're going to need a function +to compute the torque of a branch: + +(define (torque branch) + (* (branch-length branch) + (branch-weight branch) )) + +Here we have used the BRANCH-WEIGHT procedure from part (b) above. Now, +they say a mobile is balanced if two conditions are met: The torques of +its branches must be equal, and its submobiles must be balanced. (If a +branch contains a weight, rather than a submobile, we don't have to check +if it's balanced. This is the base case of the recursion.) + +(define (balanced? mobile) + (and (= (torque (left-branch mobile)) + (torque (right-branch mobile)) ) + (balanced-branch? (left-branch mobile)) + (balanced-branch? (right-branch mobile)) )) + +(define (balanced-branch? branch) + (let ((struct (branch-structure branch))) + (if (number? struct) + #t + (balanced? struct) ))) + +If you find yourself wondering why we aren't checking the sub-sub-mobiles, +the ones two levels down from the one we were asked about originally, then +you're missing the central point of this exercise: We are doing a tree +recursion, and these procedures will check the balance of all the smaller +mobiles no matter how far down in the tree structure. + + +(d) Changing representation. We change the two constructors to use +CONS instead of LIST. The only other required change is in two of +the selectors: + +(define (right-branch mobile) + (cdr mobile)) + +(define (branch-structure branch) + (cdr branch)) + +We're now using CDR instead of CADR because the second component of each +of these data types is stored in the cdr of a pair, rather than in the +second element of a list. Nothing else changes! The procedures we wrote +in parts (b) and (c) don't include any invocations of CDR or CADR or +anything like that; we respected the abstraction barrier, and so nothing +has to change "above the line." + + +2.30 square-tree + +The non-MAP way: + +(define (square-tree tree) + (cond ((null? tree) '()) + ((number? tree) (* tree tree)) + (else (cons (square-tree (car tree)) + (square-tree (cdr tree)))))) + +The MAP way: + +(define (square-tree tree) + (if (number? tree) + (* tree tree) + (map square-tree tree))) + +I'm not saying more about this because we talked about these programs in +lecture. See the lecture notes! But NOTE that what the book calls a "tree" +in this section is what I've called a "deep list," reserving the name "tree" +for an abstract data type. + + +2.31 tree-map + +This, too, can be done both ways: + +(define (tree-map fn tree) + (cond ((null? tree) '()) + ((not (pair? tree)) (fn tree)) + (else (cons (tree-map fn (car tree)) + (tree-map fn (cdr tree)))))) + +(define (tree-map fn tree) + (if (not (pair? tree)) + (fn tree) + (map (lambda (subtree) (tree-map fn subtree)) tree))) + +In both cases I've replaced NUMBER? with (NOT (PAIR? ...)) so that +the leaves of the tree can be symbols as well as numbers. (Obviously +if the underlying function is squaring, then only numbers are +appropriate.) + + +2.32 subsets + +(define (subsets s) + (if (null? s) + (list nil) + (let ((rest (subsets (cdr s)))) + (append rest (map (LAMBDA (SET) (CONS (CAR S) SET)) rest))))) + +Explanation: The subsets of a set can be divided into two categories: +those that include the first element and those that don't. Each of the +former (including the first element) consists of one of the latter +(without the first element) with the first element added. For example, +the subsets of (1 2 3) are + +not including 1: () (2) (3) (2 3) +including 1: (1) (1 2) (1 3) (1 2 3) + +But the "not including 1" ones are exactly the subsets of (2 3), +which is the cdr of the original set. So the LET uses a recursive +call to find those subsets, and we append to them the result of +sticking 1 (the car of the original set) in front of each. + +Note: It's really important to put the recursive call in a LET +argument rather than use two recursive calls, as in + + (append (subsets (cdr s)) + (map (lambda (set) (cons (car s) set)) + (subsets (cdr s)))) + +because that would take Theta(3^n) time, whereas the original version +takes Theta(2^n) time. Both are slow, but that's a big difference. + + +2.36 accumulate-n + +(define (accumulate-n op init seqs) + (if (null? (car seqs)) + nil + (cons + (accumulate op init (MAP CAR SEQS)) + (accumulate-n op init (MAP CDR SEQS))))) + + +2.37 matrices + +(define (matrix-*-vector m v) + (map (LAMBDA (ROW) (DOT-PRODUCT ROW V)) m)) + +(define (transpose mat) + (accumulate-n CONS NIL mat)) + +(define (matrix-*-matrix m n) + (let ((cols (transpose n))) + (map (LAMBDA (ROW) (MATRIX-*-VECTOR COLS ROW)) m))) + +Take a minute and try to appreciate the aesthetic beauty in these vector +and matrix programs. In a conventional approach, matrix multiplication +would involve three nested loops with index variables. These procedures +seem closer to the mathematical idea that a matrix is a first-class +thing in itself, not just an array of numbers. + + +2.38 fold-right vs. fold-left + +> (fold-right / 1 (list 1 2 3)) +1.5 + +This is 1/(2/3). + +> (fold-left / 1 (list 1 2 3)) +166.666666666667e-3 + +This is (1/2)/3, or 1/6. + +> (fold-right list nil (list 1 2 3)) +(1 (2 (3 ()))) + +This is (list 1 (list 2 (list 3 nil))). + +> (fold-left list nil (list 1 2 3)) +(((() 1) 2) 3) + +This is (list (list (list nil 1) 2) 3). + +In each example, notice that the values 1, 2, and 3 occur in left-to-right +order whether we use fold-left or fold-right. What changes is the grouping: + +fold-right: f(1, f(2, f(3, initial))) + +fold-left: f(f(f(initial, 1), 2), 3) + +So the kind of function that will give the same answer with fold-right and +fold-left is an ASSOCIATIVE operator, i.e., one for which + + (a op b) op c = a op (b op c) + + +2.54 Equal? + +(define (equal? a b) + (cond ((and (symbol? a) (symbol? b)) (eq? a b)) + ((or (symbol? a) (symbol? b)) #f) + ((and (number? a) (number? b)) (= a b)) ;; not required but + ((or (number? a) (number? b)) #f) ;; suggested in footnote + ((and (null? a) (null? b)) #t) + ((or (null? a) (null? b)) #f) + ((equal? (car a) (car b)) (equal? (cdr a) (cdr b))) + (else #f))) + +Note: I think this is the cleanest way to write it--the way that's easiest +to read. It's possible to bum a few procedure calls here and there. For +example, the first two cond clauses could be + + ((symbol? a) (eq? a b)) + ((symbol? b) #f) + +on the theory that eq? always returns #f if one argument is a symbol +and the other isn't. Similarly, one could write + + ((null? a) (null? b)) + ((null? b) #f) + +but I'm not sure the saving is worth the potential confusion. + + +Scheme-1 LET: + +I always like to start with the easy parts: + +(define let-exp? (exp-checker 'let)) + +(define (let-parameters exp) (map car (cadr exp))) + +(define (let-value-exps exp) (map cadr (cadr exp))) + +(define (let-body exp) (cddr exp)) + +Now, one way to evaluate a LET expression is to covert it into the +expression it abbreviates, namely an invocation of a lambda-generated +procedure: + +(define (let-to-lambda exp) + (cons (cons 'lambda + (cons (let-parameters exp) + (let-body exp))) + (let-value-exps exp))) + +(define (eval-1 exp) + (cond ... + ((LET-EXP? EXP) (EVAL-1 (LET-TO-LAMBDA EXP))) + ... + (else (error "bad expr: " exp)))) + +Here's an example of how let-to-lambda works: + +STk> (let-to-lambda '(let ((x (+ 2 3)) + (y (* 2 5))) + (+ x y))) +((lambda (x y) (+ x y)) (+ 2 3) (* 2 5)) + + +The other solution would be to evaluate the LET expression directly, +without first translating it: + +(define (eval-1 exp) + (cond ... + ((LET-EXP? EXP) + (EVAL-1 (SUBSTITUTE (LET-BODY EXP) + (LET-PARAMETERS EXP) + (MAP EVAL-1 (LET-VALUE-EXPS EXP)) + '()))) + ... + (else (error "bad expr: " exp)))) + +This is basically stolen from APPLY of a lambda-defined procedure, but +using the selectors for the pieces of a LET expressions, and evaluating +the let value expressions using MAP, as specified in the hint. + + + +Extra for experts: +------------------ + +Huffman coding exercises: + +None of this is particularly hard; it was assigned to illustrate an +interesting application of trees to a real-world problem (compression). + +2.67 + +Here's what SAMPLE-TREE looks like: + +((leaf a 4) + ((leaf b 2) ((leaf d 1) (leaf c 1) (d c) 2) (b d c) 4) + (a b d c) + 8) + +The corresponding codes are + A 0 + B 10 + D 110 + C 111 + +So the sample message (0 1 1 0 0 1 0 1 0 1 1 1 0) is grouped as + + 0 110 0 10 10 111 0 + +which is decoded as (a d a b b c a). + + +2.68 + +Since every node of the tree knows all the symbols in all its children, +we don't have to do a complete tree search; we can look only in the branch +that contains the symbol we want. (This is why the tree was designed with +a SYMBOLS field.) + +(define (encode-symbol symbol tree) + (if (leaf? tree) + (if (equal? symbol (symbol-leaf tree)) + '() + (error "Symbol not in tree:" symbol)) + (if (member symbol (symbols (left-branch tree))) + (cons 0 (encode-symbol symbol (left-branch tree))) + (cons 1 (encode-symbol symbol (right-branch tree)))))) + + +2.69 + +We are given a list of leaves in increasing order of weight. Each leaf +is a tree, so this can also be thought of as a list of trees. We'll +maintain a list of trees in order of weight, but including some non-leaf +trees, until there's only one tree in the list. + +(define (successive-merge set) + (if (null? (cdr set)) ;set is of length 1 + (car set) ;so return the one tree. + (successive-merge + (adjoin-set ;else make a new set + (make-code-tree (car set) (cadr set)) ;making two smallest into one + (cddr set))))) ;leaving out the individuals + + +2.70 + +STk> (define job-tree + (generate-huffman-tree '((a 2) (boom 1) (get 2) (job 2) + (na 16) (sha 3) (yip 9) (wah 1)))) +okay +STk> job-tree +((leaf na 16) + ((leaf yip 9) + (((leaf a 2) + ((leaf wah 1) (leaf boom 1) (wah boom) 2) + (a wah boom) 4) + ((leaf sha 3) ((leaf job 2) (leaf get 2) (job get) 4) (sha job get) 7) + (a wah boom sha job get) 11) + (yip a wah boom sha job get) 20) + (na yip a wah boom sha job get) 36) + +The corresponding encoding is + + NA 0 JOB 11110 + YIP 10 GET 11111 + A 1100 WAH 11010 + SHA 1110 BOOM 11011 + +STk> (encode '(get a job + sha na na na na na na na na + get a job + sha na na na na na na na na + wah yip yip yip yip yip yip yip yip yip + sha boom) + job-tree) +(1 1 1 1 1 1 1 0 0 1 1 1 1 0 + 1 1 1 0 0 0 0 0 0 0 0 0 + 1 1 1 1 1 1 1 0 0 1 1 1 1 0 + 1 1 1 0 0 0 0 0 0 0 0 0 + 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 + 1 1 1 0 1 1 0 1 1) + +There are 84 bits in this encoding. + +A fixed-length encoding would use three bits for each of the eight symbols. +For example: + + NA 000 JOB 100 + YIP 001 GET 101 + A 010 WAH 110 + SHA 011 BOOM 111 + +With this encoding, the 36 words of the song would take 36*3 = 108 bits. +We saved 24 bits, which is 22% of the fixed-length size. This is a decent +but not amazing compression ratio, considering that the example was chosen +to work well with Huffman compression. + +(Bear in mind, though, that in practice we'd have to include some +representation of the coding tree when we send the message to someone, to +allow the receiver to decode it! That's why compression in general isn't +worth it for short messages; there's generally some overhead space required +that's negligible for long messages but important for short ones.) + +For this example, even the three-bit fixed-length encoding is pretty good. +The song lyric is 125 characters (including spaces and newlines), ordinarily +represented in the ASCII code using one eight-bit byte per character, for +a total of 125*8 = 1000 bits. GZIP, the general-purpose compression +program from the Free Software Foundation, compresses this to 62 bytes, +or 496 bits (50% compression). The three-bit and Huffman encodings both do +much better than this, although of course they wouldn't work at all for +data containing anything other than those eight words. + + +2.71 + +If the weights are powers of two, then at each step of the SUCCESSIVE-MERGE +all of the symbols merged so far will weigh less than the next unmerged +symbol. That is, given ((A 1) (B 2) (C 4) (D 8) (E 16)) we get + + ((A 1) (B 2) (C 4) (D 8) (E 16)) + ((AB 3) (C 4) (D 8) (E 16)) + ((ABC 7) (D 8) (E 16)) + ((ABCD 15) (E 16)) + +(leaving out the details of the non-leaf trees to show the big picture). +Therefore, the tree will look like the very imbalanced one in figure 2.17 +on page 158: + + (ABCDE) 31 + / \ + / \ + (ABCD) 15 E 16 + / \ + / \ + (ABC) 7 D 8 + / \ + / \ + (AB) 3 C 4 + / \ + / \ + A 1 B 2 + +The encodings are + + A 0000 B 0001 C 001 D 01 E 1 + +In general, for N symbols, the most frequent takes 1 bit, and the least +frequent takes N-1 bits. + +But don't think that this is a failure of the algorithm, in the way that +the unbalanced binary search tree of figure 2.17 is a worst case! If the +frequencies of use of the symbols really are a sequence of powers of two, +then this encoding will be efficient, since more than half of the symbols +in the text to be encoded are represented with one bit. Altogether +there will be 2^(N-1) one-bit codes, 2^(N-2) two-bit codes, etc., in +this message of length (2^N)-1 symbols. This requires [2^(N+1)]-(N+2) bits +altogether. A fixed-length encoding would take (lg N)*[(2^N)-1] bits. +The exact formulas are complicated, so here are simple approximations: + fixed-length: 2^N * (lg N) + Huffman: 2^N * 2 +On average, each symbol requires (just under) two bits with Huffman coding, +regardless of the value of N. With fixed-length encoding, the number of +bits grows as N grows. And of course the (lg N) has to be rounded up to +the next higher integer, so for N=5, we need three bits per symbol for +fixed-length vs. two per symbol for Huffman. + +(The notation "lg n" means the logarithm to the base 2.) + + +2.72 + +Since only one branch is followed at each step of the encoding, the +number of steps is at worst the depth of the tree. And the time per +step, as the exercise points out, is determined by the call to MEMBER +to check whether the symbol is in the left branch. If there are N +symbols, it's easy to see that the worst case is N^2 time, supposing +the tree is very unbalanced [in 2.71 I said that an unbalanced tree isn't +a problem, but that's in determining the size of the encoded message, not +the time required for the encoding] so its depth is N, and we have to +check at most N symbols at each level. + +In reality, though, it's never that bad. The whole idea of Huffman coding +is that the most often used symbols are near the top of the tree. For the +power-of-two weights of exercise 2.71, the average number of steps to +encode each symbol is 2, so the time is 2N rather than N^2. (The worst-case +time is for the least frequently used symbol, which still takes N^2 time, +but that symbol only occurs once in the entire message!) We could make +a small additional optimization by rewriting ENCODE-SYMBOL to make sure +that at each branch node in the tree it creates, the left branch has fewer +symbols than the right branch. + + +Programming by example: + +Of course many approaches are possible; here's mine: + +(define (regroup pattern) + + ;; my feeble attempt at data abstraction: + ;; regroup0 returns two values in a pair + + (define reg-result cons) + (define reg-function car) + (define reg-minsize cdr) + + ;; Assorted trivial utility routines + + (define (firstn num ls) + (if (= num 0) + '() + (cons (car ls) (firstn (- num 1) (cdr ls))) )) + + (define (too-short? num ls) + (cond ((= num 0) #f) + ((null? ls) #t) + (else (too-short? (- num 1) (cdr ls))) )) + + (define (safe-bfn num ls) + (cond ((null? ls) '()) + ((= num 0) ls) + (else (safe-bfn (- num 1) (cdr ls))) )) + + (define (firstnum pattern) + (if (symbol? pattern) + pattern + (firstnum (car pattern)) )) + + (define (and-all preds) + (cond ((null? preds) #t) + ((car preds) (and-all (cdr preds))) + (else #f) )) + + ;; Okay, here's the real thing: + + ;; There are three kinds of patterns: 1, (1 2), and (1 2 ...). + ;; Regroup0 picks one of three subprocedures for them. + ;; In each case, the return value is a pair (function . min-size) + ;; where "function" is the function that implements the pattern + ;; and "min-size" is the minimum length of a list that can be + ;; given as argument to that function. + + (define (regroup0 pattern) + (cond ((number? pattern) (select pattern)) + ((eq? (last pattern) '...) (infinite (bl pattern))) + (else (finite pattern)) )) + + + ;; If the pattern is a number, the function just selects the NTH element + ;; of its argument. The min-size is N. + + (define (select num) + (reg-result + (cond ((= num 1) car) ; slight optimization + ((= num 2) cadr) + (else (lambda (ls) (list-ref ls (- num 1)))) ) + num)) + +;; If the pattern is a list of patterns without ..., the function + ;; concatenates into a list the results of calling the functions + ;; that we recursively derive from the subpatterns. The min-size + ;; is the largest min-size required for any subpattern. + + (define (finite pattern) + (let ((subgroups (map regroup0 pattern))) + (reg-result + (lambda (ls) (map (lambda (subg) ((reg-function subg) ls)) subgroups)) + (apply max (map reg-minsize subgroups)) ) )) + + ;; Now for the fun part. If the pattern is a list ending with ... then + ;; we have to build a map-like recursive function that sticks the result + ;; of computing a subfunction on the front of a recursive call for some + ;; tail portion of the argument list. There are a few complications: + + ;; The pattern is allowed to give any number of examples of its subpattern. + ;; For instance, ((1 2) ...), ((1 2) (3 4) ...), and ((1 2) (3 4) (5 6) ...) + ;; all specify the same function. But ((1 2) (3 4 5) ...) is different from + ;; those. So we must find the smallest leading sublist of the pattern such + ;; that the rest of the pattern consists of equivalent-but-shifted copies, + ;; where "shifted" means that each number of the copy differs from the + ;; corresponding number of the original by the same amount. (3 4) is a + ;; shifted copy of (1 2) but (3 5) isn't. Once we've found the smallest + ;; appropriate leading sublist, the rest of the pattern is unused, except + ;; as explained in the following paragraph. + + ;; Once we have the pattern for the repeated subfunction, we need to know + ;; how many elements of the argument to chop off for the recursive call. + ;; If the pattern contains only one example of the subfunction, the "cutsize" + ;; is taken to be the same as the min-size for the subfunction. For example, + ;; in the pattern ((1 2) ...) the cutsize is 2 because 2 is the highest + ;; number used. But if there are two or more examples, the cutsize is the + ;; amount of shift between examples (which must be constant if there are + ;; more than two examples), so in ((1 2) (3 4) ...) the cutsize is 2 but in + ;; ((1 2) (2 3) ...) it's 1. In ((1 2) (2 3) (5 6) ...) the shift isn't + ;; constant, so this is taken as one example of a long subpattern rather + ;; than as three examples of a short one. + + ;; Finally, if the subpattern is a single number or list, as in (1 3 ...) + ;; (that's two examples of a one-number pattern) or ((1 2) ...), then we + ;; can cons the result of the subfunction onto the recursive call. But if + ;; the subpattern has more than one element, as in (1 2 4 ...) or + ;; ((1 2) (3 4 5) ...), then we must append the result of the subfunction + ;; onto the recursive call. + + ;; INFINITE does all of this. FINDSIZE returns a pair containing two + ;; values: the number of elements in the smallest-appropriate-leading-sublist + ;; and, if more than one example is given, the shift between them, i.e., the + ;; cutsize. (If only one example is given, #T is returned + ;; in the pair instead of the cutsize.) PARALLEL? checks to see if a + ;; candidate smallest-appropriate-leading-sublist is really appropriate, + ;; i.e., the rest of the pattern consists of equivalent-but-shifted copies. + ;; The return value from PARALLEL? is the amount of shift (the cutsize). + + (define (infinite pattern) + + (define (findsize size len) + + (define (parallel? subpat rest) + (let ((cutsize (- (firstnum rest) + (firstnum subpat) ))) + + (define (par1 togo rest delta) + + (define (par2 this that) + (cond ((and (eq? this '...) (eq? that '...)) #t) + ((or (eq? this '...) (eq? that '...)) #f) + ((and (number? this) (number? that)) + (= delta (- that this))) + ((or (number? this) (number? that)) #f) + ((not (= (length this) (length that))) #f) + (else (and-all (map par2 this that))) )) + + (cond ((null? rest) cutsize) + ((null? togo) (par1 subpat rest (+ delta cutsize))) + ((not (par2 (car togo) (car rest))) #f) + (else (par1 (cdr togo) (cdr rest) delta)) )) + + (par1 subpat rest cutsize) )) + + ;; This is the body of findsize. + (cond ((= size len) (cons size #t)) + ((not (= (remainder len size) 0)) + (findsize (+ size 1) len)) + (else (let ((par (parallel? (firstn size pattern) + (safe-bfn size pattern) ))) + (if par + (cons size par) + (findsize (+ size 1) len) ))) )) + + ;; This is the body of infinite. + (let* ((len (length pattern)) + (fs-val (findsize 1 len)) + (patsize (car fs-val)) + (cutsize (cdr fs-val))) + + (define (make-recursion subpat combiner) + (let ((subgroup (regroup0 subpat))) + (letrec + ((f (lambda (ls) + (if (too-short? (reg-minsize subgroup) ls) + '() + (combiner ((reg-function subgroup) ls) + (f (safe-bfn + (if (number? cutsize) + cutsize + (reg-minsize subgroup)) + ls)) )) ))) + (reg-result f (reg-minsize subgroup)) ))) + + (if (= patsize 1) + (make-recursion (car pattern) cons) + (make-recursion (firstn patsize pattern) append) ) )) + + (reg-function (regroup0 pattern)) ) diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week7 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week7 new file mode 100644 index 0000000..912b506 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week7 @@ -0,0 +1,663 @@ +CS 61A Week 7 solutions + +LAB ASSIGNMENT: + +2.62. Union-set in Theta(n) time. + +The key is to realize the differences between union-set and +intersection-set. The null case for union-set will be different, because if +one of the sets is empty, the result must be the other set. In the element +comparisons, one element will always be added to the result set. So the +expressions with the element will be the same as intersection-set, only with +a cons added. Here's the solution: + +(define (union-set set1 set2) + (cond ((null? set1) set2) + ((null? set2) set1) + (else (let ((x1 (car set1)) (x2 (car set2))) + (cond ((= x1 x2) + (cons x1 (union-set (cdr set1) (cdr set2)))) + ((< x1 x2) + (cons x1 (union-set (cdr set1) set2))) + ((< x2 x1) + (cons x2 (union-set set1 (cdr set2))))))))) + + +Trees on page 156: + +(define tree1 + (adjoin-set 1 + (adjoin-set 5 + (adjoin-set 11 + (adjoin-set 3 + (adjoin-set 9 + (adjoin-set 7 '()))))))) + +(define tree2 + (adjoin-set 11 + (adjoin-set 5 + (adjoin-set 9 + (adjoin-set 1 + (adjoin-set 7 + (adjoin-set 3 '()))))))) + +(define tree3 + (adjoin-set 1 + (adjoin-set 7 + (adjoin-set 11 + (adjoin-set 3 + (adjoin-set 9 + (adjoin-set 5 '()))))))) + +Other orders are possible; the constraint is that each node must be +added before any node below it. So in each case we first adjoin the +root node, then adjoin the children of the root, etc. To make sure +this is clear, here's an alternative way to create tree1: + +(define tree1 + (adjoin-set 11 + (adjoin-set 9 + (adjoin-set 5 + (adjoin-set 1 + (adjoin-set 3 + (adjoin-set 7 '()))))))) + + +2.74 (Insatiable Enterprises): + +(a) Each division will have a private get-record operation, so each +division's package will look like this: + +(define (install-research-division) + ... + (define (get-record employee file) + ...) + ... + (put 'get-record 'research get-record) + ...) + +Then we can write a global get-record procedure like this: + +(define (get-record employee division-file) + ((get 'get-record (type-tag division-file)) + employee + (contents division-file))) + +It'll be invoked, for example, like this: + (get-record '(Alan Perlis) research-personnel-list) + +For this to work, each division's file must include a type tag +specifying which division it is. + +If, for example, a particular division file is a sequence of +records, one per employee, and if the employee name is the CAR of +each record, then that division can use ASSOC as its get-record +procedure, by saying + + (put 'get-record 'manufacturing assoc) + +in its package-installation procedure. + + +(b) The salary field might be in a different place in each +division's files, so we have to use the right selector based +on the division tag. + +(define (get-salary record) + (apply-generic 'salary record)) + +Each division's package must include a salary selector, comparable +to the magnitude selectors in the complex number example. + +Why did I use GET directly in (a) but apply-generic in (b)? In the +case of get-salary, the argument is a type-tagged datum. But in the +case of get-record, there are two arguments, only one of which (the +division file) has a type tag. The employee name, I'm assuming, +is not tagged. + + +(c) Find an employee in any division + +(define (find-employee-record employee divisions) + (cond ((null? divisions) (error "No such employee")) + ((get-record employee (car divisions))) + (else (find-employee-record employee (cdr divisions))))) + +This uses the feature that a cond clause with only one expression +returns the value of that expression if it's not false. + + +(d) To add a new division, you must create a package for the division, +make sure the division's personnel file is tagged with the division name, +and add the division's file to the list of files used as argument to +find-employee-record. + + +4. Scheme-1 stuff. + +(a) ((lambda (x) (+ x 3)) 5) + +Here's how Scheme-1 handles procedure calls (this is a COND clause +inside EVAL-1): + + ((pair? exp) (apply-1 (eval-1 (car exp)) ; eval the operator + (map eval-1 (cdr exp)))); eval the args + +The expression we're given is a procedure call, in which the procedure +(lambda (x) (+ x 3)) is called with the argument 5. + +So the COND clause ends up, in effect, doing this: + + (apply-1 (eval-1 '(lambda (x) (+ x 3))) (map eval-1 '(5))) + +Both lambda expressions and numbers are self-evaluating in Scheme-1, +so after the calls to EVAL-1, we are effectively saying + + (apply-1 '(lambda (x) (+ x 3)) '(5)) + +APPLY-1 will substitute 5 for X in the body of the +lambda, giving the expression (+ 5 3), and calls EVAL-1 +with that expression as argument. This, too, is a procedure call. +EVAL-1 calls itself recursively to evaluate +the symbol + and the numbers 5 and 3. The numbers are self-evaluating; +EVAL-1 evaluates symbols by using STk's EVAL, so it gets the primitive +addition procedure. Then it calls APPLY-1 with that procedure and +the list (5 3) as its arguments. APPLY-1 recognizes that the addition +procedure is primitive, so it calls STk's APPLY, which does the +actual addition. + + +(b) As another example, here's FILTER: + +((lambda (f seq) + ((lambda (filter) (filter filter pred seq)) + (lambda (filter pred seq) + (if (null? seq) + '() + (if (pred (car seq)) + (cons (car seq) (filter filter pred (cdr seq))) + (filter filter pred (cdr seq))))))) + even? + '(5 77 86 42 9 15 8)) + + +(c) Why doesn't STk's map work in Scheme-1? It works for primitives: + + Scheme-1: (map first '(the rain in spain)) + (t r i s) + +but not for lambda-defined procedures: + + Scheme-1: (map (lambda (x) (first x)) '(the rain in spain)) + Error: bad procedure: (lambda (x) (first x)) + +This problem illustrates the complexity of having two Scheme interpreters +coexisting, STk and Scheme-1. In Scheme-1, lambda expressions are +self-evaluating: + + Scheme-1: (lambda (x) (first x)) + (lambda (x) (first x)) + +But in STk, lambda expressions evaluate to procedures, which are a different +kind of thing: + + STk> (lambda (x) (first x)) + #[closure arglist=(x) 40179938] + +STk's MAP function requires an *STk* procedure as its argument, not a Scheme-1 +procedure! Scheme-1 uses STk's primitives as its primitives, so MAP is happy +with them. But a Scheme-1 lambda-defined procedure just isn't the same thing +as an STk lambda-defined procedure. + + +HOMEWORK: + +2.75 Message-passing version of make-from-mag-ang : + + (define (make-from-mag-ang r a) + (lambda (mesg) + (cond ((eq? mesg 'real-part) (* r (cos a))) + ((eq? mesg 'imag-part) (* r (sin a))) + ((eq? mesg 'magnitude) r) + ((eq? mesg 'angle) a) + (else + (error "Unknown op -- Polar form number" mesg)) )) ) + +Note that the formal parameter names X and Y that the book uses in +make-from-real-imag (p. 186) are relatively sensible because they are +indeed the x and y coordinates of a point in the plane. X and Y +are confusing as names for polar coordinates! I used R and A, for +Radius and Angle, but MAGNITUDE and ANGLE would be okay, too. + +I could have used an internal definition, as they do, instead of +lambda; the two forms are equivalent. + + +2.76 Compare conventional, data-directed, and message-passing. + +To add a new operator: + +First we must write a low-level procedure for that operator for each type, +like (magnitude-rectangular) and (magnitude-polar) if we're adding the +operator magnitude. (If we're using a package system, we can add a +local definition of MAGNITUDE to each package.) Then... + +For conventional style, we write a generic operator procedure +(magnitude) that invokes the appropriate lower-level procedure +depending on the type of its operand. + +For data-directed style, we use PUT to insert entries in the +procedure matrix for each low-level procedure; there is no new +high-level procedure required. + +For message-passing style, we modify each of the type dispatch +procedures to accept a new message corresponding to the new +operator, dispatching to the appropriate low-level procedure. + +To add a new type: + +First we must write a low-level procedure for that type for each +operator, like (real-part-polar), (imag-part-polar), +(magnitude-polar), and (angle-polar) if we're inventing the +polar type. (If we're using a package system, we can create +a new POLAR package with local definitions of REAL-PART, etc.) +Then... + +For conventional style, we modify each of the generic operator +procedures (real-part), (imaginary-part), etc. to know about the +new type, dispatching to the appropriate lower-level procedures. + +For data-directed style, we use PUT to insert entries, as for +a new operator. + +For message-passing style, we write a new type dispatch procedure +that accepts messages 'real-part, 'imag-part, etc. and dispatches +to the appropriate lower-level procedure. + +Which is most appropriate: + +Conventional style is certainly INappropriate when many new types +will be invented, because lots of existing procedures need to be +modified. + +Similarly, message-passing is INappropriate when many new operators +will be invented and applied to existing types. + +Data-directed programming is a possible solution in either case, and is +probably the best choice if both new types and new operators are likely. +It's also a good choice if the number of types or operators is large in +the first place, whether or not new ones will be invented, because it +minimizes the total number of procedures needed (leaving out the generic +dispatch procedures for each type or operator) and thereby reduces the +chances for error. + +As you'll see in chapter 3, message-passing style takes on new importance +when a data object needs to keep track of local state. But you'll see +later in the chapter (mutable data) that there are other solutions to +the local state problem, too. + +Message-passing is also sometimes sensible when there are lots of types, +each of which has its own separate set of operators with unique names, so +that a data-directed array would be mostly empty. + + +2.77 + +Starting with + + (magnitude '(complex rectangular 3 . 4)) + +we call MAGNITUDE giving + + (apply-generic 'magnitude '(complex rectangular 3 . 4)) + +The apply-generic function (see pg. 184) just uses GET to find the +entry corresponding to 'magnitude and '(complex), and gets the same +function MAGNITUDE that we invoked in the first place. This +time, however, the argument to MAGNITUDE is (CONTENTS OBJ) +so that the first type flag (COMPLEX) is removed. In other +words, we end up calling + + (magnitude '(rectangular 3 . 4)) + +Calling the function MAGNITUDE again, this becomes : + + (apply-generic 'magnitude '(rectangular 3 . 4)) + +The apply-generic function now looks up the entry for 'magnitude and +'(rectangular) and finds the MAGNITUDE function from the RECTANGULAR +package; that function is called with '(3 . 4) as its argument, which +yields the final answer... (sqrt (square 3) (square 4)) ==> 5 + + +2.79 equ? + +(define (equ? a b) + (apply-generic 'equ? a b)) + +In the scheme-number package: + + (put 'equ? '(scheme-number scheme-number) =) + +In the rational package: + + (define (equ-rat? x y) + (and (= (numer x) (numer y)) + (= (denom x) (denom y)))) + ... + (put 'equ? '(rational rational) equ-rat?) + +In the complex package: + + (define (equ-complex? x y) + (and (= (real-part x) (real-part y)) + (= (imag-part x) (imag-part y)))) + ... + (put 'equ? '(complex complex) equ-complex?) + +This technique has the advantage that you can compare for equality +a complex number in rectangular form with a complex number in polar +form, since the latter is implicitly converted to rectangular by +equ-complex?. But it has the disadvantage that when comparing +two complex numbers in polar form, it needlessly does the arithmetic +to convert them both to rectangular coordinates. (On the other +hand, if you want a polar-specific version of equ?, you have to +remember that the angles can differ by a multiple of 2*pi and the +numbers are still equal!) + + +2.80 =zero? + +(define (=zero? num) + (apply-generic '=zero? num)) + +In the scheme-number package: + + (put '=zero? '(scheme-number) zero?) + +In the rational package: + + (put '=zero? '(rational) + (lambda (n) (equ? n (make-rational 0 1)))) + +In the complex package: + + (put '=zero? '(complex) + (lambda (n) (equ? n (make-complex-from-real-imag 0 0)))) + +Of course I could have used internal defines instead of lambda +here. And of course once we invent raising it gets even easier; +I can just say + +(define (=zero? num) + (equ? num (make-scheme-number 0))) + +because then mixed-type equ? calls will be okay. + + +2.81 Louis messes up again + +(a) This will result in an infinite loop. Suppose we have two +complex numbers c1 and c2, and we try (exp c1 c2). Apply-generic +will end up trying to compute + + (apply-generic 'exp (complex->complex c1) c2) + +but this is the same as + + (apply-generic 'exp c1 c2) + +which is what we started with. + + +(b) Louis is wrong. If we have a complex exponentiation procedure +and we PUT it into the table, then apply-generic won't try to convert +the complex arguments. And if we don't have a complex exponentiation +procedure, then apply-generic correctly gives an error message; there's +nothing better it can do. + +(Once we invent the idea of raising, it would be possible to modify +apply-generic so that if it can't find a function for the given +type(s), it tries raising the operand(s) just in case the operation +is implemented for a more general type. For instance, if we try to +apply EXP to two rational numbers, apply-generic could raise them to +real and then the version of EXP for the scheme-number type will work. +But it's tricky to get this right, especially when there are two +operands -- should we raise one of them, or both?) + +(c) Nevertheless, here's how it could be done: + + (let ((type1 (car type-tags)) + (type2 (cadr type-tags)) + (a1 (car args)) + (a2 (cadr args))) + (IF (EQ? TYPE1 TYPE2) + (ERROR "CAN'T COERCE SAME TYPES" TYPE1) + (let ((t1->t2 (get-coercion type1 type2)) + (t2->t1 (get-coercion type2 type1))) + ...))) + + +2.83 Implementation of "raise" operators taking numbers to the next +level "up" in the hierarchy -- i.e. the next more general type: + + integer -> rational -> real -> complex + +The package system as presented in the text has to be modified a little, +because now instead of having a scheme-number type we want two separate +types integer and real. So start by imagining we have two separate +packages, one for integer and one for real. + +In each package we need an operation to raise that kind of number +to the next type up: + +In the integer package: + + (define (integer->rational int) + (make-rational int 1)) + (put 'raise '(integer) integer->rational) + +In the rational package: + + (define (rational->real rat) + (make-real (/ (numer rat) (denom rat)))) + (put 'raise '(rational) rational->real) + +In the real package: + + (define (real->complex Real) + (make-complex-from-real-imag real 0)) + (put 'raise '(real) real->complex) + +And then we can make this global definition: + +(define (raise num) (apply-generic 'raise num)) + +If you want to keep the Scheme-number package, you need a raise method +that distinguishes integers from non-integers internally, which sort of +goes against the whole idea of centralizing the type checking: + + (define (scheme-number->something num) + (if (integer? num) + (make-rational num 1) + (make-complex-from-real-imag num 0))) + + (put 'raise '(scheme-number) scheme-number->something) + + + +Scheme-1 MAP: + +We're writing a defined procedure in STk that will be a primitive +procedure for Scheme-1. So we get to use all the features of STk, +but we have to be sure to handle Scheme-1's defined procedures. +(See this week's lab, above, problem 4c.) + +(define (map-1 fn seq) + (if (null? seq) + '() + (cons (APPLY-1 FN (LIST (CAR SEQ))) + (map-1 fn (cdr seq))))) + +The part in capital letters is the only difference between map-1 and the +ordinary definition of map. We can't just say (FN (CAR SEQ)) the way map +does, because FN might not fit STk's idea of a function, and our procedure is +running in STk, even though it provides a primitive for Scheme-1. + +You could make this more complicated by testing for primitive vs. defined +Scheme-1 procedures. For primitives you could say (FN (CAR SEQ)). But +since APPLY-1 is happy to accept either a primitive or a lambda expression, +there's no reason not to use it for both. + + +SCHEME-1 LET: + +Here's what a LET expression looks like: + + (LET ((name1 value1) (name2 value2) ...) body) + +A good starting point is to write selectors to extract the pieces. + +(define let-exp? (exp-checker 'let)) + +(define (let-names exp) + (map car (cadr exp)) + +(define (let-values exp) + (map cadr (cadr exp)) + +(define let-body caddr) + +As in last week's lab exercise, we have to add a clause to the COND in EVAL-1: + +(define (eval-1 exp) + (cond ((constant? exp) exp) + ((symbol? exp) (error "Free variable: " exp)) + ((quote-exp? exp) (cadr exp)) + ((if-exp? exp) + (if (eval-1 (cadr exp)) + (eval-1 (caddr exp)) + (eval-1 (cadddr exp)))) + ((lambda-exp? exp) exp) + ((and-exp? exp) (eval-and (cdr exp))) ;; added in lab + ((LET-EXP? EXP) (EVAL-LET EXP)) ;; ADDED + ((pair? exp) (apply-1 (car exp) + (map eval-1 (cdr exp)))) + (else (error "bad expr: " exp)))) + +We learned in week 2 that a LET is really a lambda combined with a +procedure call, and one way we can handle LET expressions is just to +rearrange the text to get + + ( (LAMBDA (name1 name2 ...) body) value1 value2 ... ) + +(define (eval-let exp) + (eval-1 (cons (list 'lambda (let-names exp) (let-body exp)) + (let-values exp)))) + +Isn't that elegant? It's certainly not much code. You might not like +the idea of constructing an expression just so we can tear it back down +into its pieces for evaluation, so instead you might want to do the +evaluation directly in terms of the meaning, which is to APPLY an +implicit procedure to arguments: + +(define (eval-let exp) + (apply-1 (list 'lambda (let-names exp) (let-body exp)) + (map eval-1 (let-values exp)))) + +We still end up constructing the lambda expression, because in this +interpreter, a procedure is represented as the expression that created +it. (We'll see later that real Scheme interpreters have to represent +procedures a little differently.) But we don't construct the procedure +invocation as an expression; instead we call apply-1, and we also +call eval-1 for each argument subexpression. + + + +Extra for experts: + +First of all, there's no reason this shouldn't work for anonymous +procedures too... + +(define (inferred-types def) + (cond ((eq? (car def) 'define) + (inf-typ (cdadr def) (caddr def))) + ((eq? (car def) 'lambda) + (inf-typ (cadr def) (caddr def))) + (else (error "not a definition")))) + +Then the key point is that this is a tree recursion. For an expression +such as (append (a b) c '(b c)) we have to note that C is a list, but +we also have to process the subexpression (a b) to discover that A is +a procedure. + +All of the procedures in this program return an association list as +their result. We start by creating a list of the form + + ((a ?) (b ?) (c ?) (d ?) (e ?) (f ?)) + +and then create modified versions as we learn more about the types. + +(define (inf-typ params body) + (inf-typ-helper (map (lambda (name) (list name '?)) params) body)) + +(define (inf-typ-helper alist body) + (cond ((not (pair? body)) alist) + ((assoc (car body) alist) + (inf-typ-seq (typ-subst (car body) 'procedure alist) (cdr body))) + ((eq? (car body) 'map) (inf-map alist body 'list)) + ((eq? (car body) 'every) (inf-map alist body 'sentence-or-word)) + ((eq? (car body) 'member) (typ-subst (caddr body) 'list alist)) + ((memq (car body) '(+ - max min)) (seq-subst (cdr body) 'number alist)) + ((memq (car body) '(append car cdr)) (seq-subst (cdr body) 'list alist)) + ((memq (car body) '(first butfirst bf sentence se member?)) + (seq-subst (cdr body) 'sentence-or-word alist)) + ((eq? (car body) 'quote) alist) + ((eq? (car body) 'lambda) (inf-lambda alist body)) + (else (inf-typ-seq alist (cdr body))))) + +(define (typ-subst name type alist) + (cond ((null? alist) '()) + ((eq? (caar alist) name) + (cons (list name + (if (or (eq? (cadar alist) '?) + (eq? (cadar alist) type)) + type + 'x)) + (cdr alist))) + (else (cons (car alist) (typ-subst name type (cdr alist)))))) + +(define (inf-typ-seq alist seq) + (if (null? seq) + alist + (inf-typ-seq (inf-typ-helper alist (car seq)) (cdr seq)))) + +(define (inf-map alist body type) + (if (pair? (cadr body)) + (inf-typ-helper (typ-subst (caddr body) type alist) + (cadr body)) + (typ-subst (cadr body) 'procedure (typ-subst (caddr body) type alist)))) + +(define (seq-subst seq type alist) + (cond ((null? seq) alist) + ((pair? (car seq)) + (seq-subst (cdr seq) type (inf-typ-helper alist (car seq)))) + (else (seq-subst (cdr seq) type (typ-subst (car seq) type alist))))) + +(define (inf-lambda alist exp) + ((repeated cdr (length (cadr exp))) + (inf-typ-helper (append (map (lambda (name) (list name '?)) (cadr exp)) + alist) + (caddr exp)))) + + + +Note -- the check for lambda in inf-typ-helper is meant to handle cases +like the following: + +> (inferred-types + '(lambda (a b) (map (lambda (a) (append a a)) b))) +((a ?) (b list)) + +The (append a a) inside the inner lambda does NOT tell us anything +about the parameter A of the outer lambda! diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week9 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week9 new file mode 100644 index 0000000..f5489e8 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week9 @@ -0,0 +1,570 @@ +CS 61A -- Week 9 solutions + +LAB ACTIVITIES: + +1. Use a LET to keep both initial and current balance + +(define (make-account init-amount) + (let ((BALANCE INIT-AMOUNT)) ;;; This is the change. + (define (withdraw amount) + (set! balance (- balance amount)) balance) + (define (deposit amount) + (set! balance (+ balance amount)) balance) + (define (dispatch msg) + (cond + ((eq? msg 'withdraw) withdraw) + ((eq? msg 'deposit) deposit))) + dispatch)) + + +2. Add messages to read those variables. + +(define (make-account init-amount) + (let ((balance init-amount)) + (define (withdraw amount) + (set! balance (- balance amount)) balance) + (define (deposit amount) + (set! balance (+ balance amount)) balance) + (define (dispatch msg) + (cond + ((eq? msg 'withdraw) withdraw) + ((eq? msg 'deposit) deposit) + ((EQ? MSG 'BALANCE) BALANCE) ;; two lines added here + ((EQ? MSG 'INIT-BALANCE) INIT-AMOUNT))) + dispatch)) + + +3. Add transaction history. + +(define (make-account init-amount) + (let ((balance init-amount) + (TRANSACTIONS '())) ;; add local state var + (define (withdraw amount) + (SET! TRANSACTIONS (APPEND TRANSACTIONS + (LIST (LIST 'WITHDRAW AMOUNT)))) ;; update + (set! balance (- balance amount)) balance) + (define (deposit amount) + (SET! TRANSACTIONS (APPEND TRANSACTIONS + (LIST (LIST 'DEPOSIT AMOUNT)))) ;; update + (set! balance (+ balance amount)) balance) + (define (dispatch msg) + (cond + ((eq? msg 'withdraw) withdraw) + ((eq? msg 'deposit) deposit) + ((eq? msg 'balance) balance) + ((eq? msg 'init-balance) init-amount) + ((EQ? MSG 'TRANSACTIONS) TRANSACTIONS))) ;; message to examine it + dispatch)) + + +4. Why substitution doesn't work. + +(plus1 5) becomes + +(set! 5 (+ 5 1)) +5 + +The first line (the SET!) is syntactically wrong; "5" isn't a variable +and it doesn't make sense to substitute into an unevaluated part of a +special form. + +The second line (returning the value 5) is syntactically okay but +gives the wrong answer; it ignores the fact that the SET! was supposed +to change the result. + + +HOMEWORK: + +3.3 Accounts with passwords + +(define (make-account balance password) + (define (withdraw amount) ; Starting here exactly as in p. 223 + (if (>= balance amount) + (begin (set! balance (- balance amount)) + balance) + "Insufficient funds")) + (define (deposit amount) + (set! balance (+ balance amount)) + balance) + (define (dispatch pw m) ; Starting here different because of pw + (cond ((not (eq? pw password)) + (lambda (x) "Incorrect password")) + ((eq? m 'withdraw) withdraw) ; Now the same again + ((eq? m 'deposit) deposit) + (else (error "Unknown request -- MAKE-ACCOUNT" + m)))) + dispatch) + +The big question here is why withdraw can get away with returning + "Insufficient funds" +while dispatch has to return this complicated + (lambda (x) "Incorrect password") +The answer is that ordinarily the result returned by withdraw is supposed +to be a number, which is just printed. In case of an error, withdraw can +return a string instead, and that string will just get printed. But +dispatch is ordinarily supposed to return a PROCEDURE. In the example + ((acc 'some-other-password 'deposit) 50) +if dispatch just returned the string, it would be as if we'd typed + ("Incorrect password" 50) +which makes no sense. Instead this version is as if we typed + ((lambda (x) "Incorrect password") 50) +which does, as desired, print the string. + +A simpler solution would be to say (error "Incorrect password") because +the ERROR primitive stops the computation and returns to toplevel after +printing its argument(s). But you should understand the version above! + + +3.4 call-the-cops + +(define (make-account balance password) + (define error-count 0) ; THIS LINE ADDED + (define (withdraw amount) + (if (>= balance amount) + (begin (set! balance (- balance amount)) + balance) + "Insufficient funds")) + (define (deposit amount) + (set! balance (+ balance amount)) + balance) + (define (dispatch pw m) + (cond ((eq? pw password) ; REARRANGED STARTING HERE + (set! error-count 0) + (cond ((eq? m 'withdraw) withdraw) + ((eq? m 'deposit) deposit) + (else (error "Unknown request -- MAKE-ACCOUNT" + m)) )) + (else + (set! error-count (+ error-count 1)) + (if (> error-count 7) (call-the-cops)) + (lambda (x) "Incorrect password") ))) + dispatch) + +In this version, call-the-cops will be invoked before the dispatch procedure +goes on to return the nameless procedure that will, eventually, be invoked and +print the string "Incorrect password", so whatever call-the-cops prints will +appear before that message. If you'd like it to appear instead of the string, +change the last few lines to + + (lambda (x) + (if (> error-count 7) + (call-the-cops) + "Incorrect password")) + + +3.7 Joint accounts + +What we want here is a new dispatch procedure that has access to the same +environment frame containing the balance of the original account. You could +imagine a complicated scheme in which we teach make-account's dispatch +procedure a new message, make-joint, such that + ((acc 'old-password 'make-joint) 'new-password) +will return a new dispatch procedure in a new frame with its own password +binding but inheriting acc's balance binding. This can work, and we'll +do it later in this solution, but it's a little tricky because you have to +avoid the problem of needing to write a complete dispatch procedure within +a cond clause in the dispatch procedure! + +Instead, one thing to do is to create a new function that invokes f from +within a prepared frame. + +Here is a first, simple version that does almost what we want: + +(define (make-joint old-acc old-pw new-pw) + (lambda (pw m) + (if (eq? pw new-pw) + (old-acc old-pw m) + (lambda (x) "Incorrect password")))) + +It's important to understand how easy this is if we're willing to treat +the old account procedure as data usable in this new make-joint procedure. +This version works fine, with proper password protection, but it differs +in one small detail from what the problem asked us to do. I'd be very happy +with this version of the program, but for those of you who are sticklers for +detail, here's a discussion of the problem and a revised solution. + +Suppose you don't know the password of the old account but you try to make a +joint-account by guessing. Make-joint will return a procedure, without +complaining, and it isn't until you try to use that returned procedure that +the old account will complain about getting the wrong password. The problem +says, "The second argument must match the password with which the account +was defined in order for the make-joint operation to proceed." They want us +to catch a password error as soon as make-joint itself is invoked. To do +this, make-joint must be able to ask old-acc whether or not the given old-pw +is correct. So we'd like a verify-password message so that + +==> (peter-acc 'open-sesame 'verify-password) +#t +==> (peter-acc 'garply 'verify-password) +#f + +Given such a facility in make-account, we can write make-joint this way: + +(define (make-joint old-acc old-pw new-pw) + (if (old-acc old-pw 'verify-password) + (lambda (pw m) + (if (eq? pw new-pw) + (old-acc old-pw m) + (lambda (x) "Incorrect password"))) + (display "Incorrect password for old account"))) + +This approach only makes sense if we use (display ...) to signal the error. +We can't just return a string because the string won't be printed; it'll +be bound to a symbol like paul-acc as that symbol's value. Later, when we +try to invoke paul-acc as a procedure, we'll get a "Application of +non-procedure object" error message. We also can't just do the trick of +returning (lambda (x) "string"). That won't blow up our program, but again +the printing of the error message won't happen until paul-acc is applied to +something. If we wanted to wait until then to see the error message, we +could just use my first solution. So we're stuck with explicitly printing +the message. What gets returned is whatever print returns; if we ignore +the message and try to invoke paul-acc later, it'll blow up. + +To make this work we need to invent the verify-password message: + +(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 pw m) + (cond ((eq? m 'verify-password) ; This clause is new + (eq? pw password)) + ((not (eq? pw password)) + (lambda (x) "Incorrect password")) + ((eq? m 'withdraw) withdraw) + ((eq? m 'deposit) deposit) + (else (error "Unknown request -- MAKE-ACCOUNT" + m)))) + dispatch) + +Note the order of the cond clauses in dispatch. The verify-password message +is not considered an error even if the password doesn't match; it just returns +#f in that case. So we first check for that message, then if not we check +for an incorrect password, then if not we check for the other messages. + +By the way, we could avoid inventing the new verify-password method by using +the existing messages in an unusual way. Instead of + +(define (make-joint old-acc old-pw new-pw) + (if (old-acc old-pw 'verify-password) + ...)) + +we could say + +(define (make-joint old-acc old-pw new-pw) + (if (NUMBER? ((OLD-ACC OLD-PW 'DEPOSIT) 0)) + ...) + + +If you want to add a make-joint message to the account dispatch procedure, +the corresponding method has to return a new dispatch procedure. This is +the approach that I rejected earlier as too complicated, but it's not bad +once you understand how to do it: instead of having a + (define (dispatch pw m) ...) +so that there is one fixed dispatch procedure, you do the object-oriented +trick of allowing multiple dispatch procedure objects, so we have a +higher-order procedure that makes dispatch procedures. Every time a new +person is added to the account, we make a new dispatch procedure for that +person, with a new password. Even the first user of the account gets a +dispatch procedure through this mechanism, as you'll see below: + +(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 (new-dispatch new-pw) ; This is new. We have a dispatch maker + (lambda (pw m) ; instead of just one dispatch procedure. + (cond ((not (eq? pw new-pw)) + (lambda (x) "Incorrect password")) + ((eq? m 'withdraw) withdraw) + ((eq? m 'deposit) deposit) + ((eq? m 'make-joint) new-dispatch) + (else (error "Unknown request -- MAKE-ACCOUNT" + m))))) + (new-dispatch password)) ; We have to make a dispatcher the first time too. + + +3.8 Procedure for which order of evaluation of args matters + +The procedure f will be invoked twice. We want the results to depend on the +past invocation history. That is, (f 1) should have a different value +depending on whether or not f has been invoked before. + +Given the particular values we're supposed to produce, I think the easiest +thing is if (f 0) is always 0, while (f 1) is 1 if (f 0) hasn't been invoked +or 0 if it has. + +(define f + (let ((history 1)) + (lambda (x) + (set! history (* history x)) + history))) + +If we evaluate (f 1) first, then history has the value 1, and the result (and +new value of history) is (* 1 1) which is 1. On the other hand, if we +evaluate (f 0) first, that sets history to 0, so a later (f 1) returns +(* 0 1) which is 0. + +The above solution only works the first time we try + (+ (f 0) (f 1)) +however. After the first time, (f x) always returns 0 for any x. Here's +another solution that doesn't have that defect: + +(define f + (let ((invocations 0)) + (lambda (x) + (set! invocations (+ invocations 1)) + (cond ((= x 0) 0) + ((even? invocations) 0) + (else 1))))) + +Many other possible solutions are equally good. + + +3.10 Let vs. parameter + + args: initial-amount + --> body: (let ...) +global env: | +|------------------------------| | +| make-withdraw: --------------------> (function) --> global env +| | +| W1: -- (this pointer added later) -> (function A below) +| | +| W2: -- (this one added later too) -> (function B below) +|------------------------------| + +The first invocation of make-withdraw creates a frame + +E1: +|--------------------| +|initial-amount: 100 |---> global env +|--------------------| + +and in that frame evaluates the let, which makes an unnamed function + + (function) --> E1 + | + | args: balance + ---> body: (lambda (amount) ...) + +then the same let applies the unnamed function to the argument expression +initial-amount. We are still in frame E1 so initial-amount has value 100. +To apply the function we make a new frame: + +E2: +|--------------------| +|balance: 100 |---> E1 +|--------------------| + +Then in that frame we evaluate the body, the lambda expression: + + (function A) --> E2 + | + | args: amount + ---> body: (if ...) + +Then the outer define makes global W1 point to this function. + +Now we do (W1 50). This creates a frame: + +E3: +|------------| +|amount: 50 |---> E2 +|------------| + +Frame E3 points to E2 because function A (i.e. W1) points to E2. +Within frame E3 we evaluate the body of function A, the (if ...). +During this evaluation the symbol AMOUNT is bound in E3, while +BALANCE is bound in E2. So the set! changes BALANCE in E2 from +100 to 50. + +Now we make W2, creating two new frames in the process: + +E4: +|--------------------| +|initial-amount: 100 |---> global env +|--------------------| + + (function) --> E4 + | + | args: balance + ---> body: (lambda (amount) ...) + +E5: +|--------------------| +|balance: 100 |---> E4 +|--------------------| + + (function B) --> E5 + | + | args: amount + ---> body: (if ...) + +Then the outer define makes global W2 point to this function. + +Summary: the two versions of make-withdraw create objects with the same +behavior because in each case the functions A and B are defined within +individual frames that bind BALANCE. The environment structures differ +because this new version has, for each account, an extra frame containing +the binding for initial-amount. + + + +================================================== + + + +3.11 Message-passing example + +global env: +|------------------------------| +| make-account: --------------------> (function) ---> global env +| | +| acc: --(pointer added later)------> (function A below) +|------------------------------| + +When we (define acc (make-account 50)), a new frame is created that +includes both make-account's parameters (balance) and its internal +definitions (withdraw, deposit, dispatch): + +E1: +|------------------------------| +| balance: 50 |----> global env +| | +| withdraw: -------------------------> (function W) ---> E1 +| | +| deposit: --------------------------> (function D) ---> E1 +| | +| dispatch: -------------------------> (function A) ---> E1 +|------------------------------| + +(The arrow I have in the top right corner has nothing to do with the +binding of BALANCE; it's the back pointer for this frame.) + +At this point the symbol ACC is bound, in the global environment, to +function A. + +Now we do ((acc 'deposit) 40). + +E2: +|--------------------| +| m: deposit |----> E1 +|--------------------| + +The above results from evaluating (acc 'deposit), whose returned value is +function D above. + +E3: +|--------------------| +| amount: 40 |----> E1 +|--------------------| + +The above frame results from (D 40) [so to speak]. Note that its back +pointer points to E1, not E2, because that's what D points to. Now we +evaluate the body of D, which includes (set! balance (+ balance amount)) +The value for AMOUNT comes from E3, and the value for BALANCE from E1. +The set! changes the value to which BALANCE is bound in E1, from 50 to 90. + +((acc 'withdraw) 60) + +similarly creates two new frames: + +E4: +|--------------------| +| m: withdraw |----> E1 +|--------------------| + +E5: +|--------------------| +| amount: 60 |----> E1 +|--------------------| + +Again BALANCE is changed in E1, which is where ACC's local state is kept. +If we define another account ACC2, we'll produce a new frame E6 that has +the same symbols bound that E1 does, but bound to different things. The +only shared environment frame between ACC1 and ACC2 is the global environment. +The functions in E6 are *not* the same as the functions D, W, and A in E1. +(They may, depending on the implementation, have the same list structure +as their bodies, but they don't have the same environment pointers.) + + +Extra for experts: + +First the easy part, generating unique symbols: + +(define gensym + (let ((number 0)) + (lambda () + (set! number (+ number 1)) + (word 'g number)))) + +Each call to GENSYM generates a new symbol of the form G1, G2, etc. +(This isn't a perfect solution; what if there is a global variable +named G1 that's used within the argument expression? But we won't worry +about that for now -- there are solutions, but they're pretty complicated.) + +The renaming procedure will need to keep an association list with +entries converting symbols in the argument expression to gensymmed symbols. + +The problem says that all *local* variables are to be renamed. Symbols +that aren't bound within this expression (such as names of primitive +procedures!) will remain unchanged in the result. + +(define (unique-rename exp) + (define (lookup sym alist) ; find replacement symbol + (let ((entry (assoc sym alist))) + (if entry + (cdr entry) + sym))) ; not in alist, keep original + + (define (make-newnames vars) ; make (old . new) pairs for lambda + (map (lambda (var) (cons var (gensym))) vars)) + + (define (help exp alist) + (cond ((symbol? exp) (lookup sym alist)) + ((atom? exp) exp) ; self-evaluating + ((equal? (car exp) 'lambda) + (let ((newnames (make-newnames (cadr exp)))) + (let ((newalist (append newnames alist))) + (cons 'lambda + (cons (map cdr newalist) + (map (lambda (subexp) (help subexp newalist)) + (cddr exp))))))) + (else (map (lambda (subexp) (help subexp alist)) exp)))) + (help exp '())) + +There are four cases in the COND: +1. A symbol is replaced by its gensym equivalent. +2. A non-symbol atom is returned unchanged (self-evaluating expression). +3. A lambda expression is processed by making a new gensym name for each + of its parameters (found in the cadr of the lambda expression), then + making a new association list with these new pairs in front (so that + the new ones will be seen first by assoc and will take preference over + the same name used in an outer lambda), then recursively rename all the + expressions in the body of the lambda expression. +4. A compound expression that isn't a lambda is processed by recursively + renaming all its subexpressions. + + +The way to use unique-rename to allow evaluation of Scheme programs +with only one frame is that on every procedure call, the evaluator +should call unique-rename on the procedure that the user is trying +to call, then call the resulting modified procedure. You can't just +call unique-rename when the procedure is created (by a lambda +expression), because of recursive procedures. Many recursive +invocations might be active at the same time, and each of them needs +a unique renaming. + +We'll see that something very similar to this is actually done +in the query-language evaluator in week 15. |