/spelled-out-time.rkt
http://github.com/elibarzilay/rudybot · Shell · 101 lines · 93 code · 5 blank · 3 comment · 0 complexity · 34584f3159a79e5ba5edb41da4723219 MD5 · raw file
- #! /bin/sh
- #| Hey Emacs, this is -*-scheme-*- code!
- exec racket -l errortrace --require $0 --main -- ${1+"$@"}
- |#
- #lang racket
- (require (planet neil/numspell/numspell)
- (planet schematics/schemeunit:3)
- (planet schematics/schemeunit:3/text-ui))
- (define (seconds->english secs)
- (let loop ([units secs]
- [divisors '((second . 60)
- (minute . 60)
- (hour . 24)
- (day . 7)
- (week . 52)
- (year . 100))]
- [accum '()])
- (cond
- [(zero? units)
- (if (null? accum)
- '((second . 0))
- accum)]
- [(null? divisors)
- (cons `(century . ,units) accum)]
- [else
- (let ([d (car divisors)])
- (let-values ([(q r) (quotient/remainder units (cdr d))])
- (loop
- q
- (cdr divisors)
- (cons (cons (car d) r) accum))))])))
- (define (number->english/plural n unit-name)
- (define (y->ie n unit-name)
- (cond
- [(equal? 1 n)
- unit-name]
- [(equal? unit-name "century")
- "centurie"]
- [else unit-name]))
- (string-append (number->english n)
- " "
- (y->ie n unit-name)
- (if (equal? 1 n)
- ""
- "s")))
- (define (safe-take lst pos)
- (let ([pos (min pos (length lst))])
- (take lst pos)))
- (define (spelled-out-time secs)
- (let* ([result (safe-take (seconds->english secs) 1)]
- [final (list (car result))]
- [final (if (and (< 1 (length result))
- (zero? (cdr (second result))))
- final
- (append final (cdr result)))])
- (string-join
- (map (lambda (p)
- (number->english/plural
- (cdr p)
- (symbol->string (car p))))
- final)
- ", ")))
- (define-binary-check (check-spelled-out-time input-seconds expected-string)
- (equal? (spelled-out-time input-seconds)
- expected-string))
- (define spelled-out-time-tests
- (test-suite
- "spelled-out-time"
- (check-spelled-out-time 0 "zero seconds")
- (check-spelled-out-time 1 "one second")
- (check-spelled-out-time 2 "two seconds")
- (check-spelled-out-time 25 "twenty-five seconds")
- (check-spelled-out-time 123 "two minutes")
- (check-spelled-out-time 3611 "one hour")
- (check-spelled-out-time 75532 "twenty hours")
- (check-spelled-out-time 7229 "two hours")
- (check-spelled-out-time (+ 17 (* 24 3600)) "one day")
- (check-spelled-out-time (* 2 24 3600) "two days")
- (check-spelled-out-time (* 1 60 60 24 7 52 100) "one century")
- (check-spelled-out-time (* 1 60 60 24 7 52 100 10)"ten centuries")))
- (define (main . args)
- (exit (run-tests spelled-out-time-tests 'verbose)))
- (provide/contract
- [seconds->english (-> natural-number/c (listof (cons/c symbol? natural-number/c)))]
- [spelled-out-time (-> natural-number/c string?)])
- (provide main)