syndicate-2017/racket/typed/examples/flink-support.rkt

133 lines
4.0 KiB
Racket

#lang racket
(provide string->words
split-at/lenient-
(struct-out job)
(struct-out task)
(struct-out map-work)
(struct-out reduce-work)
string->job
file->job)
(require (only-in racket/list
split-at))
(module+ test
(require rackunit))
(define (string->words s)
(map (lambda (w) (string-trim w #px"\\p{P}")) (string-split s)))
(module+ test
(check-equal? (string->words "good day sir")
(list "good" "day" "sir"))
(check-equal? (string->words "")
(list))
(check-equal? (string->words "good eve ma'am")
(list "good" "eve" "ma'am"))
(check-equal? (string->words "please sir. may I have another?")
(list "please" "sir" "may" "I" "have" "another"))
;; TODO - currently fails
#;(check-equal? (string->words "but wait---there's more")
(list "but" "wait" "there's" "more")))
;; (Listof A) Nat -> (List (Listof A) (Listof A))
;; like split-at but allow a number larger than the length of the list
(define (split-at/lenient- lst n)
(define-values (a b)
(split-at lst (min n (length lst))))
(list a b))
;; ---------------------------------------------------------------------------------------------------
;; Creating a Job
(struct job (id tasks) #:transparent)
(struct task (id desc) #:transparent)
(struct map-work (data) #:transparent)
(struct reduce-work (left right) #:transparent)
;; (Listof WorkDesc) -> (Values (Listof WorkDesc) (Optionof WorkDesc))
;; Pair up elements of the input list into a list of reduce tasks, and if the input list is odd also
;; return the odd-one out.
;; Conceptually, it does something like this:
;; '(a b c d) => '((a b) (c d))
;; '(a b c d e) => '((a b) (c d) e)
(define (pair-up ls)
(let loop ([ls ls]
[reductions '()])
(match ls
['()
(values reductions #f)]
[(list x)
(values reductions x)]
[(list-rest x y more)
(loop more (cons (reduce-work x y) reductions))])))
;; a TaskTree is one of
;; (map-work data)
;; (reduce-work TaskTree TaskTree)
;; (Listof String) -> TaskTree
;; Create a tree structure of tasks
(define (create-task-tree lines)
(define map-works
(for/list ([line (in-list lines)])
(map-work line)))
;; build the tree up from the leaves
(let loop ([nodes map-works])
(match nodes
['()
;; input was empty
(map-work "")]
[(list x)
x]
[_
(define-values (reductions left-over?)
(pair-up nodes))
(loop (if left-over?
(cons left-over? reductions)
reductions))])))
;; TaskTree ID -> (Listof Task)
;; flatten a task tree by assigning job-unique IDs
(define (task-tree->list tt job-id)
(define-values (tasks _)
;; TaskTree ID -> (Values (Listof Task) ID)
;; the input id is for the current node of the tree
;; returned id is the "next available" id, given ids are assigned in strict ascending order
(let loop ([tt tt]
[next-id 0])
(match tt
[(map-work _)
;; NOTE : utilizing knowledge of Tuple representation here
(values (list (task (list 'tuple next-id job-id) tt))
(add1 next-id))]
[(reduce-work left right)
(define left-id (add1 next-id))
(define-values (lefts right-id)
(loop left left-id))
(define-values (rights next)
(loop right right-id))
(values (cons (task (list 'tuple next-id job-id) (reduce-work left-id right-id))
(append lefts rights))
next)])))
tasks)
;; InputPort -> Job
(define (create-job in)
(define job-id (gensym 'job))
(define input-lines (sequence->list (in-lines in)))
(define tasks (task-tree->list (create-task-tree input-lines) job-id))
(job job-id tasks))
;; String -> Job
(define (string->job s)
(create-job (open-input-string s)))
;; PathString -> Job
(define (file->job path)
(define in (open-input-file path))
(define j (create-job in))
(close-input-port in)
j)