Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Moved series builder code back into the frame/ directory.

  • Loading branch information...
commit 19e514d2e4aeb3387a4a29e7a82bb77ad98f01bb 1 parent 97349ec
@RayRacine authored
View
142 rpr/format/csv/csv.rkt
@@ -0,0 +1,142 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Ray Racine's Typed Racket Library
+;; Copyright (C) 2007-2013 Raymond Paul Racine
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#lang typed/racket
+
+(require
+ (for-syntax
+ syntax/parse))
+
+(: double-quote? (Char -> Boolean))
+(define (double-quote? ch)
+ (char=? #\" ch))
+
+(: comma-delimiter? (Char -> Boolean))
+(define (comma-delimiter? ch)
+ (char=? #\, ch))
+
+(: eol-delimiter? (Char -> Boolean))
+(define (eol-delimiter? ch)
+ (or (char=? #\linefeed ch)
+ (char=? #\newline ch)))
+
+(: eol? (Char Input-Port -> Boolean))
+(define (eol? ch inp)
+ (let ((rs (eol-delimiter? ch)))
+ (let ((ch (peek-char inp)))
+ (and (char? ch)
+ (eol-delimiter? ch))
+ (read-char inp))
+ rs))
+
+(define-syntax (read-until stx)
+ (syntax-parse stx
+ ((_ in-port:id stop:id)
+ #'(let loop ()
+ (let ((ch (peek-char in-port)))
+ (if (eof-object? ch)
+ (void)
+ (if (stop ch)
+ (void)
+ (begin
+ (read-char in-port)
+ (loop)))))))))
+
+(: toss-whitespace (Input-Port -> Void))
+(define (toss-whitespace inp)
+ (read-until inp char-whitespace?))
+
+;; A string field has significant whitespace between ',' delimiters.
+;; It may be quoted.
+;; Internal quotes must be double quoted.
+;; e.g. " field with white-space with a ""quoted"" internal value "
+(: read-string-value (Input-Port -> String))
+(define (read-string-value inp)
+ (define outp (open-output-string))
+
+ (define quoted (let ((ch (peek-char inp)))
+ (and (char? ch)
+ (double-quote? ch))))
+
+ (let: loop : String ((ch : (U Char EOF) (read-char inp)) (in-dquote : Boolean #f))
+ (if (eof-object? ch)
+ (if (and quoted in-dquote)
+ (error "Invalid CSV EOF with un-opened quote: ~s" (get-output-string outp))
+ (get-output-string outp))
+ (cond
+ ((or (comma-delimiter? ch)
+ (eol? ch inp))
+ (if (and quoted in-dquote)
+ (error "Invalid CSV EOF with un-opened quote: ~s" (get-output-string outp))
+ (get-output-string outp)))
+ ((double-quote? ch)
+ (if quoted
+ (get-output-string outp)
+ (if in-dquote
+ (let ((ch (peek-char inp)))
+ (if (and (char? ch)
+ (double-quote? ch))
+ (begin
+ (write ch outp)
+ (read-char inp) ;; toss second " in ""
+ (loop (read-char inp) (not in-dquote)))
+ (error "Invalid CSV EOF with un-opened quote: ~s"
+ (get-output-string outp))))
+ (error "Invalid CSV EOF with un-opened quote: ~s" (get-output-string outp)))))
+ (else
+ (write ch outp)
+ (loop (read-char inp) in-dquote))))))
+
+(: read-number-string (Input-Port -> String))
+(define (read-number-string inp)
+ (define outp (open-output-string))
+ (let: loop : String ((ch : (U Char EOF) (read-char inp)))
+ (if (eof-object? ch)
+ (get-output-string outp)
+ (cond
+ ((or (char-numeric? ch)
+ (char=? #\. ch))
+ (write ch outp)
+ (loop (read-char inp)))
+ ((or (eol? ch inp)
+ (comma-delimiter? ch))
+ (get-output-string outp))
+ (else
+ (error "Expected integer field: ~s" (get-output-string outp)))))))
+
+(: s->i (String -> Integer))
+(define (s->i s)
+ (let ((n (string->number s)))
+ (if (exact-integer? n)
+ n
+ (error "Expected Integer field: ~s" s))))
+
+(: s->r (String -> Float))
+(define (s->r s)
+ (let ((n (string->number s)))
+ (if (real? n)
+ (real->double-flonum n)
+ (error "Expected Real number field: ~s" s))))
+
+(: read-integer-value (Input-Port -> Integer))
+(define (read-integer-value inp)
+ (s->i (read-number-string inp)))
+
+(: read-real-value (Input-Port -> Real))
+(define (read-real-value inp)
+ (s->r (read-number-string inp)))
View
66 rpr/format/layout-scratch.rkt
@@ -0,0 +1,66 @@
+#lang typed/racket
+
+(provide
+ orderheader
+ orderline)
+
+(require
+ ;;(for-syntax "layout-types.rkt")
+ (only-in "layout-types.rkt"
+ Field
+ Layout)
+ (only-in "tabbed/reader.rkt"
+ string-field)
+ (only-in "tabbed/layout.rkt"
+ define-tabbed-layout)
+ (only-in "tabbed/parser.rkt"
+ define-tabbed-parser-for-layout)
+ (only-in "fixed/layout.rkt"
+ define-fixed-layout)
+ (only-in "fixed/parser.rkt"
+ define-static-parser-for-layout))
+
+(define-tabbed-layout Sales-layout
+ (date C)
+ (dow C)
+ (call F)
+ (web F))
+
+(define-tabbed-parser-for-layout (Sales-parser Sales-layout)
+ (date web))
+
+(define-fixed-layout orderline
+ (order C 11)
+ (order-sub C 5)
+ (line C 7)
+ (account C 10)
+ (address-seq C 7)
+ (create-date D 10)
+ (order-type S 1)
+ (location C 4)
+ (dept C 2)
+ (class C 3)
+ (sku C 20)
+ (vendor C 2)
+ (entered-sku C 20)
+ (source C 2)
+ (list-price N 9)
+ (sku-price N 10)
+ (cost N 10)
+ (uom C 2)
+ (pack-qty I 7)
+ (order-qty I 7)
+ (ship-qty I 7)
+ (misc-charge S 1)
+ (sub-flag S 1)
+ (contract-pp C 9)
+ (contract-pp-seq C 5)
+ (commission N 9)
+ (contract-addendum C 1))
+
+(define-fixed-layout orderheader-layout
+ (order C 10)
+ (order-sub C 5))
+
+(define-static-parser-for-layout (oh-parser orderheader-layout)
+ (order order-sub))
View
0  rpr/load/categorical-series-builder.rkt → rpr/frame/categorical-series-builder.rkt
File renamed without changes
View
5 rpr/frame/categorical-series.rkt
@@ -16,6 +16,8 @@
SIndex Label
LabelIndex))
+(define-type CSeriesFn (Label -> Label))
+
;; Categorical Series
;; Encoded as an array of integer values with an associated nominal.
;; Custom Structure Writer
@@ -95,3 +97,6 @@
(: cseries-count (CSeries -> Index))
(define (cseries-count series)
(vector-length (CSeries-data series)))
+
+;;(: cseries-map (CSeries CSeriesFn -> CSeries))
+;;(define (cseries-map
View
8 rpr/frame/frame-join.rkt
@@ -31,17 +31,17 @@
(only-in "categorical-series.rkt"
cseries-referencer cseries-count cseries-ref
CSeries CSeries?)
- (only-in "../load/series-builder.rkt"
+ (only-in "series-builder.rkt"
SeriesBuilder)
- (only-in "../load/integer-series-builder.rkt"
+ (only-in "integer-series-builder.rkt"
ISeriesBuilder ISeriesBuilder?
append-ISeriesBuilder complete-ISeriesBuilder
new-ISeriesBuilder)
- (only-in "../load/categorical-series-builder.rkt"
+ (only-in "categorical-series-builder.rkt"
CSeriesBuilder CSeriesBuilder?
append-CSeriesBuilder complete-CSeriesBuilder
new-CSeriesBuilder)
- (only-in "../load/numeric-series-builder.rkt"
+ (only-in "numeric-series-builder.rkt"
NSeriesBuilder NSeriesBuilder?
append-NSeriesBuilder complete-NSeriesBuilder
new-NSeriesBuilder))
View
4 rpr/frame/frame.rkt
@@ -191,10 +191,10 @@
project)))
(: frame-append (Frame (U Column Columns Frame) -> Frame))
-(define (frame-append frame cols)
+(define (frame-append frame cols)
(cond
((Frame? cols)
- (new-frame (append (frame-explode frame) (frame-explode frame))))
+ (new-frame (append (frame-explode frame) (frame-explode cols))))
((list? cols)
(new-frame (append (frame-explode frame) cols)))
(else
View
0  rpr/load/integer-series-builder.rkt → rpr/frame/integer-series-builder.rkt
File renamed without changes
View
0  rpr/load/numeric-series-builder.rkt → rpr/frame/numeric-series-builder.rkt
File renamed without changes
View
0  rpr/load/series-builder.rkt → rpr/frame/series-builder.rkt
File renamed without changes
View
9 rpr/frame/series.rkt
@@ -6,15 +6,15 @@
(require
(only-in "series-description.rkt"
Series)
- (only-in "../load/series-builder.rkt"
+ (only-in "series-builder.rkt"
SeriesBuilder)
- (only-in "../load/categorical-series-builder.rkt"
+ (only-in "categorical-series-builder.rkt"
CSeriesBuilder CSeriesBuilder?
complete-CSeriesBuilder)
- (only-in "../load/numeric-series-builder.rkt"
+ (only-in "numeric-series-builder.rkt"
NSeriesBuilder NSeriesBuilder?
complete-NSeriesBuilder)
- (only-in "../load/integer-series-builder.rkt"
+ (only-in "integer-series-builder.rkt"
ISeriesBuilder ISeriesBuilder?
complete-ISeriesBuilder))
@@ -29,3 +29,4 @@
((ISeriesBuilder? builder)
(complete-ISeriesBuilder builder))))
+
View
12 rpr/load/frame-builder.rkt
@@ -5,7 +5,7 @@
append-data-fields)
(require
- (only-in "series-builder.rkt"
+ (only-in "../frame/series-builder.rkt"
SeriesBuilder))
(struct: FrameBuilder ([builders : (Listof SeriesBuilder)]) #:transparent)
@@ -17,8 +17,8 @@
(: append-data-fields ((Listof (String -> Void)) (Listof String) -> Boolean))
(define (append-data-fields appenders fields)
(if (or (null? appenders)
- (null? fields))
- (check-all-data-processed appenders fields)
- (begin
- ((car appenders) (car fields))
- (append-data-fields (cdr appenders) (cdr fields)))))
+ (null? fields))
+ (check-all-data-processed appenders fields)
+ (begin
+ ((car appenders) (car fields))
+ (append-data-fields (cdr appenders) (cdr fields)))))
View
17 rpr/load/load.rkt
@@ -9,30 +9,31 @@
generate-anon-series-names
Schema SeriesTypes Schema-has-headers
Schema-SeriesTypes Schema-headers)
- "frame-builder.rkt"
(only-in prelude/type/list
zip)
- (only-in "series-builder.rkt"
+ (only-in "../frame/series-builder.rkt"
SeriesBuilder)
- (only-in "numeric-series-builder.rkt"
+ (only-in "../frame/numeric-series-builder.rkt"
new-NSeriesBuilder
NSeriesBuilder
NSeriesBuilder?
complete-NSeriesBuilder)
- (only-in "categorical-series-builder.rkt"
+ (only-in "../frame/categorical-series-builder.rkt"
new-CSeriesBuilder
CSeriesBuilder
CSeriesBuilder?
complete-CSeriesBuilder
append-CSeriesBuilder)
- (only-in "tab-delimited.rkt"
- read-tab-delimited-file
- sample-tab-delimited-file)
(only-in "../frame/series-description.rkt"
Series)
(only-in "../frame/frame.rkt"
Frame
- new-frame))
+ new-frame)
+ "frame-builder.rkt"
+ (only-in "tab-delimited.rkt"
+ read-tab-delimited-file
+ sample-tab-delimited-file))
+
(: new-FrameBuilder-from-Schema (Schema -> FrameBuilder))
(define (new-FrameBuilder-from-Schema schema)
View
113 rpr/load/tab-delimited.rkt
@@ -4,87 +4,88 @@
sample-tab-delimited-file
read-tab-delimited-file)
-(require "../frame/frame.rkt"
- racket/match
- racket/pretty
- (only-in "../../io/iteratee/enumerators.rkt"
- enumerator/text-input-port)
- (only-in "../../io/iteratee/iteratee.rkt"
- Iteratee Stream Continue Done
- icomplete)
- (only-in "../../io/iteratee/iteratees.rkt"
- head-n)
- (only-in "parse.rkt"
- parse-tab-line)
- (only-in "schema.rkt"
- generate-anon-series-names
- determine-Schema
- Schema)
- (only-in "categorical-series-builder.rkt"
- CSeriesBuilder
- CSeriesBuilder?
- complete-CSeriesBuilder
- append-CSeriesBuilder)
- (only-in "numeric-series-builder.rkt"
- NSeriesBuilder
- NSeriesBuilder?
- append-NSeriesBuilder)
- (only-in "series-builder.rkt"
- SeriesBuilder)
- (only-in "frame-builder.rkt"
- append-data-fields
- FrameBuilder
- FrameBuilder-builders))
+(require
+ "../frame/frame.rkt"
+ racket/match
+ racket/pretty
+ (only-in "../../io/iteratee/enumerators.rkt"
+ enumerator/text-input-port)
+ (only-in "../../io/iteratee/iteratee.rkt"
+ Iteratee Stream Continue Done
+ icomplete)
+ (only-in "../../io/iteratee/iteratees.rkt"
+ head-n)
+ (only-in "../frame/categorical-series-builder.rkt"
+ CSeriesBuilder
+ CSeriesBuilder?
+ complete-CSeriesBuilder
+ append-CSeriesBuilder)
+ (only-in "../frame/numeric-series-builder.rkt"
+ NSeriesBuilder
+ NSeriesBuilder?
+ append-NSeriesBuilder)
+ (only-in "../frame/series-builder.rkt"
+ SeriesBuilder)
+ (only-in "frame-builder.rkt"
+ append-data-fields
+ FrameBuilder
+ FrameBuilder-builders)
+ (only-in "parse.rkt"
+ parse-tab-line)
+ (only-in "schema.rkt"
+ generate-anon-series-names
+ determine-Schema
+ Schema))
(: tab-record-iteratee (FrameBuilder -> (Iteratee String FrameBuilder)))
(define (tab-record-iteratee frame-builder)
(: appenders (Listof (String -> Void)))
(define appenders (map (λ: ((builder : SeriesBuilder))
- (cond
- [(CSeriesBuilder? builder)
- (λ: ((str : String))
- (append-CSeriesBuilder builder str))]
- [(NSeriesBuilder? builder)
- (λ: ((str : String))
- (append-NSeriesBuilder builder str))]
- [else (λ: ((str : String)) (void))]))
+ (cond
+ [(CSeriesBuilder? builder)
+ (λ: ((str : String))
+ (append-CSeriesBuilder builder str))]
+ [(NSeriesBuilder? builder)
+ (λ: ((str : String))
+ (append-NSeriesBuilder builder str))]
+ [else (λ: ((str : String)) (void))]))
(FrameBuilder-builders frame-builder)))
(: step ((Stream String) -> (Iteratee String FrameBuilder)))
(define (step input)
(match input
- ['Nothing (Continue step)]
- ['EOS (Done 'EOS frame-builder)] ;; (complete-FrameBuilder frame-builder))]
- [str (begin
- (when (string? str)
- (append-data-fields appenders (parse-tab-line str))
- (void))
- (Continue step))]))
+ ['Nothing (Continue step)]
+ ['EOS (Done 'EOS frame-builder)] ;; (complete-FrameBuilder frame-builder))]
+ [str (begin
+ (when (string? str)
+ (append-data-fields appenders (parse-tab-line str))
+ (void))
+ (Continue step))]))
(Continue step))
(: check-data-file-exists (Path -> Void))
(define (check-data-file-exists fpath)
(unless (file-exists? fpath)
- (error (format "File not found: ~s" (path->string fpath)))))
+ (error (format "File not found: ~s" (path->string fpath)))))
(: read-tab-delimited-file (Path Boolean FrameBuilder -> FrameBuilder))
(define (read-tab-delimited-file fpath headers builder)
(check-data-file-exists fpath)
(call-with-input-file*
- fpath
- (λ: ((inp : Input-Port))
- (when headers (read-line inp))
- (icomplete (((inst enumerator/text-input-port FrameBuilder) inp)
- (tab-record-iteratee builder))))))
+ fpath
+ (λ: ((inp : Input-Port))
+ (when headers (read-line inp))
+ (icomplete (((inst enumerator/text-input-port FrameBuilder) inp)
+ (tab-record-iteratee builder))))))
(: sample-tab-delimited-file (Path Integer -> Schema))
(define (sample-tab-delimited-file fpath cnt)
(check-data-file-exists fpath)
(call-with-input-file*
- fpath
- (λ: ((inp : Input-Port))
- (determine-Schema (icomplete (((inst enumerator/text-input-port (Listof String)) inp)
- ((inst head-n String) cnt)))))))
+ fpath
+ (λ: ((inp : Input-Port))
+ (determine-Schema (icomplete (((inst enumerator/text-input-port (Listof String)) inp)
+ ((inst head-n String) cnt)))))))
Please sign in to comment.
Something went wrong with that request. Please try again.