/spelled-out-time.rkt
Shell | 101 lines | 93 code | 5 blank | 3 comment | 0 complexity | 34584f3159a79e5ba5edb41da4723219 MD5 | raw file
1#! /bin/sh 2#| Hey Emacs, this is -*-scheme-*- code! 3exec racket -l errortrace --require $0 --main -- ${1+"$@"} 4|# 5 6#lang racket 7 8(require (planet neil/numspell/numspell) 9 (planet schematics/schemeunit:3) 10 (planet schematics/schemeunit:3/text-ui)) 11 12(define (seconds->english secs) 13 (let loop ([units secs] 14 [divisors '((second . 60) 15 (minute . 60) 16 (hour . 24) 17 (day . 7) 18 (week . 52) 19 (year . 100))] 20 [accum '()]) 21 22 (cond 23 [(zero? units) 24 (if (null? accum) 25 '((second . 0)) 26 accum)] 27 [(null? divisors) 28 (cons `(century . ,units) accum)] 29 [else 30 (let ([d (car divisors)]) 31 (let-values ([(q r) (quotient/remainder units (cdr d))]) 32 (loop 33 q 34 (cdr divisors) 35 (cons (cons (car d) r) accum))))]))) 36 37(define (number->english/plural n unit-name) 38 39 (define (y->ie n unit-name) 40 (cond 41 [(equal? 1 n) 42 unit-name] 43 [(equal? unit-name "century") 44 "centurie"] 45 [else unit-name])) 46 47 (string-append (number->english n) 48 " " 49 (y->ie n unit-name) 50 (if (equal? 1 n) 51 "" 52 "s"))) 53 54(define (safe-take lst pos) 55 (let ([pos (min pos (length lst))]) 56 (take lst pos))) 57 58(define (spelled-out-time secs) 59 (let* ([result (safe-take (seconds->english secs) 1)] 60 [final (list (car result))] 61 [final (if (and (< 1 (length result)) 62 (zero? (cdr (second result)))) 63 final 64 (append final (cdr result)))]) 65 (string-join 66 (map (lambda (p) 67 (number->english/plural 68 (cdr p) 69 (symbol->string (car p)))) 70 final) 71 ", "))) 72 73 74(define-binary-check (check-spelled-out-time input-seconds expected-string) 75 (equal? (spelled-out-time input-seconds) 76 expected-string)) 77 78(define spelled-out-time-tests 79 80 (test-suite 81 "spelled-out-time" 82 (check-spelled-out-time 0 "zero seconds") 83 (check-spelled-out-time 1 "one second") 84 (check-spelled-out-time 2 "two seconds") 85 (check-spelled-out-time 25 "twenty-five seconds") 86 (check-spelled-out-time 123 "two minutes") 87 (check-spelled-out-time 3611 "one hour") 88 (check-spelled-out-time 75532 "twenty hours") 89 (check-spelled-out-time 7229 "two hours") 90 (check-spelled-out-time (+ 17 (* 24 3600)) "one day") 91 (check-spelled-out-time (* 2 24 3600) "two days") 92 (check-spelled-out-time (* 1 60 60 24 7 52 100) "one century") 93 (check-spelled-out-time (* 1 60 60 24 7 52 100 10)"ten centuries"))) 94 95(define (main . args) 96 (exit (run-tests spelled-out-time-tests 'verbose))) 97 98(provide/contract 99 [seconds->english (-> natural-number/c (listof (cons/c symbol? natural-number/c)))] 100 [spelled-out-time (-> natural-number/c string?)]) 101(provide main)