tag:blogger.com,1999:blog-24155801894982112372018-03-06T02:52:38.083-05:00William BruschiBillyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.comBlogger86125tag:blogger.com,1999:blog-2415580189498211237.post-54577614222960005532011-01-13T21:54:00.000-05:002011-01-13T21:54:43.120-05:00Where am I?I'm moving over to my new site: <a href="http://www.williambruschi.net">http://www.williambruschi.net</a>. I leave this site up though. See you over there!Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-88995304949887445062010-08-27T19:26:00.002-04:002011-01-13T22:15:59.903-05:00Book Review: Agile project management with Scrum by Ken SchwaberIn the world of software development, managers have deployed many<br />strategies over the years to guide complex software projects. As the<br />result of the numerous headaches and failures, different methodologies<br />have arisen that try to handle the malleable process of developing<br />software. The so-called waterfall approach, a mirror image of<br />traditional management of most non-software projects, first<br />entails producing an unequivocal specification that theoretically<br />leads to a simple implementation process.<br /><br />Nevertheless, this waterfall approach failed time and time again for<br />many software projects. In comes the Agile software development<br />approach. It encourages rapid and incremental development, continuous<br />communication with the customers, adaptation and self organizing<br />teams.<br /><br />Scrum is a method of agile software development, and <a href="http://www.amazon.com/gp/product/073561993X?ie=UTF8&tag=wb07b-20&linkCode=as2&camp=1789&creative=9325&creativeASIN=073561993X">Agile Project Management with Scrum by Ken Schwaber</a> gives<br />real life stories of teams that used scrum successfully and<br />unsuccessfully. The stories are short and illustrative of common<br />pitfalls and misunderstandings that teams encounter when first using<br />Scrum. For example, one such story told of a Scrum Master running the<br />daily scrum meeting, asking each developer what he/she has<br />accomplished and assigning them their next task. This is a major<br />violation of Scrum; Scrum teams are self managed. The Scrum Master<br />facilitates the use of Scrum for the project, but scrum teams decide<br />who works on what and the best way to get the job done correctly.<br /><br />This book was a quick read and great introduction to Scrum. No<br />software development process is perfect, however, and neither will any<br />new methodologies that may appear in the future be either. In my ideal<br />world of software projects, developers should never need to attend<br />meetings, interruptions will never spring up, and they will work<br />unbothered in "the flow" all day long. However, people need to<br />exchange information and software development is a team game. The<br />Scrum process seems to be a great way to boost productivity, satisfy<br />managers and stakeholders, and increase workplace moral.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-35253802540215287102010-08-15T15:03:00.002-04:002010-08-15T15:09:50.426-04:00Auto-generating VB PropertiesUnhappy with the lack of a sophisticated way to auto-generate public properties from private variables in Visual Studio, I turned to EMacs to implement my own version. The code at the end of this post is for VB.NET. It takes a buffer like this:<br /><br /><pre class="prettyprint">strLastName<br />strFirstName<br />intAmount<br />dblPrice<br /></pre><br />and changes it to this:<br /><br /><pre class="prettyprint">Private strLastName As String<br />Private strFirstName As String<br />Private intAmount As Integer<br />Private dblPrice As Double<br /><br />Public Property LastName() As String<br /> Get<br /> Return strLastName<br /> End Get<br /> Set(ByVal value As String)<br /> strLastName = value<br /> End Set<br />End Property<br /><br />Public Property FirstName() As String<br /> Get<br /> Return strFirstName<br /> End Get<br /> Set(ByVal value As String)<br /> strFirstName = value<br /> End Set<br />End Property<br /><br />Public Property Amount() As Integer<br /> Get<br /> Return intAmount<br /> End Get<br /> Set(ByVal value As Integer)<br /> intAmount = value<br /> End Set<br />End Property<br /><br />Public Property Price() As Double<br /> Get<br /> Return dblPrice<br /> End Get<br /> Set(ByVal value As Double)<br /> dblPrice = value<br /> End Set<br />End Property<br /></pre><br />You can easily configure the variable types it detects by modifying the alist *vb-types*. At work I have adjusted the template to expand into code complying with my company's coding guidelines. To use, visit a new buffer, type in the names of your private variables prefixed with a type designator, then type M-x props.<br /><br /><pre class="prettyprint lang-cl">(defconst *vb-types*<br /> '(("str" . "String")<br /> ("dbl" . "Double")<br /> ("int" . "Integer")))<br /><br />(defun var-name (var)<br /> (unless (< (length var) 4)<br /> (substring var 3)))<br /><br />(defun var-type (var)<br /> (unless (< (length var) 4)<br /> (let ((type (substring var 0 3)))<br /> (cdr (assoc type *vb-types*)))))<br /><br />(defun insert-private-vars (var)<br /> (let ((type (var-type var)))<br /> (when type<br /> (insert "Private " var " As " type)<br /> (newline))))<br /><br />(defun insert-properties (var)<br /> (let ((type (var-type var))<br /> (name (var-name var)))<br /> (when (and name type)<br /> (insert "<br />Public Property " name "() As " type "<br /> Get<br /> Return " var "<br /> End Get<br /> Set(ByVal value As " type ")<br /> " var " = value<br /> End Set<br />End Property<br />"))))<br /><br />(defun props ()<br /> (interactive)<br /> (let ((vars (split-string (buffer-string))))<br /> (erase-buffer)<br /> (mapc #'insert-private-vars vars)<br /> (newline) (newline)<br /> (mapc #'insert-properties vars)))<br /></pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-52295008011098570742010-07-05T11:23:00.004-04:002011-01-13T22:36:33.773-05:00Book Review: The Pragmatic Programmer: From Journeyman to Master<a href="http://www.amazon.com/gp/product/020161622X?ie=UTF8&tag=wb07b-20&linkCode=as2&camp=1789&creative=390957&creativeASIN=020161622X">The Pragmatic Programmer: From Journeyman to Master</a><img src="http://www.assoc-amazon.com/e/ir?t=wb07b-20&l=as2&o=1&a=020161622X" width="1" height="1" border="0" alt="" style="border:none !important; margin:0px !important;" /> was a quick and relatively fun read. The book covers many broad topics of everyday programming, such as project management, documentation, testing and automation. While reading I noticed that I already follow many of the principles outlined in the book, but reading it on paper helped encourage me to continue to do so. <br /><br />Most of material new to me concerned project management and customer relationships. Two such items include having a project glossary and choosing appropriate ways to pleasantly surprise customers. <br /><br />All programmers should know the book's material and practice it everyday. In my opinion, college's should require more reading of this type to help prepare students for the real world. Overall, it is a great book for professional programmers.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-65736914180985279272010-06-04T18:47:00.000-04:002010-06-04T18:47:26.275-04:00Book Review: Object-Oriented Programming in Common Lisp: A Programmer's Guide to CLOS by Sonya KeeneMany people unfamiliar with Common Lisp believe it's a purely<br />functional language, but this is untrue. While you can shape your<br />Common Lisp programs in a functional way, Common Lisp also support<br />Object Oriented Programming via CLOS, the Common Lisp Object<br />System. It is truly a multi-paradigm language.<br /><br />This books teaches all the aspects of CLOS, and although written<br />several years ago, the knowledge still applies today. After learning<br />about Object Oriented programming using languages like C++ and Java,<br />learning about CLOS really opened my eyes to what this style of<br />programming should feel like. All the other languages now seem to<br />constrained compared to the power and flexibility of CLOS.<br /><br />In CLOS, classes only have member variables, called slots, and support<br />multiple inheritance. They do not define methods. Instead, methods are<br />defined for Generic Functions which specialize on the classes. While<br />most OO languages use single dispatch, meaning methods specialize on<br />only one class, CLOS uses multiple dispatch. It also supports<br />specializing on distinct object instances. In addition to primary<br />methods, CLOS has before, after and around methods. You can even<br />dictate the order in which CLOS calls all of the applicable methods. <br /><br />I truly enjoyed this book as it expanding my understanding of object<br />oriented techniques. I hope the mainstream language designers can take<br />the time to read this and incorporate more of CLOS into today's<br />popular, but limited, object oriented systems.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-81151935679758557852010-05-31T11:22:00.000-04:002010-05-31T11:22:44.733-04:00SICP Problems Ch 3.1<pre class="prettyprint lang-cl">;;; SICP Section 3.1<br /><br />;;; 3.1<br />(defun make-accumulator (n)<br /> (lambda (x)<br /> (incf n x)))<br /><br />;;; 3.2<br />(defun make-monitored (f)<br /> (let ((count 0))<br /> (lambda (x)<br /> (cond ((eq x 'how-many-calls?) count)<br /> ((eq x 'reset-count) (setf count 0))<br /> (t (incf count)<br /> (funcall f x))))))<br /><br />;;; 3.3 and 3.4 - updated for 3.7<br />(defun make-account (balance password)<br /> (let ((consecutive-attempts 0))<br /> (labels ((withdraw (amount)<br /> (if (>= balance amount)<br /> (setf balance (- balance amount))<br /> "Insufficient funds"))<br /> (deposit (amount)<br /> (setf balance (+ balance amount)))<br /> (dispatch (pass m)<br /> (cond<br /> ;; Incorrect password?<br /> ((not (eq pass password))<br /> (lambda (x)<br /> (if (<= 7 (incf consecutive-attempts))<br /> "Calling cops"<br /> "Incorrect password")))<br /> ;; Withdrawing?<br /> ((eq m 'withdraw)<br /> (setf consecutive-attempts 0)<br /> #'withdraw)<br /> ;; Depositing?<br /> ((eq m 'deposit)<br /> (setf consecutive-attempts 0)<br /> #'deposit)<br /> ;; Creating joint account?<br /> ((eq m 'joint)<br /> (lambda (new-pass)<br /> (lambda (pass m)<br /> (if (eq pass new-pass)<br /> (funcall #'dispatch password m)<br /> (funcall #'dispatch nil m)))))<br /> (t (error "Unknown request -- MAKE-ACCOUNT")))))<br /> #'dispatch)))<br /><br />(defun withdraw (acc pwd amt)<br /> (funcall (funcall acc pwd 'withdraw) amt))<br /><br />(defun deposit (acc pwd amt)<br /> (funcall (funcall acc pwd 'deposit) amt))<br /><br />;;; 3.5<br />(defun random-in-range (low high)<br /> (let ((range (- high low)))<br /> (+ low (random range))))<br /><br />(defun monte-carlo (trials experiment)<br /> (labels ((iter (trials-remaining trials-passed)<br /> (cond ((= trials-remaining 0)<br /> (float (/ trials-passed trials)))<br /> ((funcall experiment)<br /> (iter (- trials-remaining 1) (+ trials-passed 1)))<br /> (t<br /> (iter (- trials-remaining 1) trials-passed)))))<br /> (iter trials 0)))<br /><br />(defun in-circle-p ()<br /> (let ((x (random-in-range 0 1.0))<br /> (y (random-in-range 0 1.0)))<br /> (<= (+ (expt (- x 0.5) 2)<br /> (expt (- y 0.5) 2))<br /> (expt 0.5 2))))<br /><br />(defun estimate-integral (p x1 x2 y1 y2 trials)<br /> (let ((area-of-rect (* (- x2 x1)<br /> (- y2 y1)))<br /> (frac-inside (monte-carlo trials p)))<br /> (* frac-inside area-of-rect)))<br /><br />;;; 3.6<br />(let ((st (make-random-state)))<br /> (defun rnd (sym)<br /> (cond ((eq sym 'generate)<br /> (lambda (x)<br /> (random x st)))<br /> ((eq sym 'reset)<br /> (lambda (x)<br /> (setf st x)))<br /> (t "Unknown symbol"))))<br /><br />;;; 3.7<br />(defun make-joint (acc pass new-pass)<br /> (funcall (funcall acc pass 'joint) new-pass))<br /><br />;;; 3.8<br />(let ((num 1))<br /> (defun f (n)<br /> (setf num (* num n))))<br /><br /></pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-23975124289806869482010-05-25T17:44:00.000-04:002010-05-25T17:44:56.359-04:00Sluggish performance on Ubuntu LucidI recently updated to Ubuntu Lucid and immediately noticed UI performance degradation after using it for a short while. The sluggish performance affected window switching and scrolling in Firefox/Chrome/Evince etc. Nothing on my system indicated a memory leak or chewed-up processor. <br /><br />I searched Ubuntu's bug tracking system and came across this <a href="https://bugs.launchpad.net/linux/+bug/562293">post</a>, which indicated the using the latest kernel version fix the problem. After following the steps <a href="http://ubuntuforums.org/showpost.php?p=9348970&postcount=8">here</a> to update my kernel, my system runs as fast as ever. Hopefully other users experience my situation will stumble across this post and find it helpful.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-76757121878588075482010-05-22T11:28:00.000-04:002010-05-22T11:28:18.788-04:00Book Review: The Selfish Gene by Richard DawkinsThe Selfish Gene does a marvelous job explaining the core concepts of<br />evolution for the lay person. It begins with the predominate theory of<br />how life began in the primordial soup. It then explains how the first<br />replicators became the genes that make up our DNA and how the natural<br />environment shapes evolution by pruning the most adaptive and<br />advantageous of those genes.<br /><br />Genes are responsible for manufacturing organisms to help them<br />replicate. They affect not only its own organism, but the surrounding<br />environment and other organisms. The book explains how the genes<br />affect the organisms behavior, and how the behavior of a population of<br />species follows an Evolutionary Stable Strategy (ESS). The book's<br />title refers to the concept that genes are really looking after<br />themselves first, but it also explains how altruistic behavior can<br />arise from the gene's selfishness. The author adamantly proposes that<br />we are the first species that can defy our genes and oppose the<br />ruthless nature of natural selection to make the world a better,<br />friendlier place.<br /><br />It worries me that many people are ignorant of evolution. Never once<br />did my high school offer a class on the topic. In my opinion, everyone<br />should be familiar with the concepts because I believe it's important<br />to know how we came to be. I recommend this book to everybody.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-63259982235794912062010-05-08T08:51:00.000-04:002010-05-08T08:51:38.259-04:00Book Review: Practical Common Lisp by Peter SeibelPractical Common Lisp has turned into the de facto standard for beginners who want to learn Common Lisp, and deservingly so. The opening chapters delve right into the development style of Common Lisp and show how it differs from more mainstream languages. It covers all the basics and more, eventually leading into chapters explaining how to parse MP3 files and create and create an MP3 Shoutcast server from scratch.<br /><br />Common Lisp is my favorite language to develop in, but most people I talk to dismiss it as being too old and irrelevant for today's computer applications. I highly disagree. The fact that the language is old is actually one of it's strengths: every design decision seems so well thought out. I've had numerous moments where I commented to myself "you know, it would be nice if this function could do this," and then discovered that it could after reading the documentation. And the development environment is the best out there. The Slime/Emacs/Lisp combination is way ahead of Visual Studio in terms of interactivity, customization, jumping through source files and debugging.<br /><br />I recommend this book to all developers out there, as learning Common Lisp helped me in my day job as well. At least read through the chapter on creating a unit test framework to get a feel of what software development should be like.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-63957580510336853722010-04-24T09:13:00.000-04:002010-04-24T09:13:30.609-04:00Book Review: Kluge: The Haphazard Construction of the Human Mind by Gary MarcusI never have done much reading about psychology before so I thought this book would be a good change of pace for me. The book was easy to read and covered the general ideas about how evolution cause major deficiencies in our brains. Most people don't realize how imperfect we actually are, but just by learning about it we can avoid certain downfalls that all people are prone too.<br /><br />It was a quick and enjoyable read, but I didn't learn a whole lot from it, probably because I read much about evolution before. Still, I recommend this book for all non-psychology students so they can better understand who they are.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-31475481024821058402010-04-11T08:04:00.000-04:002010-04-11T08:04:58.483-04:00Book Review: The Piano Tuner by Daniel MasonSet in the 1800s, the Piano Tuner is a well written novel about an ordinary man who journey's to the remote jungles of Burma on an odd mission from the British military. There he experiences sights and sounds that he had never seen before, met many interesting people and discovered a source of excitement that was missing from his bland life.<br /><br />Without revealing any spoils, I found the ending of this book highly engaging, but it still served as a poor penance for the uneventful, unexciting story leading up to it. I found the main character lacking any charm or personality whatsoever. In a sense, I found him distasteful and selfish for leaving his wife behind while seeking adventure. And all through his journey, he did nothing to change his attitude, nothing to prove his worth as a character who deserved respect and admiration.<br /><br />Though I dislike giving negative reviews, I cannot recommend this book to anyone, but I'm sure others will have different opinions.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-27999343822337736052010-03-21T12:21:00.000-04:002010-03-21T12:21:03.776-04:00SQL Prompt: Auto generating snippets<a href="http://www.red-gate.com/products/SQL_Prompt/index.htm">SQL Prompt</a> is a great add-on tool for SQL Server Management Studio that I use at work extensively. One of the features it has is "Snippets", which allow you to type a piece of code that expands into other code. For example, typing "ssf" and hitting Tab expands into "SELECT * FROM". <br /><br />Users can customize snippets, which are saved in a file and can be shared with others (more info <a href="http://www.red-gate.com/supportcenter/Content.aspx?p=SQL%20Prompt&c=knowledgebase\SQL_Prompt\KB200807000276.htm">here</a>). The database schema I use at work contains hundreds of tables, each named accoring to their abbreviated primary keys. Since some names are very long and cumbersome to type even with SQL Prompt, I created a Lisp script to auto generate snippets for each of the tables.<br /><br />For example, lets say our database models baseball statistics. We have tables for players and teams. Since we want to tract statistics for multiple years, we have a year table and tables relating the three. So, our very simple database may look like this:<br /><br />- Teams<br />- Players<br />- Years<br />- PlayersYears<br />- TeamsYears<br />- PlayersTeamsYears<br /><br />My simple Lisp program created snippets for each of the tables, expanding "pty" to "PlayersTeamsYears" and such for each of the tables.<br /><br />After saving my new SQL Prompt snippets file and starting Management Studio, SQL Prompt generated a run-time error because I had duplicate shortcut keys. Unfortuately, the error message didn't say which keys were duplicates, so I used the<a href="http://common-lisp.net/project/s-xml/"> s-xml</a> package and parsed the SQL Prompt file looking for duplicate shortcuts.<br /><br />s-xml works by parsing the xml file sequentially. For each new element, it calls a new-element hook function, and for each new piece of text it calls a new-text hook. The new-element hook takes as pararmenters the name of the element and the attributes. The new-text hook takes the string of text. Each hook also accepts a seed element, which can be any object and is passed along while parsing the file.<br /><br />I wanted to find duplicate shortcuts, so I decided to keep a hash-table with shortcuts as the key and the number of occurances as values. The shortcuts live inside of the "Shortcut" element, so my seed also needed to know the name of current element it was working on. I created the following class for my seed:<br /><pre class="prettyprint lang-cl">(defclass dup-shortcut-seed ()<br /> ((name :accessor name)<br /> (hash :initform (make-hash-table :test 'equalp) :accessor hash)))</pre><br />I created a method to easily increment the class's hash table:<br /><pre class="prettyprint lang-cl">(defgeneric inc-hash (dup-shortcut-seed key))<br /><br />(defmethod inc-hash ((dup-shortcut-seed dup-shortcut-seed) key)<br /> (incf (gethash key (hash dup-shortcut-seed) 0)))</pre><br />Now that I have my seed, I created the element and text hooks that use the seed to keep track of duplicate shortcuts:<br /><pre class="prettyprint lang-cl">(defun dup-shortcut-xml-new-element-hook (name attributes seed)<br /> (declare (ignore attributes))<br /> (let ((name (print-xml-string name)))<br /> (setf (name seed) name)<br /> (format t "New element: ~s~%" name))<br /> seed)<br /><br />(defun dup-shortcut-xml-text-hook (string seed)<br /> (when (equalp (name seed) "Shortcut")<br /> (format t "Modifying hash~%")<br /> (inc-hash seed string))<br /> seed)</pre><br />Next I created a function to call the parser on a stream:<br /><pre class="prettyprint lang-cl">(defun dup-shortcut-xml (in)<br /> (start-parse-xml<br /> in<br /> (make-instance 'xml-parser-state<br /> :seed (make-instance 'dup-shortcut-seed) <br /> :new-element-hook #'dup-shortcut-xml-new-element-hook<br /> :text-hook #'dup-shortcut-xml-text-hook)))</pre><br />Finally, I created the main function, which parses the xml file and diplays any duplicate shortcuts:<br /><pre class="prettyprint lang-cl">(defun find-dup-shortcuts-in-xml (&optional (file *output-file*))<br /> (with-open-file (in file)<br /> (let ((hash (hash (dup-shortcut-xml in))))<br /> (maphash (lambda (key value)<br /> (when (> value 1)<br /> (format t "~s:~s" key value)))<br /> hash))))</pre><br />After finding the shortcuts, I modified my snippet file and it worked beautifully!Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-60107745392942082812010-03-14T18:06:00.000-04:002010-03-14T18:06:38.339-04:00Book Review: The Singularity is Near by Ray KurzweilAnybody who loves science and technology will love this book. The book is about how technology will involve during the next one hundred years, not at a constant, linear rate, but as a double exponential rate. Ray provides many data and examples of this theory, and explains how the current research done by todays scientists and engineers will change the world more quickly than most people realize.<br /><br />The book focuses on three areas of science and technology: genetics, nanotechnology, and artificial intelligence. Advancements in each this century will bring major changes, including augmented our intelligence and replacing all of our organs so we could essentially live forever. Machines will become more intelligent than us, for when we create the first machine that can produce a machine smarter than itself, the cycle will iterate at an astonishing rate and machine intelligence will skyrocket past human intelligence. All of these future technologies he describes may seem bizarre, but keep in mind the progress of each one has already begun today.<br /><br />This book also contains a wealth of online references which I find very interesting and useful. As with any book, it should be regarded with great skepticism. For one thing, we may discover fundamental limits that stop our progressions in a particular area of research, or Ray Kurzweil may underestimate the complexities and challenges of the technologies he wrote about. This book was entertaining. The advancements mentioned are possible but not definite. I recommend this book for every technology lover and for those who are interested in the current research areas of science and technology companies and universities.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-22629247225611500522010-02-06T15:47:00.000-05:002010-02-06T15:47:54.571-05:00SICP Problems Ch 2.3<pre class="prettyprint lang-cl">;;;; SICP Section 2.3<br /><br />;;; 2.54<br />(defun my-equals (list1 list2)<br /> (cond ((and (null list1) (null list2)) t)<br /> ((and (consp (car list1)) (consp (car list2)))<br /> (and (my-equals (car list1) (car list2))<br /> (my-equals (cdr list1) (cdr list2))))<br /> (t (and (equalp (car list1) (car list2))<br /> (my-equals (cdr list1) (cdr list2))))))<br /><br />;;; 2.55<br />;; ''abc => (quote (quote abc))<br />;; (car (quote (quote abc))) = > quote<br /><br />;;; 2.56<br />;;; Differentiation definitions<br />(defun variablep (x)<br /> (symbolp x))<br /><br />(defun same-variable-p (v1 v2)<br /> (and (variablep v1) (variablep v2) (equal v1 v2)))<br /><br />(defun sump (x)<br /> (and (consp x) (equal (car x) '+)))<br /><br />(defun addend (s)<br /> (cadr s))<br /><br />(defun augend (s)<br /> (caddr s))<br /><br />(defun productp (x)<br /> (and (consp x) (equal (car x) '*)))<br /><br />(defun multiplier (p)<br /> (cadr p))<br /><br />(defun multiplicand (p)<br /> (caddr p))<br /><br />(defun =number (exp num)<br /> (and (numberp exp) (= exp num)))<br /><br />(defun make-sum (a1 a2)<br /> (cond ((=number a1 0) a2)<br /> ((=number a2 0) a1)<br /> ((and (numberp a1) (numberp a2)) (+ a1 a2))<br /> (t (list '+ a1 a2))))<br /><br />(defun make-product (m1 m2)<br /> (cond ((or (=number m1 0) (=number m2 0)) 0)<br /> ((=number m1 1) m2)<br /> ((=number m2 1) m1)<br /> ((and (numberp m1) (numberp m2)) (* m1 m2))<br /> (t (list '* m1 m2))))<br /><br />;;; Exponent definitions<br />(defun exponentiationp (x)<br /> (and (consp x) (equal (car x) '^)))<br /><br />(defun base (exp)<br /> (cadr exp))<br /><br />(defun exponent (exp)<br /> (caddr exp))<br /><br />(defun make-exponentiation (base exp)<br /> (cond ((=number exp 0) 1)<br /> ((=number exp 1) base)<br /> ((and (numberp base) (numberp exp)) (expt base exp))<br /> (t (list '^ base exp))))<br /><br />(defun deriv (exp var)<br /> (cond ((numberp exp) 0)<br /> ((variablep exp)<br /> (if (same-variable-p exp var) 1 0))<br /> ((sump exp)<br /> (make-sum (deriv (addend exp) var)<br /> (deriv (augend exp) var)))<br /> ((productp exp)<br /> (make-sum<br /> (make-product (multiplier exp)<br /> (deriv (multiplicand exp) var))<br /> (make-product (deriv (multiplier exp) var)<br /> (multiplicand exp))))<br /> ((exponentiationp exp)<br /> (make-product<br /> (exponent exp)<br /> (make-product<br /> (make-exponentiation (base exp) (- (exponent exp) 1))<br /> (deriv (base exp) var))))<br /> (t "unknown expression type")))<br /><br />;;; 2.57<br />(defun addend (s)<br /> (cadr s))<br /><br />(defun augend (s)<br /> (let ((augend (cddr s)))<br /> (if (= 1 (length augend))<br /> (car augend)<br /> (make-sum (car augend) (cdr augend)))))<br /><br />(defun multiplier (p)<br /> (cadr p))<br /><br />(defun multiplicand (p)<br /> (let ((multiplicand (cddr p)))<br /> (if (= 1 (length multiplicand))<br /> (car multiplicand)<br /> (make-product (car multiplicand)<br /> (cdr multiplicand)))))<br /><br />(defun make-sum (a1 a2)<br /> (cond ((=number a1 0) a2)<br /> ((=number a2 0) a1)<br /> ((and (numberp a1) (numberp a2)) (+ a1 a2))<br /> ((sump a2) (list '+ a1 (addend a2) (augend a2)))<br /> ((productp a2) (list '+ a1 (make-product<br /> (multiplier a2)<br /> (multiplicand a2))))<br /> ((and (consp a2) (> (length a2) 1))<br /> (list '+ a1 (make-sum (car a2) (cdr a2))))<br /> ((consp a2) (list '+ a1 (car a2)))<br /> (t (list '+ a1 a2))))<br /><br />(defun make-product (m1 m2)<br /> (cond ((or (=number m1 0) (=number m2 0)) 0)<br /> ((=number m1 1) m2)<br /> ((=number m2 1) m1)<br /> ((and (numberp m1) (numberp m2)) (* m1 m2))<br /> ((productp m2) (list '* m1 (multiplier m2) (multiplicand m2)))<br /> ((sump m2) (list '* m1 (make-sum (addend m2) (augend m2))))<br /> ((and (consp m2) (> (length m2) 1))<br /> (list '* m1 (make-product (car m2) (cdr m2))))<br /> ((consp m2) (list '* m1 (car m2)))<br /> (t (list '* m1 m2))))<br /><br />;;; 2.58<br />(defun sump (x)<br /> (and (consp x) (equal (cadr x) '+)))<br /><br />(defun addend (s)<br /> (car s))<br /><br />(defun augend (s)<br /> (caddr s))<br /><br />(defun productp (x)<br /> (and (consp x) (equal (cadr x) '*)))<br /><br />(defun multiplier (p)<br /> (car p))<br /><br />(defun multiplicand (p)<br /> (caddr p))<br /><br />(defun make-sum (a1 a2)<br /> (cond ((=number a1 0) a2)<br /> ((=number a2 0) a1)<br /> ((and (numberp a1) (numberp a2)) (+ a1 a2))<br /> (t (list a1 '+ a2))))<br /><br />(defun make-product (m1 m2)<br /> (cond ((or (=number m1 0) (=number m2 0)) 0)<br /> ((=number m1 1) m2)<br /> ((=number m2 1) m1)<br /> ((and (numberp m1) (numberp m2)) (* m1 m2))<br /> (t (list m1 '* m2))))<br /><br />;;; lookup b<br /><br />;;; 2.59<br />(defun element-of-set-p (x set)<br /> (cond ((null set) nil)<br /> ((equal x (car set)) t)<br /> (t (element-of-set-p x (cdr set)))))<br /><br />(defun adjoin-set (x set)<br /> (if (element-of-set-p x set)<br /> set<br /> (cons x set)))<br /><br />(defun intersection-set (set1 set2)<br /> (cond ((or (null set1) (null set2)) nil)<br /> ((element-of-set-p (car set1) set2)<br /> (cons (car set1)<br /> (intersection-set (cdr set1) set2)))<br /> (t (intersection-set (cdr set1) set2))))<br /><br />(defun union-set (set1 set2)<br /> (cond ((null set1) set2)<br /> ((null set2) set1)<br /> ((element-of-set-p (car set1) set2)<br /> (union-set (cdr set1) set2))<br /> (t (cons (car set1)<br /> (union-set (cdr set1) set2)))))<br /><br />;;; 2.60<br />(defun adjoin-set-2 (x set)<br /> (cons x set))<br /><br />(defun union-set-2 (set1 set2)<br /> (cond ((null set1) set2)<br /> ((null set2) set1)<br /> (t (cons (car set1)<br /> (union-set-2 (cdr set1) set2)))))<br /><br />;;; 2.61<br />(defun adjoin-set-2 (x set)<br /> (let ((first (car set)))<br /> (cond ((null set) (list x))<br /> ((= x first) set)<br /> ((> x first) (cons first (adjoin-set-2 x (cdr set))))<br /> (t (cons x set)))))<br /><br />;;; 2.62<br />(defun union-set-2 (set1 set2)<br /> (cond ((null set1) set2)<br /> ((null set2) set1)<br /> ((= (car set1) (car set2))<br /> (cons (car set1) (union-set-2 (cdr set1) (cdr set2))))<br /> ((> (car set1) (car set2))<br /> (cons (car set2) (union-set-2 set1 (cdr set2))))<br /> (t (cons (car set1) (union-set-2 (cdr set1) set2)))))<br /><br />;;; 2.66<br />(defun lookup (given-key set-of-records)<br /> (let ((current-record (car set-of-records))<br /> (key (key current-record)))<br /> (cond ((null set-of-records) nil)<br /> ((= given-key key) current-record)<br /> ((> given-key key)<br /> (lookup given-key (right-tree set-of-records)))<br /> (t (lookup given-key (left-tree set-of-records))))))<br /><br />;;; Huffman tree representation<br />(defun make-leaf (symbol weight)<br /> (list 'leaf symbol weight))<br /><br />(defun leaf? (object)<br /> (equalp (car object) 'leaf))<br /><br />(defun symbol-leaf (x) (cadr x))<br /><br />(defun weight-leaf (x) (caddr x))<br /><br />(defun make-code-tree (left right)<br /> (list left<br /> right<br /> (append (symbols left) (symbols right))<br /> (+ (weight left) (weight right))))<br /><br />(defun left-branch (tree) (car tree))<br /><br />(defun right-branch (tree) (cadr tree))<br /><br />(defun symbols (tree)<br /> (if (leaf? tree)<br /> (list (symbol-leaf tree))<br /> (caddr tree)))<br /><br />(defun weight (tree)<br /> (if (leaf? tree)<br /> (weight-leaf tree)<br /> (cadddr tree)))<br /><br />(defun decode (bits tree)<br /> (defun decode-1 (bits current-branch)<br /> (if (null bits)<br /> nil<br /> (let ((next-branch<br /> (choose-branch (car bits) current-branch)))<br /> (if (leaf? next-branch)<br /> (cons (symbol-leaf next-branch)<br /> (decode-1 (cdr bits) tree))<br /> (decode-1 (cdr bits) next-branch)))))<br /> (decode-1 bits tree))<br /><br />(defun choose-branch (bit branch)<br /> (cond ((= bit 0) (left-branch branch))<br /> ((= bit 1) (right-branch branch))<br /> (t (error "bad bit"))))<br /><br />(defun adjoin-set (x set)<br /> (cond ((null set) (list x))<br /> ((< (weight x) (weight (car set))) (cons x set))<br /> (t (cons (car set) (adjoin-set x (cdr set))))))<br /><br />(defun make-leaf-set (pairs)<br /> (if (null pairs)<br /> nil<br /> (let ((pair (car pairs)))<br /> (adjoin-set (make-leaf (car pair) (cadr pair))<br /> (make-leaf-set (cdr pairs))))))<br /><br />;;; 2.67<br />(defparameter *sample-tree*<br /> (make-code-tree (make-leaf 'a 4)<br /> (make-code-tree<br /> (make-leaf 'b 2)<br /> (make-code-tree (make-leaf 'd 1)<br /> (make-leaf 'c 1)))))<br /><br />(defparameter *sample-message* '(0 1 1 0 0 1 0 1 0 1 1 1 0))<br /><br />(decode *sample-message* *sample-tree*) ; => (A D A B B C A)<br /><br />;;; 2.68<br />(defun encode (message tree)<br /> (if (null message)<br /> nil<br /> (append (encode-symbol (car message) tree)<br /> (encode (cdr message) tree))))<br /><br />(defun encode-symbol (symbol tree)<br /> (cond ((or (null tree) (leaf? tree)) nil)<br /> ((member symbol (symbols (left-branch tree)))<br /> (cons 0 (encode-symbol symbol (left-branch tree))))<br /> ((member symbol (symbols (right-branch tree)))<br /> (cons 1 (encode-symbol symbol (right-branch tree))))<br /> (t (error "Symbol not in tree."))))<br /><br />;;; 2.69<br />(defun generate-huffman-tree (pairs)<br /> (successive-merge (make-leaf-set pairs)))<br /><br />(defun successive-merge (leaf-set &optional sub-tree)<br /> (cond ((null (cdr leaf-set))<br /> (make-code-tree (car leaf-set) sub-tree))<br /> ((null sub-tree)<br /> (successive-merge (cdr leaf-set) (car leaf-set)))<br /> (t (successive-merge (cdr leaf-set)<br /> (make-code-tree (car leaf-set)<br /> sub-tree)))))<br /><br />;;; 2.70<br />(defparameter *lyric-huff-tree*<br /> (generate-huffman-tree '((a 2) (boom 1) (get 2) (job 2)<br /> (na 16) (sha 3) (yip 9) (wah 1))))<br /><br />(defparameter *song* '(get a job sha na na na na na na na na<br /> get a job sha na na na na na na na<br /> wah yip yip yip yip yip yip yip yip<br /> yip Sha boom))<br /><br />(length (encode *song* *lyric-huff-tree*)) ; => 86<br /><br />;; 2.71<br />;; Most frequent = 1, least = N - 1<br /><br /><br /></pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-82670703488379639552010-02-06T15:43:00.000-05:002010-02-06T15:43:14.613-05:00Book Review: 1984 by George OrwellThe novel 1984 left me feeling dreadful. Not because of the quality of the writing or story, but because of the hopeless world the author created and because, as I read through the book and put myself in Winston's shoes, I could not imagine how to rebel and defeat the party. At times I thought some parts extreme, but then when reflecting about all the slavery and hardships in past society I thought perhaps this novel's world may not be so far fetched after all. <br /><br />The story started slow for my tastes but the vivid writing and lucid details kept me interested. I felt some parts a bit too drawn out, such as when Winston read a couple chapters of Goldstein's book. But once I hit the book's turning point I found it hard to put down.<br /><br />Overall, this book was a great change of pace for me. I'm glad I finally took the time to read it, as so many others have before me, and I recommend it to people who love drama, history, politics, or simply great writing.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-21260554915564719322009-12-11T23:03:00.000-05:002009-12-11T23:03:57.463-05:00Book Review: A Briefer History of Time by Stephen Hawking and Leonard MlodinowThe topics of physics and the universe have always intrigued me, but since studying them in general has little relevance to my everyday job, I always had difficulty making time to learn about them. I took my last physics course in my freshman year of college and since the only knowledge I learned about the universe came from Discovery channel shows. I liked this book because I felt more in tune about modern physics and the universe after reading it.<br /><br />This book explains the history of physics, from the Greeks to Isac Newton to modern topics like relativity to string theory. It explains them all in a general sense, enough to grasp the mechanisms but it does not overwhelm the reader with details, as the author geared the book to the wider audience. <br /><br />Some parts of the book mentioned the intentions of God when he created the universe, which I disliked. The notion of a higher power creating the universe only means we remain even farther away from knowing the true roots of the universe, for then the next obvious question is how was this higher power created? If the unified theory of physics ends up being associated with a creator's intentions I would be gravely disappointed.<br /><br />Overall, I got exactly what I wanted from this book: a concise overview of modern physics. I doubt I'll find the time to delve deeper into the topic, but I'll make sure to keep up-to-date with the current progress.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-13724845098882121372009-12-01T19:48:00.000-05:002009-12-01T19:48:43.927-05:00Book Review: Undone by Michael KimballUndone is a dark, suspenseful quick-pace novel about a couple's insurance-scamming scheme gone wrong, leading to a world of chaos involving murder, seduction and scandalous blackmail. Set in a small Maine town, the quiet world of the locals becomes disrupted after a suspicious death and a blatant murder. The lives of those involved quickly spiral out of control.<br /><br />I breezed through this novel as I found myself craving to discover what would happen next. The characters were dark and grim and the entire time I wondered if anyone would find their salvation. If you are looking for a fast and entertaining read, I recommend this book.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-42611676531017312512009-11-01T18:28:00.001-05:002009-11-01T18:29:00.878-05:00Book Review: The Road by Cormac McCarthySet in the near future, THE ROAD is a story about a father and son<br />traveling through the bleak, post-apocalyptic world. In the ash<br />covered earth they struggle scavenging for food and avoiding<br />cannibalistic nomads, all while trying to keep their wits and humanity<br />intact. <br /><br />Cormac's writing style simultaneously paints a hopeless world and<br />shows the loving bond between father and son. The ash covered<br />landscapes, toxic air, endless gray skies, constant threat of being<br />hunted, and sparse scraps of food tests the pair's will to survive.<br />While reading the novel, I often questioned whether it would be better<br />for them to die.<br /><br />This is indeed a great novel; not one that will cheer you up on a<br />rainy day but move you with intricate emotions. It is a powerful story<br />with a deep writing style. I intend to keep this on my bookshelf for the<br />rest of my life.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-36683939070984278372009-10-25T17:13:00.000-04:002009-10-25T17:14:42.387-04:00SICP Problems Ch 2.2<blockquote>SICP Exercise 2.17</blockquote><br /><pre class="prettyprint lang-cl">(defun last-pair (list)<br /> (if (null (cdr list))<br /> list<br /> (last-pair (cdr list))))</pre><br /><br /><blockquote>SICP Exercise 2.18</blockquote><br /><pre class="prettyprint lang-cl">(defun rev (list)<br /> (if (null (cdr list))<br /> list<br /> (cons (car (last list))<br /> (rev (butlast list)))))</pre><br /><br /><blockquote>SICP Exercise 2.19</blockquote><br /><pre class="prettyprint lang-cl">(defparameter *us-coins* (list 50 25 10 5 1))<br />(defparameter *uk-coins* (list 100 50 20 10 5 1 0.5))<br /><br />(defun count-change (amount coin-values)<br /> (cc amount coin-values))<br /><br />(defun cc (amount coin-values)<br /> (cond ((= amount 0) 1)<br /> ((or (< amount 0) (no-more-p coin-values)) 0)<br /> (t (+ (cc amount<br /> (except-first-denomination coin-values))<br /> (cc (- amount<br /> (first-denomination coin-values))<br /> coin-values)))))<br /><br />(defun no-more-p (coin-values)<br /> (null coin-values))<br /><br />(defun except-first-denomination (coin-values)<br /> (cdr coin-values))<br /><br />(defun first-denomination (coin-values)<br /> (car coin-values))</pre><br /><br /><blockquote>SICP Exercise 2.20</blockquote><br /><pre class="prettyprint lang-cl">(defun same-parity (integer &rest integers)<br /> (cond ((null integers) integer)<br /> ((evenp integer) (append (list integer)<br /> (remove-if-not #'evenp integers)))<br /> (t (append (list integer) (remove-if-not #'oddp integers)))))</pre><br /><br /><blockquote>SICP Exercise 2.21</blockquote><br /><pre class="prettyprint lang-cl">defun square-list-1 (items)<br /> (if (null items)<br /> nil<br /> (cons (expt (car items) 2)<br /> (square-list-1 (cdr items)))))<br /><br />(defun square-list-2 (items)<br /> (mapcar (lambda (x) (* x x))<br /> items))</pre><br /><br /><blockquote>SICP Exercise 2.23</blockquote><br /><pre class="prettyprint lang-cl">(defun for-each (proc items)<br /> (when (consp items)<br /> (funcall proc (car items))<br /> (for-each proc (cdr items))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.27</blockquote><br /><pre class="prettyprint lang-cl">(defparameter x (list (list 1 2) (list 3 4)))<br /><br />(defun last-element (list)<br /> "Returns the last element of LIST."<br /> (car (last list)))<br /><br />(defun deep-rev (list)<br /> (cond ((and (= 1 (length list)) (not (listp (car list)))) list)<br /> ((= 1 (length list)) (list (deep-rev (car list))))<br /> ((listp (last-element list))<br /> (cons (deep-rev (last-element list))<br /> (deep-rev (butlast list))))<br /> (t (cons (last-element list)<br /> (deep-rev (butlast list))))))</pre><br /><br /><blockquote>SICP Exercise 2.28</blockquote><br /><pre class="prettyprint lang-cl">(defun fringe (list)<br /> (when list<br /> (if (atom list)<br /> (list list)<br /> (append (fringe (car list))<br /> (fringe (cdr list))))))</pre><br /><br /><blockquote>SICP Exercise 2.29</blockquote><br /><pre class="prettyprint lang-cl"><br />;; a.<br />(defun make-mobile (left right)<br /> (list left right))<br /><br />(defun make-branch (length structure)<br /> (list length structure))<br /><br />(defun left-branch (mobile)<br /> (first mobile))<br /><br />(defun right-branch (mobile)<br /> (second mobile))<br /><br />(defun branch-length (branch)<br /> (first branch))<br /><br />(defun branch-structure (branch)<br /> (second branch))<br /><br />;; b.<br />(defun mobilep (structure)<br /> (listp structure))<br /><br />(defun total-weight (mobile)<br /> (+ (total-branch-weight (left-branch mobile))<br /> (total-branch-weight (right-branch mobile))))<br /><br />(defun total-branch-weight (branch)<br /> (let ((branch-structure (branch-structure branch)))<br /> (if (mobilep branch-structure)<br /> (total-weight branch-structure)<br /> branch-structure)))<br /><br />;;; c.<br />(defun torque (branch)<br /> (* (branch-length branch)<br /> (total-branch-weight branch)))<br /><br />(defun balanced-mobile-p (mobile)<br /> (let ((left (left-branch mobile))<br /> (right (right-branch mobile)))<br /> (cond<br /> ;; Return false if the left and right torques are unequal.<br /> ((/= (torque left) (torque right)) nil)<br /> ;; The mobile is balanced at this level. Return true if there<br /> ;; are no more submobiles.<br /> ((and (not (mobilep left))<br /> (not (mobilep right)))<br /> t)<br /> ;; Submobiles exist. Check their balance.<br /> (t (and (if (mobilep (branch-structure left))<br /> (balanced-mobile-p (branch-structure left))<br /> t)<br /> (if (mobilep (branch-structure right))<br /> (balanced-mobile-p (branch-structure right))<br /> t))))))<br /><br />;;; d. For section a, we need to replace the first and second<br />;;; functions with car and cdr respectively. The remaining sections<br />;;; can be left intact.<br /></pre><br /><br /><blockquote>SICP Exercise 2.30</blockquote><br /><pre class="prettyprint lang-cl">(defun square-tree-1 (tree)<br /> (cond ((null tree) nil)<br /> ((not (listp tree)) (* tree tree))<br /> (t (cons (square-tree-1 (car tree))<br /> (square-tree-1 (cdr tree))))))<br /><br />(defun square-tree-2 (tree)<br /> (mapcar (lambda (sub-tree)<br /> (if (listp sub-tree)<br /> (square-tree-2 sub-tree)<br /> (* sub-tree sub-tree)))<br /> tree))</pre><br /><br /><br /><blockquote>SICP Exercise 2.31</blockquote><br /><pre class="prettyprint lang-cl">(defun tree-map (proc tree)<br /> (mapcar (lambda (sub-tree)<br /> (if (listp sub-tree)<br /> (tree-map proc sub-tree)<br /> (funcall proc sub-tree)))<br /> tree))<br /><br />(defun square (x)<br /> (* x x))<br /><br />(defun square-tree-3 (tree)<br /> (tree-map #'square tree))</pre><br /><br /><blockquote>SICP Exercise 2.32</blockquote><br /><pre class="prettyprint lang-cl">(defun subsets (s)<br /> (if (null s)<br /> (list nil)<br /> (let ((rest (subsets (cdr s))))<br /> (append rest (mapcar (lambda (x)<br /> (cons (car s) x))<br /> rest)))))</pre><br /><br /><blockquote>SICP Exercise 2.33</blockquote><br /><pre class="prettyprint lang-cl">(defun accumulate (op initial sequence)<br /> (if (null sequence)<br /> initial<br /> (funcall op (car sequence)<br /> (accumulate op initial (cdr sequence)))))<br /><br />(defun my-map (p sequence)<br /> (accumulate (lambda (x y)<br /> (cons (funcall p x) y))<br /> nil<br /> sequence))<br /><br />(defun my-append (seq1 seq2)<br /> (accumulate #'cons seq2 seq1))<br /><br />(defun my-length (sequence)<br /> (accumulate (lambda (x y)<br /> ;; Avoid style warnings by telling the compiler to<br /> ;; ignore X.<br /> (declare (ignore x)) <br /> (+ 1 y))<br /> 0 sequence))</pre><br /><br /><blockquote>SICP Exercise 2.34</blockquote><br /><pre class="prettyprint lang-cl">(defun horner-eval (x coefficient-sequence)<br /> (accumulate (lambda (this-coeff higher-terms)<br /> (+ this-coeff<br /> (* x higher-terms)))<br /> 0<br /> coefficient-sequence))</pre><br /><br /><br /><blockquote>SICP Exercise 2.35</blockquote><br /><pre class="prettyprint lang-cl">(defun count-leaves (tree)<br /> (accumulate #'+<br /> 0<br /> (mapcar (lambda (sub-tree)<br /> (if (listp sub-tree)<br /> (count-leaves sub-tree)<br /> 1))<br /> tree)))</pre><br /><br /><blockquote>SICP Exercise 2.36</blockquote><br /><pre class="prettyprint lang-cl">(defun accumulate-n (op init seqs)<br /> (if (null (car seqs))<br /> nil<br /> (cons (accumulate op init (mapcar #'car seqs))<br /> (accumulate-n op init (mapcar #'cdr seqs)))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.37</blockquote><br /><pre class="prettyprint lang-cl">(defun dot-product (v w)<br /> (accumulate #'+ 0 (mapcar #'* v w)))<br /><br />(defun matrix-*-vector (m v)<br /> (mapcar (lambda (row)<br /> (dot-product row v))<br /> m))<br /><br />(defun transpose (mat)<br /> (accumulate-n #'cons nil mat))<br /><br />(defun matrix-*-matrix (m n)<br /> (let ((cols (transpose n)))<br /> (mapcar (lambda (row)<br /> (matrix-*-vector cols row))<br /> m)))</pre><br /><br /><blockquote>SICP Exercise 2.39</blockquote><br /><pre class="prettyprint lang-cl">(defun fold-left (op initial sequence)<br /> (labels ((iter (result rest)<br /> (if (null rest)<br /> result<br /> (iter (funcall op result (car rest))<br /> (cdr rest)))))<br /> (iter initial sequence)))<br /><br />(defun fold-right (op initial sequence)<br /> (accumulate op initial sequence))<br /><br />(defun reverse-1 (sequence)<br /> (fold-right (lambda (x y)<br /> (append y (list x)))<br /> nil<br /> sequence))<br /><br />(defun reverse-2 (sequence)<br /> (fold-left (lambda (x y)<br /> (append (list y) x))<br /> nil<br /> sequence))</pre><br /><br /><blockquote>SICP Exercise 2.40</blockquote><br /><pre class="prettyprint lang-cl">(defun flatmap (proc seq)<br /> (accumulate #'append nil (mapcar proc seq)))<br /><br />(defun enumerate-interval (x y)<br /> "Returns the list from X to Y"<br /> (loop for i from x to y collect i))<br /><br />(defun unique-pairs (n)<br /> (flatmap <br /> (lambda (i)<br /> (mapcar (lambda (j)<br /> (list i j))<br /> (enumerate-interval 1 (- i 1))))<br /> (enumerate-interval 1 n)))<br /><br />;;; Definitions for prime?<br /><br />(defun dividesp (a b) (zerop (mod b a)))<br /><br />(defun find-divisor (n test-divisor)<br /> (cond ((> (square test-divisor) n) n)<br /> ((dividesp test-divisor n) test-divisor)<br /> (t (find-divisor n (+ test-divisor 1)))))<br /><br />(defun smallest-divisor (n)<br /> (find-divisor n 2))<br /><br />(defun prime? (n) (= n (smallest-divisor n)))<br /><br />(defun prime-sum? (pair)<br /> (prime? (+ (car pair) (cadr pair))))<br /><br />(defun make-pair-sum (pair)<br /> (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))<br /><br />(defun prime-sum-pairs (n)<br /> (mapcar #'make-pair-sum<br /> (remove-if-not #'prime-sum?<br /> (unique-pairs n))))</pre><br /><br /><blockquote>SICP Exercise 2.41</blockquote><br /><pre class="prettyprint lang-cl">(defun triples (n s)<br /> (remove-if-not (lambda (list) (= s (reduce #'+ list)))<br /> (flatmap<br /> (lambda (i)<br /> (flatmap<br /> (lambda (j)<br /> (mapcar (lambda (k) (list i j k))<br /> (enumerate-interval 1 (- j 1))))<br /> (enumerate-interval 1 (- i 1))))<br /> (enumerate-interval 1 n))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.42</blockquote><br /><pre class="prettyprint lang-cl">(defparameter empty-board nil)<br /><br />(defun board-position (row col)<br /> "Represents a chess piece's position on the board."<br /> (list row col))<br /><br />(defun adjoin-position (row col set-of-positions)<br /> "Adjoins a new row-column position to a set of positions."<br /> (append set-of-positions (list (board-position row col))))<br /><br />(defun get-column (position)<br /> "Returns the column of the board-position POSITION."<br /> (cadr position))<br /><br />(defun get-row (position)<br /> "Returns the row of the board position POSITION."<br /> (car position))<br /><br />(defun get-board-position (col positions)<br /> "Returns the board position in column COL."<br /> (car (remove-if-not (lambda (position)<br /> (= col (get-column position)))<br /> positions)))<br /><br />(defun in-same-row? (col positions)<br /> "Returns true if the queen in column COL shares the same row with<br />another queen in the position set POSITIONS."<br /> (let ((row (get-row (get-board-position col positions))))<br /> (some (lambda (position)<br /> (and (/= col (get-column position))<br /> (= row (get-row position))))<br /> positions)))<br /><br />(defun in-diagonal? (col positions)<br /> "Returns true if the queen in column COL resides in the diagonal <br />of another queen in the position set POSITIONS."<br /> (let ((row (get-row (get-board-position col positions))))<br /> (some (lambda (position)<br /> (when (/= col (get-column position))<br /> (= 1 (abs (/ (- row (get-row position))<br /> (- col (get-column position)))))))<br /> positions)))<br /><br />(defun safe? (new-queen old-queens)<br /> "Returns true if the NEW-QUEEN does not reside in the same row<br />or diagonal of any of the OLD-QUEENS."<br /> (cond<br /> ;; Return true when no OLD-QUEENS exist.<br /> ((null old-queens) t)<br /> ;; Test if NEW-QUEEN resides on the same row.<br /> ((in-same-row? new-queen old-queens) nil)<br /> ;; Test if NEW-QUEEN resides on the same diagonal.<br /> ((in-diagonal? new-queen old-queens) nil)<br /> ;; Return true if all the tests pass.<br /> (t t)))<br /><br />(defun queens (board-size)<br /> (labels ((queen-cols (k)<br /> (if (= k 0)<br /> (list empty-board)<br /> (remove-if-not<br /> (lambda (positions) (safe? k positions))<br /> (flatmap<br /> (lambda (rest-of-queens)<br /> (mapcar (lambda (new-row)<br /> (adjoin-position new-row<br /> k<br /> rest-of-queens))<br /> (enumerate-interval 1 board-size)))<br /> (queen-cols (- k 1)))))))<br /> (queen-cols board-size)))</pre><br /><br /><blockquote>SICP Exercise 2.44</blockquote><br /><pre class="prettyprint lang-cl">(defun up-split (painter n)<br /> (if (= n 0)<br /> painter<br /> (let ((smaller (up-split painter (- n 1))))<br /> (below painter (beside smaller smaller)))))</pre><br /><br /><blockquote>SICP Exercise 2.45</blockquote><br /><pre class="prettyprint lang-cl">(defun split (proc1 proc2)<br /> (labels ((do-split (painter n)<br /> (if (= n 0)<br /> painter<br /> (let ((smaller (do-split painter (- n 1))))<br /> (funcall proc1 painter<br /> (funcall proc2 smaller smaller))))))<br /> (lambda (painter n)<br /> (do-split painter n))))</pre><br /><br /><blockquote>SICP Exercise 2.46</blockquote><br /><pre class="prettyprint lang-cl">(defun make-vect (x y)<br /> (cons x y))<br /><br />(defun xcor-vect (v)<br /> (car v))<br /><br />(defun ycor-vect (v)<br /> (cdr v))<br /><br />(defun add-vect (v1 v2)<br /> (make-vect (+ (xcor-vect v1) (xcor-vect v2))<br /> (+ (ycor-vect v1) (ycor-vect v2))))<br /><br />(defun sub-vect (v1 v2)<br /> (make-vect (- (xcor-vect v1) (xcor-vect v2))<br /> (- (ycor-vect v2) (ycor-vect v2))))<br /><br />(defun scale-vect (s v)<br /> (make-vect (* s (xcor-vect v))<br /> (* s (ycor-vect v))))</pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-13377802189746819082009-10-14T21:57:00.002-04:002009-10-14T22:02:48.914-04:00Book Review: Thousand Splendid SunsIn his second novel, Khaled Hosseini wrote a more gripping, compelling, page turner than his first, which says a lot considering how much I enjoyed the first novel. This novel follows two women, who grew up in vastly different lifestyles, and shows how the wars in Afghanistan ruined their families and eventually brought them together. <br /><br />Throughout reading the novel, I got the feeling that these two lives, however dreadful and punished they seemed, are typical in Afghanistan. This made me realize how much I take for granted, the simple freedoms that I practice without the thought that some other force could snatch them from me. In this sense, the book made me more grateful for the country I live in.<br /><br />Overall, I found the book easy to read and finished it quickly. The tale seemed powerful and held my attention till the end. Though not one of my all time favorites, I would recommend this book to others.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-73898950846572246162009-10-08T18:37:00.002-04:002009-10-08T18:42:51.655-04:00Book Review: The Kite RunnerI recently finished the critically acclaimed novel “<a href="http://www.amazon.com/Kite-Runner-Khaled-Hosseini/dp/1594480001">The Kite Runner</a>” by Khaled Hosseini and understand why the book received so much praise. The story contains vibrant characters and a compelling plot, but for me the most interesting and beneficial aspect of the story was the exposure to a different culture, one where all my previous knowledge originated from news reports of war and violence. Reading about this tiny part of Afghan life helped me realize how little I knew about their customs and beliefs.<br /><br />Although gripping and entertaining, I would not consider this novel my favorite of all time, but definitely liked it enough to read the follow up book, A Thousand Splendid Suns, which I plan to do in the coming months.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-70600955814926107532009-09-29T20:16:00.002-04:002009-09-29T20:17:42.581-04:00Finally Back!Sorry for the long hiatus, as I lacked personal internet access for the entire summer while in the midst of job relocation and house hunting. But now since I'm finally back, look for new posts very soon!Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-36039657089591571062009-04-19T17:56:00.000-04:002009-04-19T17:57:07.804-04:00Book Review: Atonement by Ian McEwanIan McEwan's tale about a guilt stricken woman troubled by an unfortunate lie she orchestrated as a young teenager really displays his proficient, magnificent prose. I thoroughly enjoyed the author's mastery of describing his characters. Most writers are content to describe the physical characteristics and superficial emotions of their characters. Ian McEwan, on the other hand, shows how his characters think, such as the worrisome sentiments of a migraine-sickened mother to the coping fantasies of a child struggling with growing up. Within these life-like descriptions he wrote a compelling story that, while takes a while to set in motion, gripped me until the end.Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-7235049397855519122009-04-14T20:26:00.003-04:002009-04-14T20:32:24.719-04:00Project Euler - Problem 22<blockquote>Using names.txt (right click and 'Save Link/Target As...'), a 46K text file containing over five-thousand first names, begin by sorting it into alphabetical order. Then working out the alphabetical value for each name, multiply this value by its alphabetical position in the list to obtain a name score.<br /><br />For example, when the list is sorted into alphabetical order, COLIN, which is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN would obtain a score of 938 × 53 = 49714.<br /><br />What is the total of all the name scores in the file?</blockquote><br /><br />This solution's final function follows the problem's definition precisely: sort the file, compute the alphabetical values for each name, then sum the values.<br /><br /><pre class="prettyprint lang-cl">;;; Use the split-sequence library for splitting the names.txt file.<br />(require 'split-sequence)<br /><br />(defparameter *ansi-base-code* 64<br /> "Subtract this value from a character's ansi integer value to get<br />the characters position in the alphabet.")<br /><br />(defparameter *names-file* "programming/lisp/euler/names.txt"<br /> "The locations of names.txt on my computer.")<br /><br />(defun char-position (char)<br /> "Returns CHAR's position in the alphabet.<br />Example: (char #\A) => 1<br /> (char #\C) => 3"<br /> (- (char-int char)<br /> *ansi-base-code*))<br /><br />(defun alphabetical-value (string)<br /> "Returns the alphabetical value of STRING. For example, COLIN is worth<br />3 + 15 + 12 + 9 + 14 = 53"<br /> (reduce #'+ (map 'list (lambda (char)<br /> (char-position char))<br /> string)))<br /><br />(defun name-score (string position)<br /> "Returns the name score of STRING."<br /> (* (alphabetical-value string) position))<br /><br />(defun name-scores (list)<br /> "Returns a list of the name scores of LIST. Removes any quotes from<br />the items in LIST before calculating the score."<br /> (let ((alphabetical-position 0))<br /> (mapcar (lambda (name)<br /> (incf alphabetical-position)<br /> (name-score (remove #\" name) alphabetical-position))<br /> list)))<br /><br />(defun parse-file (file delimiter)<br /> "Returns a list of items from FILE parsed by DELIMITER."<br /> (with-open-file (stream file)<br /> (split-sequence:split-sequence delimiter (read-line stream))))<br /><br />(defun sort-list (list)<br /> "Sorts LIST by alphabetical string value."<br /> (sort list #'string<))<br /><br />(defun sum-list (list)<br /> "Returns the sum of all the elements in LIST."<br /> (reduce #'+ list))<br /><br />(defun euler-22 ()<br /> (sum-list (name-scores (sort-list (parse-file *names-file* #\,)))))</pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0tag:blogger.com,1999:blog-2415580189498211237.post-34405583130714035882009-03-24T20:33:00.005-04:002009-04-09T20:54:31.392-04:00SICP Problems Ch 2.1<blockquote>SICP Exercise 2.2<br />Consider the problem of representing line segments in a plane. Each segment is represented as a pair of points: a starting point and an ending point. Define a constructor make-segment and selectors start-segment and end-segment that define the representation of segments in terms of points. Furthermore, a point can be represented as a pair of numbers: the x coordinate and the y coordinate. Accordingly, specify a constructor make- point and selectors x-point and y-point that define this representation. Finally, using your selectors and constructors, define a procedure midpoint-segment that takes a line segment as argument and returns its midpoint (the point whose coordinates are the average of the coordinates of the endpoints). To try your procedures, you'll need a way to print points: (define <br /> (print-point p)<br /> (newline)<br /> (display "(")<br /> (display (x-point p))<br /> (display ",")<br /> (display (y-point p))<br /> (display ")"))</blockquote><br /><br /><pre class="prettyprint lang-cl">;;; Utility functions<br />(defun average (x y)<br /> (/ (+ x y)<br /> 2))<br /><br />;;; Point and segment functions<br />(defun make-point (x y)<br /> (cons x y))<br /><br />(defun x-point (point)<br /> (car point))<br /><br />(defun y-point (point)<br /> (cdr point))<br /><br />(defun make-segment (start end)<br /> (cons start end))<br /><br />(defun start-segment (segment)<br /> (car segment))<br /><br />(defun end-segment (segment)<br /> (cdr segment))<br /><br />(defun midpoint-segment (segment)<br /> (make-point (average (x-point (start-segment segment))<br /> (x-point (end-segment segment)))<br /> (average (y-point (start-segment segment))<br /> (y-point (end-segment segment)))))<br /><br />(defun print-point (p)<br /> (format t "x=~D y=~D~%"<br /> (x-point p)<br /> (y-point p)))</pre><br /><br /><br /><blockquote>SICP Exercise 2.3<br />Implement a representation for rectangles in a plane. (Hint: You may want to make use of exercise 2.2.) In terms of your constructors and selectors, create procedures that compute the perimeter and the area of a given rectangle. Now implement a different representation for rectangles. Can you design your system with suitable abstraction barriers, so that the same perimeter and area procedures will work using either representation?</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun make-rec (lower-left-pt upper-right-pt)<br /> (cons lower-left-pt upper-right-pt))<br /><br />(defun rec-upper-right (rec)<br /> (cdr rec))<br /><br />(defun rec-lower-left (rec)<br /> (car rec))<br /><br />(defun rec-upper-left (rec)<br /> (make-point (x-point (rec-lower-left rec))<br /> (y-point (rec-upper-right rec))))<br /><br />(defun rec-lower-right (rec)<br /> (make-point (x-point (rec-upper-right rec))<br /> (y-point (rec-lower-left rec))))<br /> <br />(defun rec-len (rec)<br /> (- (y-point (rec-upper-left rec))<br /> (y-point (rec-lower-left rec))))<br /><br />(defun rec-width (rec)<br /> (- (x-point (rec-lower-right rec))<br /> (x-point (rec-lower-left rec))))<br /><br />(defun area-rec (rec)<br /> (* (rec-len rec)<br /> (rec-width rec)))<br /><br />(defun perimeter-rec (rec)<br /> (* 2<br /> (+ (rec-len rec)<br /> (rec-width rec))))<br /><br />;;; Alternative representation of rectangles<br /><br />(defun alt-make-rec (bottom-seg left-seg)<br /> (cons bottom-seg left-seg))<br /><br />(defun alt-upper-left (rec)<br /> (end-segment (cdr rec)))<br /><br />(defun alt-lower-left (rec)<br /> (start-segment (car rec)))<br /><br />(defun alt-lower-right (rec)<br /> (end-segment (cdr rec)))<br /><br />(defun alt-upper-right (rec)<br /> (make-point (x-point (alt-lower-right rec))<br /> (y-point (alt-upper-left rec))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.4<br />Here is an alternative procedural representation of pairs. For this representation, verify that (car (cons x y)) yields x for any objects x and y.<br /><br /> (define (cons x y)<br /> (lambda (m) (m x y)))<br /> (define (car z)<br /> (z (lambda (p q) p)))<br /><br />What is the corresponding definition of cdr? (Hint: To verify that this works, make use of the substitution model of section 1.1.5.)</blockquote><br /><br /><pre class="prettyprint lang-cl">;;; Redefine Scheme functions in CL<br />(defun alt-cons (x y)<br /> (lambda (m) (funcall m x y)))<br /><br />(defun alt-car (z)<br /> (funcall z (lambda (p q) p)))<br /><br />(defun alt-cdr (z)<br /> (funcall z (lambda (p q) q)))</pre><br /><br /><br /><blockquote>SICPSICP Exercise 2.5<br />Show that we can represent pairs of nonnegative integers using only numbers and arithmetic operations if we represent the pair a and b as the integer that is the product 2^a*3^b. Give the corresponding definitions of the procedures cons, car, and cdr.</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun alt2-cons (a b)<br /> (* (expt 2 a) (expt 3 b)))<br /><br />(defun alt2-car (z)<br /> (do ((i 0 (1+ i))<br /> (n z (/ n 2)))<br /> ((> (mod n 2) 0) i)))<br /><br />(defun alt2-cdr (z)<br /> (do ((i 0 (1+ i))<br /> (n z (/ n 3)))<br /> ((> (mod n 3) 0) i)))</pre><br /><br /><br /><blockquote>SICP Exercise 2.6<br />In case representing pairs as procedures wasn't mind-boggling enough, consider that, in a language that can manipulate procedures, we can get by without numbers (at least insofar as nonnegative integers are concerned) by implementing 0 and the operation of adding 1 as<br /><br /> (define zero (lambda (f) (lambda (x) x)))<br /><br /> (define (add-1 n)<br /> (lambda (f) (lambda (x) (f ((n f) x)))))<br /><br />This representation is known as Church numerals, after its inventor, Alonzo Church, the logician who invented the calculus. Define one and two directly (not in terms of zero and add-1). (Hint: Use substitution to evaluate (add-1 zero)). Give a direct definition of the addition procedure + (not in terms of repeated application of add-1).</blockquote><br /><br /><pre class="prettyprint lang-cl">;;; Redefine Scheme functions in CL<br />(defun zero ()<br /> (lambda (f)<br /> (lambda (x) x)))<br /><br />(defun add-1 (n)<br /> (lambda (f)<br /> (lambda (x)<br /> (funcall f (funcall (funcall n f) x)))))<br /><br />;;; Definitions of one and two<br />(defun one ()<br /> (lambda (f)<br /> (lambda (x)<br /> (funcall f x))))<br /><br />(defun two ()<br /> (lambda (f)<br /> (lambda (x)<br /> (funcall f (funcall f x)))))<br /><br />;;; We can test our definitions of one and two with the following code:<br />;;; (funcall (funcall (one) #'1+) 0) => 1<br />;;; (funcall (funcall (two) #'1+) 0) => 2<br /><br />;;; Notice the pattern for the definitions of one and two: the natural<br />;;; number N converts to its corresponding Church numeral by<br />;;; compositing the function f N times. We can abstract this by<br />;;; using a macro to define our Church numerals<br /><br />(defun compose (times)<br /> (if (= times 1)<br /> '(funcall f x)<br /> `(funcall f ,(compose (1- times)))))<br /><br />(defmacro def-church-numeral (name N)<br /> `(defun ,name ()<br /> (lambda (f)<br /> (lambda (x)<br /> ,(compose N)))))<br /><br />;;; Now we can define new Church numerals as follows:<br />;;; (def-church-numeral three 3)<br />;;; (funcall (funcall (three) #'1+) 0) => 3<br /><br />;;; To define an add function for Church numerals, implement the<br />;;; identity f(m + n)(x) = fm(fn(x)). The code can look rather<br />;;; ugly in Common Lisp because the need for funcall, but to <br />;;; understand it remember how we call the church numeral <br />;;; functions, and see that the code calls the first church<br />;;; numeral and passes it to the second.<br /><br />(defun add (m n)<br /> (lambda (f)<br /> (lambda (x)<br /> (funcall (funcall (funcall m) f)<br /> (funcall (funcall (funcall n) f) x)))))<br /><br />;;; We can test the add function as follows:<br />;;;(funcall (funcall (add #'one #'three) #'1+) 0) => 4</pre><br /><br /><br /><blockquote>SICP Exercise 2.7<br />Alyssa's program is incomplete because she has not specified the implementation of the interval abstraction. Here is a definition of the interval constructor:<br /><br /> (define (make-interval a b) (cons a b))<br /><br />Define selectors upper-bound and lower-bound to complete the implementation.</blockquote><br /><br /><pre class="prettyprint lang-cl">;;; Redefine the Scheme functions in CL<br /><br />(defun add-interval (x y)<br /> (make-interval (+ (lower-bound x) (lower-bound y))<br /> (+ (upper-bound x) (upper-bound y))))<br /><br />(defun mul-interval (x y)<br /> (let ((p1 (* (lower-bound x) (lower-bound y)))<br /> (p2 (* (lower-bound x) (upper-bound y)))<br /> (p3 (* (upper-bound x) (lower-bound y)))<br /> (p4 (* (upper-bound x) (upper-bound y))))<br /> (make-interval (min p1 p2 p3 p4)<br /> (max p1 p2 p3 p4))))<br /><br />(defun dev-interval (x y)<br /> (mul-interval x<br /> (make-interval (/ 1.0 (upper-bound y))<br /> (/ 1.0 (lower-bound y)))))<br /><br />(defun make-interval (a b)<br /> (cons a b))<br /><br />;;; End of Scheme definitions<br /><br />(defun upper-bound (interval)<br /> (max (car interval) (cdr interval)))<br /><br />(defun lower-bound (interval)<br /> (min (car interval) (cdr interval)))</pre><br /><br /><br /><blockquote>SICP Exercise 2.8<br />Using reasoning analogous to Alyssa's, describe how the difference of two intervals may be computed. Define a corresponding subtraction procedure, called sub-interval.</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun sub-interval (x y)<br /> (add-interval x<br /> (make-interval (- (upper-bound y))<br /> (- (lower-bound y)))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.9<br />The width of an interval is half of the difference between its upper and lower bounds. The width is a measure of the uncertainty of the number specified by the interval. For some arithmetic operations the width of the result of combining two intervals is a function only of the widths of the argument intervals, whereas for others the width of the combination is not a function of the widths of the argument intervals. Show that the width of the sum (or difference) of two intervals is a function only of the widths of the intervals being added (or subtracted). Give examples to show that this is not true for multiplication or division.</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun interval-width (interval)<br /> (abs (/ (- (upper-bound interval) (lower-bound interval))<br /> 2.0)))</pre><br /><br /><br /><blockquote>SICP Exercise 2.11<br />In passing, Ben also cryptically comments: ‘‘By testing the signs of the endpoints of the intervals, it is possible to break mul-interval into nine cases, only one of which requires more than two multiplications.’’ Rewrite this procedure using Ben’s suggestion.</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun sym-signum (n)<br /> "Calls signum and returns + or - instead of 1, -1, 0. 0 is<br />considered postive for the sake of this exercise"<br /> (let ((sign (signum n)))<br /> (cond ((eq sign 1) '+)<br /> ((eq sign -1) '-)<br /> ((eq sign 0) '+))))<br /><br />(defun list-signs (lst)<br /> "Given a list of numbers, returns a list of the number's signs"<br /> (mapcar #'sym-signum lst))<br /><br />(defmacro make-interval-if (signs &body body)<br /> "Cleans up the definition of new-mul-interval by removing lots<br />of repeated code"<br /> `(cond ,@(mapcar #'(lambda (statement)<br /> (let ((test-signs (first statement))<br /> (lower-bound (second statement))<br /> (upper-bound (third statement)))<br /> `((equal ,signs ',test-signs)<br /> (make-interval (* ,(first lower-bound)<br /> ,(second lower-bound))<br /> (* ,(first upper-bound)<br /> ,(second upper-bound))))))<br /> body)))<br /><br /><br /><br />(defun new-mul-interval (x y)<br /> (let* ((ux (upper-bound x))<br /> (lx (lower-bound x))<br /> (uy (upper-bound y))<br /> (ly (lower-bound y))<br /> (signs (list-signs (list lx ux ly uy)))<br /> ;; max and min are needed for the special case<br /> (max (max (* lx ly) (* lx uy) (* ux uy) (* ux ly)))<br /> (min (min (* lx ly) (* lx uy) (* ux uy) (* ux ly))))<br /> (make-interval-if signs<br /> ((+ + + +) (lx ly) (ux uy))<br /> ((+ + - +) (ux ly) (ux uy))<br /> ((+ + - -) (ux ly) (lx uy))<br /> ((- + + +) (uy lx) (uy ux))<br /> ((- + - -) (ux ly) (lx ly))<br /> ((- - + +) (lx uy) (ly ux))<br /> ((- - - +) (lx uy) (ly lx))<br /> ((- - - -) (ux uy) (ly lx))<br /> ;; special case:<br /> ((- + - +) (min 1) (max 1)))))</pre><br /><br /><br /><blockquote>SICP Exercise 2.12<br />Define a constructor make-center-percent that takes a center and a percentage tolerance and produces the desired interval. You must also define a selector percent that produces the percentage tolerance for a given interval. The center selector is the same as the one shown above.</blockquote><br /><br /><pre class="prettyprint lang-cl">(defun make-center-percent (center percent)<br /> (let ((percent (/ percent 100.0)))<br /> (cons (- center (* center percent))<br /> (+ center (* center percent)))))<br /><br />(defun center (interval)<br /> (/ (+ (lower-bound interval) (upper-bound interval)) 2))<br /><br />(defun percent (interval)<br /> (let ((center (center interval))<br /> (lb (lower-bound interval)))<br /> (* (/ (- center lb)<br /> center)<br /> 100)))</pre>Billyhttp://www.blogger.com/profile/01672383908376893630noreply@blogger.com0