My solutions to the scheme text "How to Design Programs 2nd ed". (Or htdp2e) I aim to complete as many as these as I can - please feel free to comment on my solutions/answers!
Sunday, 8 January 2012
Exercise 152: More text editing...
Note: These are my answers as I originally created them. As I have moved on to questions 153 and 154 I have discovered that some of my tests are simply wrong. I've left them incorrect here as this was how I originally answered them and they aren't actually being as part of this answer. You will need to read the posts for questions 153 and 154 to see my (corrected) answers!!!
Explain why the template for editor-kh deals with "\t" and "\r" before it checks for strings of length 1.
Strings of length 1 (ie, ordinary typed characters) need to be simply inserted into the text. ; Any special characters (eg tabs, backspaces) need to take an appropriate special action (eg deleting text, adding a carriage return etc).
The issue is that "\b", "\r" etc are only one charater long eg:
> (string-length "\b")
1
So, we need to check for and handle these special characters first, and only then handle any other ordinary single characters;
; code supplied by the text book
(define (editor-kh ed k)
(cond
[(key=? k "left") (editor-lft ed)]
[(key=? k "right") (editor-rgt ed)]
[(key=? k "\b") (editor-del ed)]
[(key=? k "\t") ed]
[(key=? k "\r") ed]
[(= (string-length k) 1) (editor-ins ed k)]
[else ed]))
; dummy functions
(define (editor-lft ed) 1)
(define (editor-rgt ed) 1)
(define (editor-del ed) 1)
(define (editor-ins ed k)
(make-editor (cons k (editor-pre ed)) (editor-post ed)))
; test function for editor-ins. Empty editor should let you
; insert text at the front of the pre element
(check-expect
(editor-ins (make-editor empty empty) "e")
(make-editor (cons "e" empty) empty))
; test function for editor-ins. Text should be inserted before
; any existing text. Remember that the letters in 'pre' are
; stored in reverse order, so if we want to append text,
; we need to append it to the start.
; This apparently makes the design easier, but they
; haven't clarified why this should be ... (yet)
(check-expect
(editor-ins (make-editor (cons "d" empty)
(cons "f" (cons "g" empty)))
"e")
(make-editor (cons "e" (cons "d" empty))
(cons "f" (cons "g" empty))))
Anything below here is from 151.scm and is included cause we need these chunks of code - these aren't part of the answers to this question. Comments have been removed - if you're curious, go and read the post for question 151!
; Lo1s -> Lo1s
; produce a reverse version of the given list
(check-expect
(rev (cons "a" (cons "b" (cons "c" empty))))
(cons "c" (cons "b" (cons "a" empty))))
(define (rev l)
(cond ((empty? l) l)
((cons? l) (add-to-end (first l)
(rev (rest l))))))
; adds an item to the end of the given list
; I didn't read this section of the manual as I wanted to come up
; with this on my own.
; I had issues at this point as I kept wanting to use 'cons' to join the two
; lists together - this of course results in a nested list (which is not what
; we want. eg;
; (cons (list "a" "b") (cons "a" empty)) => (list (list "a" "b") "a")
; After I discovered the 'append' function, this function shrank away to almost
; nothing. The only reason we need it now, is to save creating the second
; list with item and empty in the main function.
(define (add-to-end item l)
(append l (cons item empty)
))
(check-expect (add-to-end "a" empty) (list "a"))
(check-expect (add-to-end "c" (list "a" "b")) (list "a" "b" "c"))
; An Editor is (make-editor Lo1S Lo1S)
; An Lo1S is one of:
; – empty
; – (cons 1String Lo1S)
(define-struct editor (pre post))
; This function consumes two strings and produces an Editor.
(define (create-editor left-string right-string)
(make-editor (explode left-string) (explode right-string)))
; These values are given directly by the question
; constants
(define HEIGHT 20) ; the height of the editor
(define WIDTH 200) ; its width
(define FTSZ 11) ; the font size
(define FTCL "black") ; the font color
; graphical constants - also supplied directly by the question
(define MT (empty-scene WIDTH HEIGHT))
(define CU (rectangle 1 HEIGHT "solid" "red"))
; Editor -> Image
; render an editor as an image of the two texts separated by the cursor
; (supplied directly from the question)
(define (editor-render e)
MT)
; main : String -> Editor
; launch the editor given some initial string
; (supplied directly from the question)
(define (main s)
(big-bang (create-editor s "")
(on-key editor-kh)
(to-draw editor-render)))
; At this point we can actually call our editor, but it doesn't
; do anything interesting yet. (Or anything at all really!)
;(make-editor (make-editor "Hello" "World") "")
; The first two test statements are supplied by the question.
; This first checks to make sure that when you press 'e' you
; create an editor displaying e
(check-expect (editor-kh (create-editor "" "") "e")
(create-editor "e" ""))
; This checks that when you type 'e', it's added at the cursor point
; (rather than the beginning or end of the editor)
(check-expect (editor-kh (create-editor "cd" "fg") "e")
(create-editor "ecd" "fg"))
Monday, 7 November 2011
Exercise 151 - Designing an editor
Exercise 151: Design the function create-editor.
The function consumes two strings and produces an Editor. The first string is the text to the left of the cursor and the second string is the text to the right of the cursor. The rest of the section relies on this function.
First up, I wanted to roll my own rev function instead of going off the one in the book. This was a fairly short question and so needed some padding to make it interesting!
; Lo1s -> Lo1s
; produce a reverse version of the given list
(check-expect
(rev (cons "a" (cons "b" (cons "c" empty))))
(cons "c" (cons "b" (cons "a" empty))))
(define (rev l)
(cond ((empty? l) l)
((cons? l) (add-to-end (first l)
(rev (rest l))))))
Now we need our wish-list function 'add-to-end'.
I didn't read this section of the manual as I wanted to come up with the solution to this on my own.
I had issues at this point as I kept wanting to use 'cons' to join the two lists together - this of course results in a nested list (which is not what we want). eg;
(cons (list "a" "b") (cons "a" empty))
=> (list (list "a" "b") "a")
After I discovered the 'append' function, this function shrank away to almost nothing. The only reason we need it now, is to save creating the second list with item and empty in the main function.
; adds an item to the end of the given list
(define (add-to-end item l)
(append l (cons item empty)
))
(check-expect (add-to-end "a" empty) (list "a"))
(check-expect (add-to-end "c" (list "a" "b"))
(list "a" "b" "c"))
Now, for the actual question - we need to make an Editor. This function consumes two strings and produces an Editor.
; An Editor is (make-editor Lo1S Lo1S)
; An Lo1S is one of:
; - empty
; - (cons 1String Lo1S)
(define-struct editor (pre post))
This method really seems overkill (or I'm not doing something I should be doing... it seems we've cut down on typing by 2 characters (the difference between m-a-k-e and c-r-e-a-t-e)
Perhaps my possible lack of comprehension will become clearer later on in exercise 152, but for now, this is what I think they are after ...
(define (create-editor left-string right-string)
(make-editor left-string right-string))
All these constants below are given by the question - I'm just pasting them here for completeness
; constants
(define HEIGHT 20) ; the height of the editor
(define WIDTH 200) ; its width
(define FTSZ 11) ; the font size
(define FTCL "black") ; the font color
; graphical constants - also supplied directly by the question
(define MT (empty-scene WIDTH HEIGHT))
(define CU (rectangle 1 HEIGHT "solid" "red"))
; Editor -> Image
; render an editor as an image of the two texts separated by the cursor
; (supplied directly from the question)
(define (editor-render e)
MT)
; Editor KeyEvent -> Editor
; deal with a key event, given some editor
; (supplied directly from the question)
(define (editor-kh ed ke)
ed)
; main : String -> Editor
; launch the editor given some initial string
; (supplied directly from the question)
(define (main s)
(big-bang (create-editor s "")
(on-key editor-kh)
(to-draw editor-render)))
At this point we can actually call our editor, but it doesn't do anything interesting yet. (Or anything at all really!)
(make-editor (make-editor "Hello" "World") "")
The first two test statements are supplied by the question. The rest are what we need to come up to answer the question.
; This first checks to make sure that when you press 'e' you
; create an editor displaying e
(check-expect (editor-kh (create-editor "" "") "e")
(create-editor "e" ""))
; This checks that when you type 'e', it's added at the
; cursor point
; (rather than the beginning or end of the editor)
(check-expect (editor-kh (create-editor "cd" "fgh") "e")
(create-editor "cde" "fgh"))
; check that pushing backspace deletes text from the
; correct location
(check-expect (editor-kh (create-editor "Bob" "Dylan") "\b")
(create-editor "Bo" "Dylan"))
(check-expect (editor-kh (create-editor "" "") "\b")
(create-editor "" ""))
; check we can use the cursor to move to the left
(check-expect (editor-kh (create-editor "Bob" "Dylan") "left")
(create-editor "Bo" "bDylan"))
(check-expect (editor-kh (create-editor "" "Dylan") "left")
(create-editor "" "Dylan"))
; check we can use the cursor to move to the right
(check-expect (editor-kh (create-editor "Bob" "Dylan") "right")
(create-editor "BobD" "ylan"))
(check-expect (editor-kh (create-editor "Bob" "") "right")
(create-editor "Bob" ""))
Tuesday, 18 October 2011
Exercise 150 - Transposing a Matrix
Mathematics teachers may have introduced you to matrix calculations by now. Numeric programs deal with those, too. Here is one possible data representation for matrices:
; A Matrix is one of:
; – empty
;; – (cons LN Matrix)
; An LN is one of:
; – empty
;; – (cons Number LN)
; interp. a matrix is a list of rows, a row is a list of numbers
; constraint: all rows are of the same length
Study it and translate the two-by-two matrix consisting of the numbers 11, 12, 21, 22 into this data representation.
They don't make it 100% clear how this should translate to a matrix (eg horizontally or vectically), but common sense would be to divide it into two horizontal rows
(require racket/base)
(define MATRIX (list (list 11 12)
(list 21 22)))
; define an extra couple of Matrix's to use for testing.
(define MATRIX2 (list (list 11 12)
(list 21 22)
(list 31 32)))
(define MATRIX3 (list (list 11 12 13)
(list 21 22 23)
(list 31 32 33)))
Study it and translate the two-by-two matrix consisting of the numbers 11, 12, 21, 22 into this data representation.
The following function implements the important mathematical operation of transposing the entries in a matrix. To transpose means to mirror the entries along the diagonal, that is, the line from the top-left to the bottom-right.
; Matrix -> Matrix
; transpose the items on the given matrix along the diagonal
;(check-expect (transpose mat1) tam1)
(define (transpose lln)
(cond
[(empty? (first lln)) empty]
[else (cons (first* lln) (transpose (rest* lln)))]))
The definition assumes two auxiliary functions:
first*, which consumes a matrix and produces the first column as a list of numbers;;
rest*, which consumes a matrix and removes the first column. The result is a matrix.
Even though you lack definitions for these functions, you should be able to understand how transpose works. You should also understand that you cannot design this ;function with the design recipes you have seen so far. Explain why.
Design the two “wish list” functions. Then complete the design of the transpose with some test cases.
I am not at all sure how transpose works at this point! (My maths-fu is weak). From reading the code, it seems to work thru a list of lists of numbers, taking the first column and then creating a new list by adding this first column back onto the start of the matrix (which has just had the first column removed!
(An example here would have gone a long way.)
Even if this is transposing the colums, it seems it would be working in complete columns, so I'm not sure how it could ever produce a diagonal transposition.
To confound things further, they say "You cannot design this function". then without explaining anything further, they tell us to go design this function!
I'm not sure if i'm meant to be able to do this or not, but we'll have a try... If we can run the code and it does what they say, perhaps seeing it in process may make things clearer!
The function first* is not too hard - it's the standard recursive scheme function. If the matrix is empty, return empty, otherwise build up a new list consisting of the first number in the list, and the result of calling this on the *rest* of the rows in the matrix
;first* consumes a matrix and produces the first column as a
;list of numbers
; Matrix -> LN
(define (first* lln)
(cond ((empty? lln) empty)
((cons? lln) (cons (first (first lln))
(first* (rest lln))))))
(check-expect (first* MATRIX) (list 11 21))
(check-expect (first* MATRIX2) (list 11 21 31))
This is basically the inverse of first* - this time we want to grab the rest of each list and return that.
;Matrix -> Matrix
(define (rest* lln)
(cond ((empty? lln) empty)
((cons? lln) (cons (rest (first lln))
(rest* (rest lln))))))
(check-expect (rest* MATRIX) (list (list 12)
(list 22)))
(check-expect (rest* MATRIX2) (list (list 12)
(list 22)
(list 32)))
(check-expect (rest* MATRIX3) (list (list 12 13)
(list 22 23)
(list 32 33)))
Now to test the transposing - in theory, this function should turn our matrix from this:
; 11 12 13
; 21 22 23
; 31 32 32
into this:
; 11 21 31
; 12 22 32
; 13 23 33
(check-expect (transpose MATRIX3) (list (list 11 21 31)
(list 12 22 32)
(list 13 23 33)))
The test passes, so the transpose function does what it is meant to – but why?!?!
Let's add a debugging method to try and work out what's going on.
(define (print-matrix mat)
(cond ((empty? mat)
(fprintf (current-output-port) " *** \n"))
(else (fprintf (current-output-port)
" ~a\n"
(first mat))
(print-matrix (rest mat)))))
If you put this into the (transpose) function, you can see that transpose does rip the matrix apart into columns. Once the columns have been removed, these get cons'd together horizontally (as rows) to become the new Matrix. This automatically 'mirrors' each half along the diagonal without needing to work on diagonal sections of the matrix.
For example, originally if you had:
; (list (list 2 5)
; (list 8 9))
This would get ripped into the two colums (list 2 8) and (list 8 9) and then assembled as;
; (list (list 2 8)
; (list 8 9))
Thursday, 6 October 2011
Exercise 149: Design a BSL program that simulates the Unix command wc
Exercise 149: Design a BSL program that simulates the Unix command wc.
The purpose of the command is to count the number of characters (1Strings),
words, and lines in a given file. That is, the command consumes the name of
a file and produces a value that consists of three numbers.
(require racket/base)
(require 2htdp/batch-io)
First, create a function to count the chars
; calculates the number of chars in a string
; Spaces count as a character
; String->Number
(define (count-chars string)
(count-chars-helper (explode string) 0))
; List-of-Characters->Number
(define (count-chars-helper loc count)
(cond ((empty? loc) count)
((cons? loc) (count-chars-helper
(rest loc)
(add1 count)))))
(check-expect (count-chars "") 0)
(check-expect (count-chars "This is a string") 16)
Second stage - create a function to count the words
; calculates the number of words in a list of lists
; of strings
; List-Of-Lists-Of-String->Number
(define (count-words llos)
(count-words-helper llos 0))
; Does the actual work of getting the count
; - llos -> empty - returns the count
; - (rest llos) is a string - count it, and recurse
; - (rest llos) is a cons, we're on a new line, so just recurse
; List-Of-Lists-Of-String->Number
(define (count-words-helper llos count)
(cond ((empty? llos) count)
((cons? llos)
(cond ((string? (first llos))
(count-words-helper (rest llos) (add1 count)))
((empty? (first llos))
(count-words-helper (rest llos) count))
((cons? (first llos))
(count-words-helper
(first llos)
(count-words-helper (rest llos) count)))))))
Some tests to make sure we didn't mess that up!
; basic case - an empty list
(check-expect (count-words empty) 0)
; a list of strings
(check-expect (count-words
(list "This" "is" "a" "string"))
4)
; a list of lists of strings
(check-expect (count-words (list
(list "line" "one")
(list "line" "two")))
4)
; make sure we handle new lines (empty lists) okay
(check-expect (count-words (list (list "line" "one")
empty (list "line" "two")))
4)
Finally - last method - count the lines.
; calculates the number of lines in list of lists of strings
; this method is very straight forward - just counting the number of
; items present in our list
; basically just counting the lists
; List-of-Strings->Number
(define (count-lines los)
(count-lines-helper los 0))
(define (count-lines-helper los count)
(cond ((empty? los) count)
((cons? los) (count-lines-helper (rest los)
(add1 count)))))
(check-expect (count-lines empty) 0)
(check-expect (count-lines (list "This is a string"))
1)
(check-expect (count-lines (list (list "line one")
(list "line two")))
2)
(check-expect (count-lines (list (list "line one")
empty
(list "line two")))
3)
; finally, wrap it all up with a function that
; calls all 3 of our new methods and produces a list
; character, word and line counts
; String->List-of-Numbers
(define (wc filename)
(list
(count-chars (read-file filename))
(count-words (read-words/line filename))
(count-lines (read-lines filename))
))
The purpose of the command is to count the number of characters (1Strings),
words, and lines in a given file. That is, the command consumes the name of
a file and produces a value that consists of three numbers.
(require racket/base)
(require 2htdp/batch-io)
First, create a function to count the chars
; calculates the number of chars in a string
; Spaces count as a character
; String->Number
(define (count-chars string)
(count-chars-helper (explode string) 0))
; List-of-Characters->Number
(define (count-chars-helper loc count)
(cond ((empty? loc) count)
((cons? loc) (count-chars-helper
(rest loc)
(add1 count)))))
(check-expect (count-chars "") 0)
(check-expect (count-chars "This is a string") 16)
Second stage - create a function to count the words
This part is mildy tricky - there are three cases we need to deal with:
- if llos is currently a string, its just a string and we can recursively iterate on it til the end simply
- it's an empty list - ie, a blank line. We need to just skip this item and move on. If we try and count it, we'll get #void and it will make add1 very unhappy
- it's a populated list - ie, one or more populated lines. In this case we need to call count-words-helper on it twice - once to get the count for the first line, and again to get the count for all the remaining lines. The result of the first count feeds into the second call as we don't know how to maintain variable state yet... I found this part very difficult to grok
; calculates the number of words in a list of lists
; of strings
; List-Of-Lists-Of-String->Number
(define (count-words llos)
(count-words-helper llos 0))
; Does the actual work of getting the count
; - llos -> empty - returns the count
; - (rest llos) is a string - count it, and recurse
; - (rest llos) is a cons, we're on a new line, so just recurse
; List-Of-Lists-Of-String->Number
(define (count-words-helper llos count)
(cond ((empty? llos) count)
((cons? llos)
(cond ((string? (first llos))
(count-words-helper (rest llos) (add1 count)))
((empty? (first llos))
(count-words-helper (rest llos) count))
((cons? (first llos))
(count-words-helper
(first llos)
(count-words-helper (rest llos) count)))))))
Some tests to make sure we didn't mess that up!
; basic case - an empty list
(check-expect (count-words empty) 0)
; a list of strings
(check-expect (count-words
(list "This" "is" "a" "string"))
4)
; a list of lists of strings
(check-expect (count-words (list
(list "line" "one")
(list "line" "two")))
4)
; make sure we handle new lines (empty lists) okay
(check-expect (count-words (list (list "line" "one")
empty (list "line" "two")))
4)
Finally - last method - count the lines.
; calculates the number of lines in list of lists of strings
; this method is very straight forward - just counting the number of
; items present in our list
; basically just counting the lists
; List-of-Strings->Number
(define (count-lines los)
(count-lines-helper los 0))
(define (count-lines-helper los count)
(cond ((empty? los) count)
((cons? los) (count-lines-helper (rest los)
(add1 count)))))
(check-expect (count-lines empty) 0)
(check-expect (count-lines (list "This is a string"))
1)
(check-expect (count-lines (list (list "line one")
(list "line two")))
2)
(check-expect (count-lines (list (list "line one")
empty
(list "line two")))
3)
; finally, wrap it all up with a function that
; calls all 3 of our new methods and produces a list
; character, word and line counts
; String->List-of-Numbers
(define (wc filename)
(list
(count-chars (read-file filename))
(count-words (read-words/line filename))
(count-lines (read-lines filename))
))
Tuesday, 27 September 2011
Exercise 148: Design a program that encodes text files numerically.
Exercise 148: Design a program that encodes text files numerically.
Each letter in a word should be encoded as a numeric three-letter string with a value between 0 and 256. Here is our encoding function for letters:
; 1String -> String
; auxiliary for stating tests
;(define (code1 c)
; (number->string (string->int c)))
;
;(check-expect (encode-letter "\t")
; (string-append "00" (code1 "\t")))
;(check-expect (encode-letter "a")
; (string-append "0" (code1 "a")))
;(check-expect (encode-letter "z") (code1 "z"))
;
;(define (encode-letter s)
; (cond
; [(< (string->int s) 10) (string-append "00" (code1 s))]
; [(< (string->int s) 100) (string-append "0" (code1 s))]
; [else (code1 s)]))
; Before you start, explain this function. Also recall how
; a string can be converted into a list of 1Strings.
; Again, use read-words/line to preserve the organization of
; the file into lines and words.
They don't specify in the question what they want you to do with the output, so I'm going to return it as a plain string with no padding between the groups.
(require racket/base)
; 1String -> String
; convert the given 1string into a three-letter numeric string
; 1String -> String
; auxiliary for stating tests
(define (code1 c)
(number->string (string->int c)))
(check-expect (encode-letter "\t")
(string-append "00" (code1 "\t")))
(check-expect (encode-letter "a")
(string-append "0" (code1 "a")))
(check-expect (encode-letter "z")
(code1 "z"))
(define (encode-letter s)
(cond
[(< (string->int s) 10) (string-append "00" (code1 s))]
[(< (string->int s) 100) (string-append "0" (code1 s))]
[else (code1 s)]))
Explaining how it works is straight forward. code1 calls string->int, which will convert the char passed in into an int. (Presumably it's ascii code decimal equivilant). This is then converted to a string and returned.
As this will be a straight int (eg, no leading zero's) the function encode-letter will prepend "00" if the number is less than 10, or prepend "0" if the number is greater than 10 but less than 100.
; encode a list of numbers - returns a list of strings of
; encoded chars
; 1String -> String
(define (process-word loc)
(cond ((empty? loc) "")
((cons? loc) (string-append (encode-letter (first loc))
(process-word (rest loc))))))
(check-expect (process-word (list "t" "h" "e")) "116104101")
; Process the entire line of words into integer codes. Note the
; use of the 'explode' function here. I was originally trying
; to use string->list which will not work!
; List-of-Strings->String
(define (process-line los)
(cond ((empty? los)
"")
((cons? los)
(string-append (process-word (explode (first los)))
(process-line (rest los))))))
(check-expect (process-line (list "the" "cat" "in" "the" "hat"))
"116104101099097116105110116104101104097116")
Each letter in a word should be encoded as a numeric three-letter string with a value between 0 and 256. Here is our encoding function for letters:
; 1String -> String
; auxiliary for stating tests
;(define (code1 c)
; (number->string (string->int c)))
;
;(check-expect (encode-letter "\t")
; (string-append "00" (code1 "\t")))
;(check-expect (encode-letter "a")
; (string-append "0" (code1 "a")))
;(check-expect (encode-letter "z") (code1 "z"))
;
;(define (encode-letter s)
; (cond
; [(< (string->int s) 10) (string-append "00" (code1 s))]
; [(< (string->int s) 100) (string-append "0" (code1 s))]
; [else (code1 s)]))
; Before you start, explain this function. Also recall how
; a string can be converted into a list of 1Strings.
; Again, use read-words/line to preserve the organization of
; the file into lines and words.
They don't specify in the question what they want you to do with the output, so I'm going to return it as a plain string with no padding between the groups.
(require racket/base)
; 1String -> String
; convert the given 1string into a three-letter numeric string
; 1String -> String
; auxiliary for stating tests
(define (code1 c)
(number->string (string->int c)))
(check-expect (encode-letter "\t")
(string-append "00" (code1 "\t")))
(check-expect (encode-letter "a")
(string-append "0" (code1 "a")))
(check-expect (encode-letter "z")
(code1 "z"))
(define (encode-letter s)
(cond
[(< (string->int s) 10) (string-append "00" (code1 s))]
[(< (string->int s) 100) (string-append "0" (code1 s))]
[else (code1 s)]))
Explaining how it works is straight forward. code1 calls string->int, which will convert the char passed in into an int. (Presumably it's ascii code decimal equivilant). This is then converted to a string and returned.
As this will be a straight int (eg, no leading zero's) the function encode-letter will prepend "00" if the number is less than 10, or prepend "0" if the number is greater than 10 but less than 100.
; encode a list of numbers - returns a list of strings of
; encoded chars
; 1String -> String
(define (process-word loc)
(cond ((empty? loc) "")
((cons? loc) (string-append (encode-letter (first loc))
(process-word (rest loc))))))
(check-expect (process-word (list "t" "h" "e")) "116104101")
; Process the entire line of words into integer codes. Note the
; use of the 'explode' function here. I was originally trying
; to use string->list which will not work!
; List-of-Strings->String
(define (process-line los)
(cond ((empty? los)
"")
((cons? los)
(string-append (process-word (explode (first los)))
(process-line (rest los))))))
(check-expect (process-line (list "the" "cat" "in" "the" "hat"))
"116104101099097116105110116104101104097116")
Tuesday, 20 September 2011
Excercise 147 - Removing articles from a text file
Exercise 147: Design a program that removes all articles from a text file.
The program consumes the name n of a file, reads the file, removes the articles, and writes
the result out to a file whose name is the result of concatenating "no-articles-" with n.
For this exercise, an article is one of the following three words: "a", "an", and "the".
Use read-words/line so that the transformation retains the organization of the
original text into lines and words. When the program is designed, run it on the
Piet Hein poem.
; these requires let us print out debugging info
; and read/write the files to disk
(require racket/base)
(require 2htdp/batch-io)
; the list of articles we are going to strip
(define ARTICLES (list "a" "the" "an"))
; String -> Boolean
; Returns true of false if a word is permitted (eg it is not in
; our list of ARTICLES)
; articles is a List-of-Strings
; word is a String
(define (permitted? articles word)
(cond ((empty? articles) #true)
((string=? (first articles) word) #false)
((cons? articles) (permitted? (rest articles) word))))
; test our permitted? function is working as expected
(check-expect (permitted? ARTICLES "bob") #true)
(check-expect (permitted? ARTICLES "the") #false)
; List-of-Strings -> List-of-Strings
;
; Returns a list of strings with the ARTICLES filtered out
; We need to call this function my_filter (or something other
; than filter) as filter is defined by racket/base
;
; A List-of-Strings is one of:
; – empty
; – (cons String List-of-Strings)
(define (my_filter los)
(cond ((empty? los) empty)
((cons? los)
(fprintf (current-output-port) "filter: ~a permit: ~a\n"
(first los)
(permitted? ARTICLES (first los)))
(cond ((permitted?
ARTICLES (first los))
(cons (first los)
(my_filter (rest los))))
(else (my_filter (rest los)))))))
I thought there was a string->word-list type function that I could use here, but apparently not. I probably should have written a quick one, but this will do for now
; Test we are correctly stripping out the non-permitted words
; from our list
(check-expect (my_filter (list "a" "quick" "brown" "fox"
"is" "an" "elephant") )
(list "quick" "brown" "fox" "is" "elephant"))
; processes a list of List-of-Strings, filtering each list in turn
; returns a List-of-Lists-of-Strings
(define (process llos)
(cond ((empty? llos) empty)
((cons? llos) (cons (my_filter (first llos))
(process (rest llos))))))
; test our process function is removing the items from our list as
; we'd expect
(check-expect (process (list (list "a" "cat")
(list "a" "quick" "brown")
(list "fox" "is" "an" "elephant")))
(list (list "cat")
(list "quick" "brown")
(list "fox" "is" "elephant")))
And now we're pretty much finished - we can actually run the program that they asked for. We still have to convert the List of Lists of Strings that process-file is returning to a String that write-file can use, but luckily we just wrote a couple of functions that did exactly that....
; wrap this round a read/write block and add in our new file name
(define (process-file filename)
(write-file (string-append "no-articles-" filename)
(collapse-lines (process (read-words/line
filename)))))
; These last two functions are taken from my answer to
; exercise 146
; List-of-List-of-Strings -> String
; collapses a list of lists of strings into a single string.
(define (collapse-lines llos)
(cond ((empty? llos) "")
((cons? llos) (string-append
(collapse-los (first llos)) "\n"
(collapse-lines (rest llos))))))
; List-of-Strings -> String
; collapses a 1 dimensional list of tokens into a string
; (eg NOT a list of lists of strings, just a list of strings
Finally - lets run it and see what we get:
> (process-file "ttt.txt")
"no-articles-ttt.txt"
The program consumes the name n of a file, reads the file, removes the articles, and writes
the result out to a file whose name is the result of concatenating "no-articles-" with n.
For this exercise, an article is one of the following three words: "a", "an", and "the".
Use read-words/line so that the transformation retains the organization of the
original text into lines and words. When the program is designed, run it on the
Piet Hein poem.
; these requires let us print out debugging info
; and read/write the files to disk
(require racket/base)
(require 2htdp/batch-io)
; the list of articles we are going to strip
(define ARTICLES (list "a" "the" "an"))
; String -> Boolean
; Returns true of false if a word is permitted (eg it is not in
; our list of ARTICLES)
; articles is a List-of-Strings
; word is a String
(define (permitted? articles word)
(cond ((empty? articles) #true)
((string=? (first articles) word) #false)
((cons? articles) (permitted? (rest articles) word))))
; test our permitted? function is working as expected
(check-expect (permitted? ARTICLES "bob") #true)
(check-expect (permitted? ARTICLES "the") #false)
Racket includes a filter method, which does basically 90% of this exercise, but we don't want to use it as then we're not learning anything! So . . . lets roll our own.
; List-of-Strings -> List-of-Strings
;
; Returns a list of strings with the ARTICLES filtered out
; We need to call this function my_filter (or something other
; than filter) as filter is defined by racket/base
;
; A List-of-Strings is one of:
; – empty
; – (cons String List-of-Strings)
(define (my_filter los)
(cond ((empty? los) empty)
((cons? los)
(fprintf (current-output-port) "filter: ~a permit: ~a\n"
(first los)
(permitted? ARTICLES (first los)))
(cond ((permitted?
ARTICLES (first los))
(cons (first los)
(my_filter (rest los))))
(else (my_filter (rest los)))))))
I thought there was a string->word-list type function that I could use here, but apparently not. I probably should have written a quick one, but this will do for now
; Test we are correctly stripping out the non-permitted words
; from our list
(check-expect (my_filter (list "a" "quick" "brown" "fox"
"is" "an" "elephant") )
(list "quick" "brown" "fox" "is" "elephant"))
; processes a list of List-of-Strings, filtering each list in turn
; returns a List-of-Lists-of-Strings
(define (process llos)
(cond ((empty? llos) empty)
((cons? llos) (cons (my_filter (first llos))
(process (rest llos))))))
; test our process function is removing the items from our list as
; we'd expect
(check-expect (process (list (list "a" "cat")
(list "a" "quick" "brown")
(list "fox" "is" "an" "elephant")))
(list (list "cat")
(list "quick" "brown")
(list "fox" "is" "elephant")))
And now we're pretty much finished - we can actually run the program that they asked for. We still have to convert the List of Lists of Strings that process-file is returning to a String that write-file can use, but luckily we just wrote a couple of functions that did exactly that....
; wrap this round a read/write block and add in our new file name
(define (process-file filename)
(write-file (string-append "no-articles-" filename)
(collapse-lines (process (read-words/line
filename)))))
; These last two functions are taken from my answer to
; exercise 146
; List-of-List-of-Strings -> String
; collapses a list of lists of strings into a single string.
(define (collapse-lines llos)
(cond ((empty? llos) "")
((cons? llos) (string-append
(collapse-los (first llos)) "\n"
(collapse-lines (rest llos))))))
; List-of-Strings -> String
; collapses a 1 dimensional list of tokens into a string
; (eg NOT a list of lists of strings, just a list of strings
(define (collapse-los los)
(cond ((empty? los) "")
((= 1 (length los)) (first los))
((cons? los) (string-append
(first los)
" "
(collapse-los (rest los))))))
> (process-file "ttt.txt")
"no-articles-ttt.txt"
dgs@dgs-netbook:~/code/htdp$ cat ttt.txt
TTT
Put up in a place
where it's easy to see
the cryptic admonishment
T.T.T.
When you feel how depressingly
slowly you climb,
it's well to remember that
Things Take Time.
Piet Hein
dgs@dgs-netbook:~/code/htdp$ cat no-articles-ttt.txt
TTT
Put up in place
where it's easy to see
cryptic admonishment
T.T.T.
When you feel how depressingly
slowly you climb,
it's well to remember that
Things Take Time.
Piet Hein
Success!
Subscribe to:
Posts (Atom)