suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

batch-io finished

Browse Source
This commit is contained in:
Matthias Felleisen 2010-04-15 20:34:26 -04:00
parent 2fb34bcfdc
commit 2727d5f0ba
8 changed files with 210 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
collects/2htdp/batch-io.ss
View File

@ -1,73 +1,90 @@
#lang scheme
(require (for-syntax syntax/parse)
htdp/error
"private/csv/csv.ss")
(require (for-syntax syntax/parse) srfi/13 htdp/error "private/csv/csv.ss")
;; todo
;; -- read files as "white space separated tokens"
;; -- tokenization? how? map-file? on a string?
;; todo?
;; -- export tokenization?
;; -----------------------------------------------------------------------------
(provide
;; all reader functions consume the name of a file f:
;; -- f must be a file name (string) in the same folder as the program
(provide
read-file ;; String -> String
;; read the file f (in current-directory) as a string
;; read the file f as a string
read-file-as-lines ;; String -> [Listof String]
;; read the file f (in current-directory) as a list of strings
;; read the file f as a list of strings, one per line
read-file-as-words ;; String -> [Listof String]
;; read the file f as a list of white-space separated tokens
read-file-as-1strings ;; String -> [Listof 1String]
;; read the file f (in current-directory) as a list of 1strings
write-file ;; String String -> Boolean
;; write str to file f (in current-directory);
;; false, if f exists
;; true, if f doesn't exist
)
;; read the file f as a list of 1strings (characters)
(provide
read-file-as-csv turn-row-into
;; (read-file-as-csv f:expr)
;; f must evaluate to the name of a file name (string) in the program's folder
;; read the file f as a file of comma-separated values; i.e.,
;; a list of rows, where each row is a list of strings, numbers, etc.
read-file-as-csv ;; String -> [Listof [Listof (U Any)]]
;; -- f must be formated as a a file with comma-separated values (Any)
;; read the file f as a list of lists---one per line---of values (Any)
;; (read-file-as-csv f:expr (turn-row-into row:expr))
;; row must evaluate to a function of one argument; the function is applied
;; to each row, meaning the result is now a list of results produces by row
read-file-as-csv/rows ;; String ([Listof Any] -> X) -> [Listof X]
;; -- f must be formated as a a file with comma-separated values (Any)
;; read the file f as a file of comma-separated values, apply the second
;; argument to each row, i.e., list of CSV on one line
write-file ;; String String -> Boolean
;; write the second argument to file f in the same folder as the program
;; produce false, if f exists
;; produce true, if f doesn't exist
)
;; -----------------------------------------------------------------------------
(define (read-file f)
(check-file f 'read-file)
(define-syntax-rule
(def-reader (name f s ...) body ...)
(define (name f s ...)
(check-file f 'name)
(let ()
body ...)))
;; --- exported functions --
(def-reader (read-file f)
(list->string (read-chunks f read-char drop-last-newline)))
(define (read-file-as-1strings f)
(check-file f 'read-file-as-1strings)
(def-reader (read-file-as-1strings f)
(map string (read-chunks f read-char drop-last-newline)))
(define (read-file-as-lines f)
(check-file f 'read-file-as-lines)
(def-reader (read-file-as-lines f)
(read-chunks f read-line reverse))
(define-syntax (turn-row-into stx)
(raise-syntax-error 'turn-row-into "used out of context" stx))
(def-reader (read-file-as-words f)
(define lines (read-chunks f read-line reverse))
(foldr (lambda (f r) (append (split f) r)) '() lines))
(define-syntax (read-file-as-csv stx)
(syntax-parse stx #:literals (turn-row-into)
[(_ f:expr) #'(read-file-as-csv/func f (lambda (x) x))]
[(_ f:expr (turn-row-into s:expr))
#'(let ([row s]
[error->syntax-error
(lambda (x)
(raise-syntax-error 'turn-row-into (exn-message x) #'s))])
(check-file f 'read-file-as-csv)
(with-handlers ((exn? error->syntax-error))
(check-proc 'read-file-as-cvs row 1 "one argument" "turn-row-into"))
(read-file-as-csv/func f s))]))
(def-reader (read-file-as-csv f)
(read-file-as-csv/func f))
(def-reader (read-file-as-csv/rows f row)
(check-proc 'read-file-as-cvs row 1 "one argument" "row")
(read-file-as-csv/func f row))
;; -----------------------------------------------------------------------------
;; writer
(define (write-file f str)
(check-arg 'write-file (string? f) "string (name of file)" "first" f)
(check-arg 'write-file (string? str) "string" "second" str)
(let ([result (not (file-exists? f))])
(with-output-to-file f
(lambda () (printf "~a" str))
#:exists 'truncate)
result))
;; -----------------------------------------------------------------------------
;; auxiliaries
;; String [([Listof X] -> Y)] -> [Listof Y]
(define (read-file-as-csv/func f row)
(define (read-file-as-csv/func f [row (lambda (x) x)])
(local ((define (reader o)
(make-csv-reader o '((strip-leading-whitespace? . #t)
(strip-trailing-whitespace? . #t)))))
@ -86,80 +103,19 @@
(define (drop-last-newline accu)
(reverse (if (char=? (car accu) #\newline) (cdr accu) accu)))
;; -----------------------------------------------------------------------------
(define (write-file f str)
(check-arg 'write-file (string? f) "name of file (string) in program's folder" "first" f)
(check-arg 'write-file (string? str) "string" "second" str)
(let ([result (not (file-exists? f))])
(with-output-to-file f
(lambda () (printf "~a" str))
#:exists 'truncate)
result))
;; -----------------------------------------------------------------------------
;; String[file name] Symbol -> Void
;; effect: ensure that f is a file in current directory or report error for t
(define (check-file f t)
(check-arg t (string? f) "string" "first" f)
(check-arg t (file-exists? f) "name of file in program's folder" "first" f))
;; -----------------------------------------------------------------------------
;; split : String [Regexp] -> [Listof String]
;; splits a string into a list of substrings using the given delimiter
;; (white space by default)
(define (split str [ptn #rx"[ ]+"])
(regexp-split ptn (string-trim-both str)))
;
;
;
; ;
; ;
; ;;;; ; ; ;; ; ;; ; ;;; ;;;; ;;;;; ;;; ;;; ; ;; ;;;;
; ; ; ; ; ;; ; ;; ; ; ; ; ; ; ; ;; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ;;; ; ; ; ; ; ; ;;;;; ;;; ; ; ; ; ; ; ;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ; ; ;; ; ;; ; ;; ; ; ; ; ; ; ; ; ;
; ;;;; ;; ; ;; ; ;; ; ;;;; ;;;; ;;; ; ;;; ; ; ;;;;
; ; ;
; ;;; ;;;
;
#|
For basic i/o, I find the following two functions extremely helpful to provide as a
teachpack along with what batch-io gives. Perhaps it would be possible to include
them in the standard teachpack?
;; split : String String -> Listof[String]
;; splits a string into a list of substrings using the given delimiter (space
;; by default)
(define (split str [ptn "[ ]+"])
(unless (string? str)
(error 'split "expects string as first argument"))
(unless (string? ptn)
(error 'split "expects string as second argument"))
(regexp-split ptn (string-trim-both str)))
;; split : String -> Listof[String]
;; splits a string into a list of lines
(define (split-lines str)
(map string-trim-both (split str "\r*\n")))
These are some other functions that I've also found helpful... the first two
because sometimes it's handy to be able to use the GUI dialog box to figure
out the complete pathname of a file; the third to be able to load images from
a program:
(define (pick-a-file)
(path->string (get-file)))
(define (pick-a-save-file)
(path->string (put-file)))
I realize that it might not be good to provide too much i/o stuff from the HtDP
perspective, because it could start to distract from the more important issues
that are to be taught/learned.
;; ---
|#
;; split-lines : String -> Listof[String]
;; splits a string with newlines into a list of lines
(define (split-lines str)
(map string-trim-both (split str "\r*\n")))

19
collects/2htdp/tests/batch-io.ss
View File

@ -19,20 +19,20 @@ eos
(second test2-as-list))))
(write-file file test1)
(check-true (string=? (read-file file) test1) " 1")
(check-true (string=? (read-file file) test1) "read-file 1")
(write-file file test2)
(check-true (string=? (read-file file) test2) " 2")
(check-true (string=? (read-file file) test2) "read-file 2")
(write-file file test1)
(check-equal? (read-file-as-lines file) (list test1) "-as-lines 1")
(check-equal? (read-file-as-lines file) (list test1) "as-lines 1")
(write-file file test2)
(check-equal? (read-file-as-lines file) test2-as-list "-as-lines 2")
(check-equal? (read-file-as-lines file) test2-as-list "as-lines 2")
(define as-1strings1 (map string (string->list test1)))
(write-file file test1)
(check-equal? (read-file-as-1strings file) as-1strings1 "-as-1strings 1")
(check-equal? (read-file-as-1strings file) as-1strings1 "as-1strings 1")
(define as-1strings2
(map string
@ -43,7 +43,7 @@ eos
test2-as-list))))))
(write-file file test2)
(check-equal? (read-file-as-1strings file) as-1strings2 "-as-lines 2")
(check-equal? (read-file-as-1strings file) as-1strings2 "as-lines 2")
(define test3 #<< eos
word1, word2
@ -52,7 +52,10 @@ eos
)
(write-file file test3)
(check-equal? (read-file-as-csv file) '(("word1" "word2") ("word3" "word4")))
(check-equal? (read-file-as-csv file) '(("word1" "word2") ("word3" "word4"))
"as-cvs 1")
(check-equal? (read-file-as-words file) '("word1," "word2" "word3," "word4")
"as-words 1")
(check-exn exn:fail:contract? (lambda () (write-file 0 1)))
(check-exn exn:fail:contract? (lambda () (write-file '("test") 1)))
@ -74,4 +77,4 @@ eos
(module a scheme
(require 2htdp/batch-io)
(read-file-as-csv "batch-io.ss" (turn-row-into cons)))
(require 'a))))))
(require 'a))))))

127
collects/teachpack/2htdp/scribblings/batch-io.scrbl
View File

@ -1,16 +1,34 @@
#lang scribble/doc
@(require (for-label scheme teachpack/2htdp/batch-io))
@(require scribble/manual "shared.ss")
@(require scribble/struct)
@(require scheme/sandbox scribble/manual scribble/eval scribble/core)
@(require "shared.ss")
@(require 2htdp/batch-io)
@(define (file-is f)
(define x (read-file f))
(centered
(tabular #:style "searchbox"
(list (list (verbatim x))))))
@(define-syntax examples-batch-io
(syntax-rules ()
[(_ d ...)
(let ()
(define me (make-base-eval))
(begin
(interaction-eval #:eval me (require 2htdp/batch-io))
(interaction-eval #:eval me d)
...)
(interaction-eval #:eval me (require lang/htdp-intermediate-lambda))
me)]))
@; -----------------------------------------------------------------------------
@(define-syntax-rule (reading name ctc s)
@defproc[(@name [f (and/c string? file-exists?)]) @ctc ]{
reads the content of file @scheme[f] and produces it as @s .
The file @scheme[f] must exist and must be located in the same folder
(directory) as the program; otherwise the function signals an error.} )
reads the content of file @scheme[f] and produces it as @s .} )
@teachpack["batch-io"]{Batch Input/Output}
@ -21,37 +39,92 @@
The batch-io teachpack introduces several functions and a form for reading
content from files and one function for writing to a file.
@reading[read-file-as-string string?]{a string, including newlines}
All functions that read a file consume the name of a file and possibly
additional arguments. They assume that the specified file exists in the
same folder as the program; if not they signal an error:
@itemlist[
@reading[read-file-as-lines (listof string?)]{a list of strings, one per line}
@item{@reading[read-file string?]{a string, including newlines}
@reading[read-file-as-1strings (listof 1string?)]{a list of one-char strings, one per character}
@examples[#:eval (examples-batch-io)
(read-file "data.txt")
]
assuming the file named @scheme["data.txt"] has this shape:
@(file-is "data.txt")
Note how the leading space in the second line translates into the space
between the newline indicator and the word @scheme["good"] in the result.}
@defform/subs[#:id read-file-as-csv
#:literals
(turn-row-into)
(read-file-as-csv f-expr clause)
([clause
(turn-row-into row-expr)
])]{
reads the content of file @scheme[f] and produces it as a list of rows.
The file @scheme[f] must be a file of comma-separated values (csv).
It must exist and must be located in the same folder
(directory) as the program; otherwise the function signals an error.
@item{@reading[read-file-as-lines (listof string?)]{a list of strings, one per line}
@examples[#:eval (examples-batch-io)
(read-file-as-lines "data.txt")
]
when @scheme["data.txt"] is the name of the same file as in the preceding
item. And again, the leading space of the second line shows up in the
second string in the list.}
The form comes with one optional clause: @scheme[turn-into-row], which is
described next.}
@item{@reading[read-file-as-words (listof string?)]{a list of strings, one per white-space separated token in the file}
@defform[(turn-row-into row-expr)
#:contracts
([row-expr (-> (listof (or/c string? number?)) any)])]{
requests that each row is processed by the result of @scheme[row-expr]
before it is added to the result of @scheme[read-file-as-csv].}
@examples[#:eval (examples-batch-io)
(read-file-as-words "data.txt")
]
This time, however, the extra leading space of the second line of
@scheme["data.txt"] has disappeared in the result. The space is considered
a part of the separator that surrounds the word @scheme["good"].
}
@item{@reading[read-file-as-1strings (listof 1string?)]{a list of one-char strings, one per character}
@defproc[(write-file [f string?] [cntnt string?]) boolean?]{
@examples[#:eval (examples-batch-io)
(read-file-as-1strings "data.txt")
]
Note how this function reproduces all parts of the file faithfully,
including spaces and newlines.}
@item{@reading[read-file-as-csv (listof (listof any/c))]{a list of lists of comma-separated values}
@examples[#:eval (examples-batch-io)
(read-file-as-csv "data.csv")
]
where the file named @scheme["data.csv"] has this shape:
@(file-is "data.csv")
It is important to understand that the rows don't have to have the same
length. Here the third line of the file turns into a row of three
elements.
}
@item{@defproc[(@read-file-as-csv/rows [f (and/c string? file-exists?)][s
(-> (listof any/c) X?)]) (listof X?)]{reads the content of file @scheme[f] and
produces it as list of rows, each constructed via @scheme[s]}
@examples[#:eval (examples-batch-io)
(read-file-as-csv/rows "data.csv" (lambda (x) x))
(read-file-as-csv/rows "data.csv" length)
]
The first example shows how @scheme[read-file-as-csv] is just a short form
for @scheme[read-file-as-csv/rows]; the second one simply counts the
number of separated tokens and the result is just a list of numbers.
In many cases, the function argument is used to construct a structure from
a row.}
]
There is only one writer function at the moment:
@itemlist[
@item{@defproc[(write-file [f string?] [cntnt string?]) boolean?]{
turns @scheme[cntnt] into the content of file @scheme[f], located in the
same folder (directory) as the program. If the file exists when the
function is called, the function produces @scheme[true]; otherwise it
produces @scheme[false].}
@examples[#:eval (examples-batch-io)
(if (write-file "output.txt" "good bye")
(write-file "output.txt" "cruel world")
(write-file "output.txt" "cruel world"))
]
After evaluating this examples, the file named @scheme["output.txt"]
looks like this:
@(file-is "output.txt")
Explain why.
}
]

3
collects/teachpack/2htdp/scribblings/data.csv Normal file
View File

@ -0,0 +1,3 @@
hello, world
good, bye
i, am, done
1 hello, world
2 good, bye
3 i, am, done

3
collects/teachpack/2htdp/scribblings/data.txt Normal file
View File

@ -0,0 +1,3 @@
hello world
good bye
i am done

25
collects/teachpack/2htdp/scribblings/universe.scrbl
View File

@ -154,7 +154,7 @@ The design of a world program demands that you come up with a data
@defform/subs[#:id big-bang
#:literals
(on-tick on-draw on-key on-release on-mouse on-receive stop-when
(on-tick to-draw on-draw on-key on-release on-mouse on-receive stop-when
check-with register record? state name)
(big-bang state-expr clause ...)
([clause
@ -163,8 +163,8 @@ The design of a world program demands that you come up with a data
(on-key key-expr)
(on-release release-expr)
(on-mouse key-expr)
(on-draw draw-expr)
(on-draw draw-expr width-expr height-expr)
(to-draw draw-expr)
(to-draw draw-expr width-expr height-expr)
(stop-when stop-expr) (stop-when stop-expr last-scene-expr)
(check-with world?-expr)
(record? boolean-expr)
@ -183,7 +183,7 @@ The design of a world program demands that you come up with a data
itself as a scene; when the program must shut down; where to register the
world with a universe; and whether to record the stream of events. A world
specification may not contain more than one @scheme[on-tick],
@scheme[on-draw], or @scheme[register] clause. A @scheme[big-bang]
@scheme[to-draw], or @scheme[register] clause. A @scheme[big-bang]
expression returns the last world when the stop condition is satisfied
(see below) or when the programmer clicks on the @tt{Stop} button or
closes the canvas.
@ -389,7 +389,7 @@ All @tech{MouseEvent}s are represented via strings:
@item{
@defform[(on-draw render-expr)
@defform[(to-draw render-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)])]{
@ -398,8 +398,8 @@ All @tech{MouseEvent}s are represented via strings:
dealt with an event. Its size is determined by the size of the first
generated @tech{scene}.}
@defform/none[#:literals (on-draw)
(on-draw render-expr width-expr height-expr)
@defform/none[#:literals (to-draw)
(to-draw render-expr width-expr height-expr)
#:contracts
([render-expr (-> (unsyntax @tech{WorldState}) scene?)]
[width-expr natural-number/c]
@ -407,7 +407,12 @@ All @tech{MouseEvent}s are represented via strings:
tell DrScheme to use a @scheme[width-expr] by @scheme[height-expr]
canvas instead of one determine by the first generated @tech{scene}.
}}
}
For compatibility reasons, the teachpack also supports the keyword
@tt{on-draw} in lieu of @scheme[to-draw] but the latter is preferred
now.
}
@item{
@ -497,7 +502,7 @@ a short-hand for three lines of code:
;; (run-simulation create-UFO-scene) is short for:
(big-bang 0
(on-tick add1)
(on-draw create-UFO-scene))
(to-draw create-UFO-scene))
])
Exercise: Add a condition for stopping the flight of the UFO when it
@ -1637,7 +1642,7 @@ Finally, here is the third function, which renders the state as a scene:
(define (create-world n)
(big-bang WORLD0
(on-receive receive)
(on-draw (draw n))
(to-draw (draw n))
(on-tick move)
(name n)
(register LOCALHOST)))

3
collects/teachpack/data.csv Normal file
View File

@ -0,0 +1,3 @@
hello, world
good, bye
i, am, done
1 hello, world
2 good, bye
3 i, am, done

3
collects/teachpack/data.txt Normal file
View File

@ -0,0 +1,3 @@
hello world
good bye
i am done