133 lines
4.0 KiB
Racket
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)
|