This page may be found online at
Code Files (for those who want brief solutions)
count.ss-- Code for counting characters.
split.ss-- Code for splitting strings.
You may recall that we defined the dating desires for each datee in our dating service as something like the following:
Each desire is one of the following: (1) a list consisting of the symbol
characteristicand a string; (2) a list consisting of a symbol for one of the base characteristics (such as
eyecolor) and an appropriate corresponding value (typically a string or a number); (3) a list consisting of the symbol
likesand a string; (4) a list consisting of the symbol
agerangeand two integers.
Here's a sample list of desires
(define jacks-desires '((characteristic "cute") (characteristic "smart") (eyecolor "blue") (eyecolor "hazel") (height 70) (height 71) (height 72) (height 73) (likes "computer science") (likes "voting")))
However, most of us wrote relatively primitive procedures for reading in
desires. Now is your chance to remedy that problem. Document,
write, and test a procedure,
read-desires, that reads in
as many desires as the client wishes to enter. Your procedure
should return a list of desires.
Hint: You may also want to define a
My first inclination is to look for stuff that I've already written
that may help with this problem. For
homework 3, I created a utility
that contains a number of general utility procedures for reading values.
I would hope that you would have done the same, since I posted that solution.
(read-positive-number prompt)reads a positive number.
(read-string prompt)reads a string.
(read-symbol prompt list-of-valid)reads a symbol.
(read-string-list prompt terminator)reads a list of strings.
It seems that each of these may be useful at one time or another.
As I suggested in class, it may be helpful to write a short introduction. Here's a procedure to do just that.
;;; Procedure: ;;; intro ;;; Parameters: ;;; (none) ;;; Purpose: ;;; Prints out an introduction. ;;; Produces: ;;; Nothing ;;; Preconditions: ;;; Still able to write to standard output. ;;; Postconditions: ;;; Has printed some text. (define intro (lambda () (display "Soon I will ask you to describe your ideal date.") (newline) (display "If you want to give a multiple-word response to any.") (newline) (display "question, you will need to surround that response with") (newline) (display "quotation marks.") (newline) (display " I will ask you for eye color, hair color, weight, ") (newline) (display "height, age, and other characteristics.") (newline) (display " I will also ask you for a list of things you'd like") (newline) (display "your date to like") (newline)))
There are two basic interfaces I can give to the user. I can either ask for type of desire and value each time or I can ask for all the values for each kind of desire before going on. Many of you decided that we're better off dealing with a range of weights and heights, and I'll follow your lead.
Here's an example of the first type of interaction.
What kind of desire would you like to enter? (eyecolor, agerange, characteristic, etc): eyecolor What eyecolor would you like? red Are there other desires you'd like to enter? yes What kind of desire would you like to enter? (eyecolor, agerange, characteristic, etc): agerange What is the youngest age you'll date? twenty-something I'm sorry, I only understand numbers. What is the youngest age you'll date? 20 What is the oldest age you'll date? 30 Are there other desires you'd like to enter? no Here's the result: ((eyecolor red) (agerange 20 30))
Here's an example of the second type of interaction.
Please enter an eyecolor (or X to stop): red Please enter an eyecolor (or X to stop): blue Please enter an eyecolor (or X to stop): X Please enter a minimum weight: 0 Please enter a minimum height (or 0 to stop): 72 Please enter a height (or 0 to stop): 0 ... Here's the result: ((eyecolor red) (eyecolor blue) (height 72))
Let's try each in turn. For the first interface, we'll need to print
the introduction with a call to
(intro) and then repeatedly
ask for desires. Since we do repetition through recursion, I'll create
a helper procedure. Rather than starting with the yes/no question, I'll
start by reading a desire and then ask the "Do you want to continue?"
I've decided that I may ask other yes/no questions, so I've written a helper
ask-yes-no, that asks such questions and returns true
for yes and false for no. You can see the code for it in
(letrec ((helper (lambda () ; Read one desire (let ((desire (read-one-desire))) ; Check if the client wishes to enter other desires (if (ask-yes-no "Do you wish to enter any other desires? ") ; Yes. Recurse. (cons desire (helper)) ; No. Return a one element list. (cons desire null))))))
The body of my
read-desires procedure is then only two lines.
Of course, we do still have to write
prompts for a category and then asks the appropriate question.
We can prompt for a category with
check for the result with
cond. In simple cases, we
just read a string and put it in a list with the category. In the
case of ranges, we use further helper procedures.
;;; Procedure: ;;; read-one-desire ;;; Parameters: ;;; (none) ;;; Purpose: ;;; Reads one desire, prompting for the type of desire as well ;;; as the particular desire. ;;; Produces: ;;; A desire, in the standard format. ;;; Preconditions: ;;; Able to read input and write output. ;;; Postconditions: ;;;; Returns a desire in the appropriate format. (define read-one-desire (lambda () ; Determine the category (let ((category (read-symbol (string-append "What kind of desire do you wish to enter?" (string #\newline) " ") (list 'eyecolor 'haircolor 'height 'weight 'age 'characteristic 'like)))) ; Which category is it? (cond ; Eye color ((equal? category 'eyecolor) (list 'eyecolor (read-string "What eye color do you like? "))) ; Hair color ((equal? category 'haircolor) (list 'haircolor (read-string "What hair color do you like? "))) ; Age range ((equal? category 'age) (read-age-range)) ; Height range ((equal? category 'height) (read-height-range)) ; Weight range ((equal? category 'weight) (read-weight-range)) ; Other characteristic ((equal? category 'characteristic) (list 'characteristic (read-string "What characteristic are you looking for? "))) ; A like ((equal? category 'like) (list 'likes (read-string "What do you want your date to like? "))) ; Default. This should not happen. (else (begin (display "I can't understand ") (display (symbol->string category)) (display ".") (newline) (list 'unknown category)))))))
You may have noted that there are a number of places in which I read
ranges. If I were sensible, I'd define a
procedure. Since I'm not, I defined separate
procedures. Here's one of them. You can find the others in
;;; Procedure ;;; read-age-range ;;; Parameters: ;;; (none) ;;; Purpose: ;;; Reads a range of ages. ;;; Produces: ;;; A list of the form ('agerange number number). ;;; Preconditions: ;;; Possible to read input and write output. ;;; Postconditions: ;;; Reads input, writes output. ;;; Result is in the appropriate form. ;;; Note: ;;; Does not verify that the younger age is smaller than the ;;; older age. (define read-age-range (lambda () (let* ((youngest (read-positive-number "What is the youngest age you'd like to date? ")) (oldest (read-positive-number "What is the oldest age you'd like to date? "))) (list 'agerange youngest oldest))))
For the second solution, I simply ask for each thing in turn. I call
read-weight-range. For everything else, I can use
read-string-list to read in lots of values. I then need
to convert each value to a list of a form like
What better way to do that than to use
map? Now that I've
created all these lists, I can join them together with
Since the first three things I get aren't lists of lists, I put them in one
;;; Procedure: ;;; read-desires-two ;;; Parameters: ;;; Reads a list of desires, one by one. Reads all the responses ;;; for each kind of desires before going on to the next. ;;; Produces: ;;; A potentially-empty list of desires. ;;; Preconditions: ;;; It is currently possible to read input and print output. ;;; Postconditions: ;;; Has read some input and printed some output. (define read-desires-two (lambda () (intro) (append (list (read-age-range) (read-height-range) (read-weight-range)) (map (lambda (color) (list 'eyecolor color)) (read-string-list "What eye color do you like (x to stop)? " "x")) (map (lambda (color) (list 'hair color)) (read-string-list "What hair color do you like (x to stop)? " "x")) (map (lambda (thing) (list 'characteristic thing)) (read-string-list "What other characteristic are you looking for (x to stop)? " "x")) (map (lambda (like) (list 'likes like)) (read-string-list "What would you like your date to like (x to stop)? " "x")))))
As you can guess, I was hoping to test many things with this problem. The first was to see whether you'd started to master techniques for generating output and getting input from Scheme. The second was to see whether you could extend those techniques to getting multiple values. The third was to see whether you could extend your work from homework 3. The fourth was to see whether you'd build upon solutions already given to you. There were probably others, too.
Sarah and Steven Schemer suggest that it was just too much
effort to write the
read-person procedure for homework 3. ``After all,''
they say, ``clients can just enter information about themselves
in DrScheme, as in the following.''
> (define me '("John" "Doe" male both 33 ((height 66) "handsome" "creative" "smart") ("fast cars" "lego" "computer science") ((characteristic "cute") (characteristic "smart") (eyecolor "blue") (eyecolor "hazel") (height 70) (height 71) (height 72) (height 73) (likes "computer science")))) > (suggest-dates me datees)
Write two or three paragraphs that argue for or against their position.
It is clearly a pain in the body-part-of-your-choice to write the
read-desires procedure. (I think it may even have
taken me longer than it took some of you because I quested for
really clean code, long-winded explanations, and variants.) While
it is worth such effort if it produces a much nicer interface for
the client, it is not clear that the "Enter XXX" interface is all
Why is it not nice? Because there is no way to correct something that you didn't mean to enter (or that you entered incorrectly). Because you have to remember to type those quotation marks around multiple-word answers. Because you have to answer many extra questions (lots of yes/no questions in the first interface; all the categories in the second case, even if all you want is someone who likes computer geeks). Is all our work worth that much frustration for the client? Certainly not? Could we write a better interface? Yes, but it would probably take the rest of the semester, at least given our current skills :-).
Finally, it doesn't really require much knowledge to enter data in the form we did above. GIven some good examples or coaching, most Grinnell students could figure out what to do. While you might occasionally get things wrong and therefore receive weirdo error messages, the error messages are probably no worse than those that come from the interface we wrote (or as a result of unchecked values we've read).
[Side note: Now that we now how to build Web interfaces, that might be the best solution. Not too much time on our part. Fairly easy to use and correct for the client.]
[Side note: One could also argue that the best way to use any dating service is to speak with real people. The "intermediary" could then type in the Scheme code after chatting with the client.]
By requiring the client to enter Scheme code, you are limiting the audience of our dating service. While it is clear that the ability to program in Scheme increases anyone's desirability, it is also clear that there are people who might be worth dating who cannot write any Scheme. As we've seen in this class, even "copy, paste, replace, and execute" code is hard to get right, so we can't just expect our clients to do so.
While clients may still get error messages from our interface when they enter strings incorrectly, we expect that those messages (which we can control) will be more understandable than the typical Scheme messages.
Everyone disagreed with the Schemers. I'll admit that I think they're more right than you give them credit for.
Sarah and Steven have encountered the follow procedure that does not
meet their model for predicates.
In particular, they can't find the
;;; Procedure: ;;; same-person? ;;; Purpose: ;;; Determine if two people are the same. ;;; Currently, that the two people have the same name, but that ;;; may change. ;;; Parameters: ;;; Two people in the appropriate form. ;;; Returns: ;;; #t, if they are; #f otherwise. ;;; Preconditions: ;;; All people are in the approved form. ;;; Postconditions: ;;; Does not affect the parameters. (define same-person? (lambda (person1 person2) (equal? (get-datee-full-name person1) (get-datee-full-name person2))))
Explain to Sarah and Steven how this can code can work, even
though it lacks an
Although I didn't make it explicit, Sarah and Steven expect to see
(define same-person? (lambda (person1 person2) (if (equal? (get-datee-full-name person1) (get-datee-full-name person2)) #t #f)))
Why is the extant code as good (or perhaps better)? Their code says
If the test returns true, then return true. If the test returns false, then return false.
We can simplify that to
Return the same thing that the test returns.
Hence, we don't need an
if because the procedure does what we expect
Many of you found that this problem was strange. The purpose of the
problem was to force you to think about (and therefore resolve) the
common misconception that you always need to put a test in either an
if or a
I found it interesting that many of you used the word ``if'' in your answer, as in
if the two people match, return true
Believe it or not, but I let my wife play with our dating service
(with a cleverly created database that suggests me first. She noted
that it would be helpful to see a list of the adjectives that
people have already submitted. I'm turning the problem over to you.
Write a procedure,
list-likes that takes a list of datees
as a parameter and returns a list that contains all the likes listed,
with no duplicates.
For this problem, any helper procedures should be local to
The overall structure to my solution to this problem is fairly simple:
If we didn't have to worry about making the helpers local, all we'd have to write is
Joining the likes together is fairly straightforward. We recurse through the list, appending the current set of likes to any remaining likes.
;;; Procedure: ;;; join-likes ;;; Parameters: ;;; A list of datees ;;; Produces: ;;; A list of likes with potential duplicates. ;;; Preconditions: ;;; The list of datees is in the approved format. In ;;; particular, (list-ref datee 6) gives a list of likes. ;;; Postconditions: ;;; Returns a list of strings representing all possible likes. ;;; If a string appears in some list of likes, it appears in ;;; that list. ;;; If a string appears in the result list, it appears in some ;;; list of likes. (define join-likes (lambda (datees) ; If no one is left in our list, there are no likes. (if (null? datees) null ; Otherwise, join this person's likes to the remaining likes (append (list-ref (car datees) 6) (join-likes (cdr datees))))))
Of course, you may note that we can use some of the higher-order procedures
for a more concise solution to this part of the problem. First we make
a list of the lists of likes by mapping an appropriate call to
list-ref onto the list of datees. Then we apply
to that list. (Our original code does almost exactly the same thing, but in
a different order).
(define join-likes (lambda (datees) (apply append (map (lambda (datee) (list-ref datee 6)) datees))))
There are a number of ways to remove duplicates from a list. We can step through the list, value by value, removing any that appear in the rest of the list.
;;; Procedure: ;;; remove-duplicates ;;; Parameters: ;;; A list of strings. ;;; Purpose: ;;; Remove duplicate entries. ;;; Produces: ;;; A list of strings with no duplicate entries. ;;; Preconditions: ;;; The parameter is a list of strings. [Unverified] ;;; Postconditions: ;;; Returns a list of strings. ;;; No string appears twice in the result list. ;;; Every string in the original list appears in the result list. ;;; Every string in the result list appeared in the original list. (define remove-duplicates (lambda (lst) ; The empty list has no duplicates (if (null? lst) null ; Otherwise, get the first element and remove duplicates from the rest. (let ((first (car lst)) (rest (remove-duplicates (cdr lst)))) ; If the first element is in the rest of the list, don't use it. (if (member first rest) rest ; Otherwise, do use it. (cons first rest))))))
We can also step through the list, removing copies of each element from the remainder of the list.
(define remove-duplicates (lambda (lst) ; The empty list has no duplicates (if (null? lst) null ; Otherwise, remove copies of the first element from the rest. (cons (car lst) (remove-duplicates (remove-copies (car lst) (cdr lst)))))))
Of course, that requires us to write
;;; Procedure: ;;; remove-copies ;;; Parameters: ;;; A string, removeMe ;;; A list of strings, strings ;;; Purpose: ;;; Removes all copies of a value from a list. ;;; Produces: ;;; A list of strings. ;;; Preconditions: ;;; The parameter is a list of strings. ;;; Postconditions: ;;; The result list contains only strings. ;;; The result list does not contain removeMe. ;;; Every value (other than removeMe) that appeared in strings appears ;;; in the result. ;;; Every value that appears in the result appeared in strings. (define remove-copies (lambda (removeMe strings) (cond ((null? strings) null) ((equal? removeMe (car strings)) (remove-copies removeMe (cdr strings))) (else (cons (car strings) (remove-copies removeMe (cdr strings)))))))
A hybrid possibility is to use a two-parameter helper that takes as parameters both the remaining strings to investigate and the strings seen so far.
(define remove-duplicates (lambda (lst) (letrec ((helper (lambda (vals acc) (cond ((null? vals) (reverse acc)) ((member (car vals) acc) (helper (cdr vals) acc)) (else (helper (cdr vals) (cons (car vals) acc))))))) (helper lst null))))
Now we need to make those helpers local to
(define list-likes (lambda (datees) (letrec ( ; Helper one: join-likes (join-likes (lambda (datees) (apply append (map (lambda (datee) (list-ref datee 6)) datees)))) ; Helper two: remove-dupes lst acc (remove-dupes (lambda (vals acc) (cond ((null? vals) (reverse acc)) ((member (car vals) acc) (remove-dupes (cdr vals) acc)) (else (remove-dupes (cdr vals) (cons (car vals) acc))))))) ; Okay, go for it! (remove-dupes (join-likes datees) null))))
As you might expect, the primary goal of this problem was to force you to do multiple recursions within the same procedure. Here, you need to recuse on the database and then again over the result list (at least in the typical solution). As in problem 1, I was also hoping to verify that you'd managed to master issues from homework 3. Finally, I wanted to test your ability to define local helpers. (As you may have noted from my solution, I expected you to wait until the end of your work to make them local.)
I was surprised that many of you decided to copy and paste the database
directly into your exam, particularly since I'd already told you that
(load "datees.ss") would get all of them.
a. Write a procedure,
(count-chars pred? string)
that counts how many characters in a string match a predicate.
(count-chars char-alphabetic? "Hello world.")
should return 10.
count-chars, write a procedure
that counts the number of punctuation characters that appear in a string.
count-chars, all helpers must be local. For
the purposes of this question, the punctuation characters are
quotation mark (
exclamation point (
question mark (
Since we can use
string-ref to extract individually
charaacters, we step through the list, looking at each character
in turn and counting it if it matches the predicate. I've written
a tail-recursive version.
;;; Procedure: ;;; count-chars ;;; Parameters: ;;; A predicate ;;; A string ;;; Purpose: ;;; Counts all the characters in the string that meet the predicate. ;;; Produces: ;;; A count of all such characters (an integer). ;;; Preconditions: ;;; The predicate maps characters to boolean values. ;;; The string is a string. ;;; Postconditions: ;;; Counts correctly. (define count-chars (lambda (pred? str) (letrec ((helper (lambda (pos ; Current position in the string. max ; Last position in the string. count) ; How many characters already matched. (cond ; If we've finished the string, stop. ((> pos max) count) ; If the first character meets the predicate, add 1 ((pred? (string-ref str pos)) (helper (+ 1 pos) max (+ 1 count))) ; Otherwise, just look at the rest. (else (helper (+ 1 pos) max count)))))) (helper 0 ; Start at the front (- (string-length str) 1) ; Stop at the last character. Since 0-based, ; stop one before the end. 0)))) ; Haven't seen anything yet.
How do we tell if a character is one of a group of characters?
We can use an
or of lots of calls to equality tests.
We can check if the character is a member of the group. We can
check ASCII values (UGH).
;;; Procedure: ;;; count-punc ;;; Parameters: ;;; A string ;;; Purpose: ;;; Counts all punctuation characters in the string. ;;; Produces: ;;; A count of all punctuation (an integer). ;;; Preconditions: ;;; The string is a string. ;;; Postconditions: ;;; Counts correctly. ;;; Note: ;;; Uses the following punctuation: ;;; * apostrophe ('), ;;; * colon (:), ;;; * comma (,), ;;; * quotation mark ("), ;;; * exclamation point (!), ;;; * parentheses (( and )), ;;; * period (.), ;;; * question mark (?), and ;;; * semi-colon (;). (define count-punc (lambda (str) (let ((punc (string->list "':,\"!().?;"))) (count-chars (lambda (ch) (member ch punc)) str))))
My primary goal for this problem was to test your expertise writing your own higher-order procedures. I also wanted to see how well you'd be able to recurse through strings.
Many of you turned the string into a list. This is not a very efficient solution, but it works.
Many of you recursed on
(substring str 1 (string-length str)).
This solution is particularly inefficient as you have to build lots of new
Write a procedure that takes two strings (a source string and a split string) as parameters and returns a list of strings that correspond to the parts of the source string separated by the split sting. For example,
> (split "Hello there you fool" " ") ("Hello" "there" "you "fool") > (split "alpha,beta,gamma" ",") ("alpha" "beta" "gamma") > (split "fufie fubar fun" "fu") ("" "fie " "bar " "n")
As I suggested in email, the best way to solve this problem is to break it into parts. First find the first index of the split string within the source. Next, split at that point. Finally, recuse on the first.
How do we find the index of the split string? Look to see if the split string is the substring starting at index 0. If so, the index of the split string is 0. If not, try 1. Keep going until you run out of possible indices.
;;; Procedure: ;;; find-index ;;; Parameters: ;;; A pattern string. ;;; A source strng. ;;; Purpose: ;;; Finds the index of the pattern string in the source string. ;;; Produces: ;;; The index of the first match of the pattern within the source, ;;; if the pattern falls within the source. ;;; -1, otherwise ;;; Preconditions: ;;; Both parameters are strings. ;;; Postconditions: ;;; If the result is not -1 then it is the first value, i, such ;;; that the substring of source beginning at i of length equal ;;; to the length of pattern is the same as pattern). (define find-index (lambda (pattern source) ; Remember some key values for efficiency (let ((plen (string-length pattern)) (slen (string-length source))) ; Helper procedure. Keeps track of where we're looking. (let helper ((index 0)) ; The index we're currently checking. (cond ; If there are too few characters left, give up ((< (- slen index) plen) (- 0 1)) ; If the current substring matches, return its index ((equal? (substring source index (+ index plen)) pattern) index) ; Otherwise, advance to the next thing. (else (helper (+ index 1))))))))
Okay, once we've found the index of the splitter, how do we split? First, we take the substring of everything up to the splitter. Recall that substring ends on the character before the third parameter.
(substring source 0 split-index)
Next, we take the substring that appears after the splitter.
(substring source (+ split-index (string-length splitter)) (string-length source))
We then recurse on that second string.
Putting it all together:
; Procedure: ;;; split ;;; Parameters: ;;; source, a string ;;; splitter, a string ;;; Purpose: ;;; Split the source at every occurence of the splitter. ;;; Produces: ;;; A list of strings. ;;; Preconditions: ;;; Both parameters are strings. ;;; Postconditions: ;;; Affects neither string. ;;; Examples: ;;; > (split "Hello there you fool" " ") ;;; ("Hello" "there" "you "fool") ;;; > (split "alpha,beta,gamma" ",") ;;; ("alpha" "beta" "gamma") ;;; > (split "fufie fubar fun" "fu") ;;; ("" "fie " "bar " "n") ;;; > (split "me and you and a dog named boo" " and ") ;;; ("me" "you" "a dog named boo") (define split (lambda (source splitter) ; (1) Find the index of the splitter in the source. (let ((split-index (find-index splitter source))) ; (2) If the splitter is not in the source (indicated by a ; index of -1), just return a list containing the source. (if (= split-index -1) (list source) ; Otherwise, split at the splitter and recurse (cons (substring source 0 split-index) (split (substring source (+ split-index (string-length splitter)) (string-length source)) splitter))))))
Another problem in which I wanted you to think about nested recursion. Also another chance to see how well you learned (or read about) strings.
This was clearly the hardest problem on the exam, although I did not intend it as such. Some of you spent longer on the first problem, but it sounds like that was mostly a matter of resolving little errors than of trying to figure out what to do.
I note that this problem also had the widest range of times spent. The least time was fifteen minutes (for a working solution!). The greatest was over ten hours.
Saturday, 11 November 2000
Sunday, 12 November 2000
Monday, 13 November 2000
Disclaimer Often, these pages were created "on the fly" with little, if any, proofreading. Any or all of the information on the pages may be incorrect. Please contact me if you notice errors.
This page may be found at http://www.cs.grinnell.edu/~rebelsky/Courses/CS151/2000F/Exams/examnotes.02.html
Source text last modified Mon Nov 13 10:41:12 2000.
This page generated on Mon Nov 13 10:41:53 2000 by Siteweaver. Validate this page's HTML.
Contact our webmaster at email@example.com