Add Racket version of T9 solutions

racket/README.md

@@ -0,0 +1,75 @@
+# T9 Racket Solution
+
+## Racket
+
+**TBD**
+
+[`Racket`](https://racket-lang.org/) is a descendant of
+[`Scheme`](https://en.wikipedia.org/wiki/Scheme_(programming_language)), a dialect of
+[`Lisp`](https://en.wikipedia.org/wiki/Lisp_(programming_language)).
+`Racket` is intended as a language for building other languages,
+and is packaged as a multi-platform distribution including
+an editor `DrRacket` and various derived languages.
+
+The solutions in this section are purposely generated (mostly) using recursive functions
+instead of using the more conventional functions such as the `for` loop that are availble.
+`Racket` supports [tail recursion](https://en.wikipedia.org/wiki/Tail_call) which optimizes
+these calls to avoid creating new stack frames.
+
+## Installation
+
+Acquire the code for this project in some normal fashion left as an exercise
+for the reader.
+There is no installation step past cloning the directory to your host.
+
+## Usage
+
+Change to the `T9/racket` directory in your favorite command shell.
+
+There are three programs corresponding to the three known algorithms:
+
+* `numeric.rkt`
+* `odometer.rkt`
+* `recursive.rkt`
+
+Each program requires common code in `infra.rkt`.
+When using a REPL this file must be loaded first.
+
+Each program filters from `STDIN` to `STDOUT`.
+Each line of input is a string made up of digits.
+Output will be multiple lines of results for each line of input.
+
+Type in digit strings and see what happens:
+
+    $ racket -i -t infra.rkt -t recursive.rkt -e '(main recursive)'
+    Welcome to Racket v8.9 [cs].
+    ### Starting numeric
+    5678
+    5678                         108 results
+      JMPT JMPU JMPV JMQT JMQU JMQV JMRT JMRU JMRV JMST JMSU JMSV JNPT JNPU JNPV JNQT
+      JNQU JNQV JNRT JNRU JNRV JNST JNSU JNSV JOPT JOPU JOPV JOQT JOQU JOQV JORT JORU
+      JORV JOST JOSU JOSV KMPT KMPU KMPV KMQT KMQU KMQV KMRT KMRU KMRV KMST KMSU KMSV
+      KNPT KNPU KNPV KNQT KNQU KNQV KNRT KNRU KNRV KNST KNSU KNSV KOPT KOPU KOPV KOQT
+      KOQU KOQV KORT KORU KORV KOST KOSU KOSV LMPT LMPU LMPV LMQT LMQU LMQV LMRT LMRU
+      LMRV LMST LMSU LMSV LNPT LNPU LNPV LNQT LNQU LNQV LNRT LNRU LNRV LNST LNSU LNSV
+      LOPT LOPU LOPV LOQT LOQU LOQV LORT LORU LORV LOST LOSU LOSV
+    ### Finished numeric
+
+
+Use `<ctrl>-D` to end the input stream and again to exit the Racket REPL.
+
+## Testing
+
+The `test.sh` shell script in this directory executes a simple test against prepared data
+using all three scripts:
+
+    $ test.sh
+    ### Starting recursive
+    ### Finished recursive
+    Files /home/marc/work/T9/racket/../test/results and - are identical
+    ### Starting odometer
+    ### Finished odometer
+    Files /home/marc/work/T9/racket/../test/results and - are identical
+    ### Starting numeric
+    ### Finished numeric
+    Files /home/marc/work/T9/racket/../test/results and - are identical

racket/infra.rkt

@@ -0,0 +1,98 @@
+#lang racket/base
+
+(require
+  racket/contract
+  racket/format
+  racket/function
+  racket/list
+  racket/string)
+
+(provide main digits? t9)
+
+(module+ test
+  (require rackunit))
+
+(define
+  t9
+  '(("0" "0")
+    ("1" "1")
+    ("2" "A" "B" "C")
+    ("3" "D" "E" "F")
+    ("4" "G" "H" "I")
+    ("5" "J" "K" "L")
+    ("6" "M" "N" "O")
+    ("7" "P" "Q" "R" "S")
+    ("8" "T" "U" "V")
+    ("9" "W" "X" "Y" "Z")))
+
+(define/contract (digits? str)
+  (any/c . -> . boolean?)
+  (and
+   (string? str)
+   ; Can be empty string in some cases, but if not empty must be all digits.
+   (regexp-match? #px"^\\d*$" str)))
+
+(module+ test
+  (check-exn exn:fail? (thunk (digits?)))
+  (check-true (digits? "123"))
+  (check-false (digits? "abc"))
+  (check-false (digits? 123)))
+
+;; TODO: more unit tests to do below
+
+; Format as many results as will fit in one line.
+; Return the remaining results.
+(define/contract (format-result-line-core results column)
+  ((listof string?) integer? . -> . (listof string?))
+  (if (empty? results)
+      results
+      (let* ([current (car results)]
+             [new-column (+ column (string-length current) 1)])
+        (if (> new-column 80)
+            results
+            (begin
+              (printf " ~a" current)
+              (format-result-line-core (cdr results) new-column))))))
+
+; Format a single line of results.
+; Return the remaining results.
+(define/contract (format-result-line results)
+  ((listof string?) . -> . (listof string?))
+  (display " ")
+  (let ([results (format-result-line-core results 0)])
+    (newline)
+    results))
+
+; Format result lines.
+(define/contract (format-result-lines results)
+  ((listof string?) . -> . void?)
+  (unless (empty? results)
+    (let ([remaining (format-result-line results)])
+      (unless (empty? remaining)
+        (format-result-lines remaining)))))
+
+; Format results for comparison with known solution.
+(define/contract (format-results digits results)
+  (string? (listof string?) . -> . void?)
+  (let ((count (length results)))
+    (printf "~a~a result~a~%"
+            (~a digits #:width 25)
+            (~a count #:width 7 #:align 'right)
+            (if (= count 1) "" "s"))
+    (format-result-lines results)))
+
+; Process a number using the specified function and format results.
+(define/contract (process fn line)
+  (procedure? string? . -> . void?)
+  (let ([digits (string-trim line)])
+    (unless (string=? digits "")
+      (format-results digits (fn digits)))))
+
+; Read lines from specified stream and process each line.
+(define/contract (main fn [stream (current-input-port)])
+  ((procedure?) (input-port?) . ->* . void?)
+  (let ((fn-name (object-name fn)))
+    (fprintf (current-error-port) "### Starting ~a~%" fn-name)
+    (for ([line (in-lines stream)])
+      (process fn line))
+    (fprintf (current-error-port) "### Finished ~a~%" fn-name)))

racket/namespace.rkt

@@ -0,0 +1,11 @@
+#lang racket/base
+
+; Use this to configure a namespace for interactive racket invocations
+; without using -i flag which leaves racket in REPL afterwards.
+;
+; Examples:
+;   racket -i -t infra.rkt -t recursive.rkt -e '(main recursive)'
+;   racket -i -t infra.rkt -t odometer.rkt -e '(main odometer)'
+;   racket -i -t infra.rkt -t numeric.rkt -e '(main numeric)'
+(current-namespace (make-base-namespace))
+

racket/numeric.rkt

@@ -0,0 +1,48 @@
+#lang racket/base
+
+(require
+  racket/contract
+  racket/dict
+  racket/function
+  racket/list
+  racket/string
+  "infra.rkt")
+
+(provide numeric)
+
+(module+ test
+  (require rackunit))
+
+(define/contract (numeric-solution number columns [results '()])
+  ((exact-nonnegative-integer? (listof (listof string?))) (string?) . ->* . (listof string?))
+  (if (empty? columns)
+      results
+      (let* ([col (car columns)]
+             [len (length col)]
+             [mod (modulo number len)]
+             [num (floor (/ number len))])
+        (numeric-solution num (cdr columns) (cons (list-ref col mod) results)))))
+
+(module+ test
+  (check-exn exn:fail? (thunk (numeric-solution)))
+  (check-exn exn:fail? (thunk (numeric-solution 17)))
+  (check-exn exn:fail? (thunk (numeric-solution 17 23)))
+  (check-exn exn:fail? (thunk (numeric-solution 17 '(("a")) 23)))
+  (let ([columns '(("C" "D") ("A" "B"))])
+    (check-equal? (numeric-solution 0 columns) '("A" "C"))
+    (check-equal? (numeric-solution 1 columns) '("A" "D"))
+    (check-equal? (numeric-solution 2 columns) '("B" "C"))
+    (check-equal? (numeric-solution 3 columns) '("B" "D"))))
+
+; Numeric solution to T9 problem.
+(define/contract (numeric digits)
+  (digits? . -> .  (listof string?))
+  (let* ([columns (reverse (map (lambda (digit) (dict-ref t9 digit))
+                                (string-split digits #rx"(?<=.)(?=.)")))]
+         [maximum (apply * (map (lambda (column) (length column)) columns))])
+    (for/list ([i (in-range maximum)])
+      (string-join (numeric-solution i columns) ""))))
+
+(module+ test
+  (check-exn exn:fail? (thunk (numeric)))
+  (check-exn exn:fail? (thunk (numeric 123))))

racket/odometer.rkt

@@ -0,0 +1,129 @@
+#lang racket/base
+
+(require
+  racket/class
+  racket/contract
+  racket/dict
+  racket/function
+  racket/list
+  racket/string
+  "infra.rkt")
+
+(module+ test
+  (require rackunit))
+
+(provide odometer)
+
+(define (single-char? str)
+  (and (string? str) (= (string-length str) 1)))
+
+(module+ test
+  (check-exn exn:fail? (thunk (single-char?)))
+  (check-false (single-char? 3))
+  (check-true (single-char? "a"))
+  (check-false (single-char? "ab")))
+
+; Define class for a single 'wheel' in a mechanical odometer.
+(define/contract wheel%
+  (class/c (init [char-list (listof single-char?)])
+           [click (->m boolean?)]
+           [current (->m string?)])
+  (class object%
+    (init char-list)
+
+    (super-new)
+
+    (define chars char-list)
+    (define index 0)
+
+    ; Click a wheel to its next character.
+    ; Returns #t if the wheel returns to its first character,
+    ; indicating carry-over to the next wheel.
+    (define/public (click)
+      (if (< index (sub1 (length chars)))
+          (begin (set! index (add1 index)) #f)
+          (begin (set! index 0) #t)))
+
+    ; Return the current character showing on the wheel.
+    (define/public (current)
+      (list-ref chars index))))
+
+(define/contract (wheel? obj)
+  (any/c . -> . boolean?)
+  (is-a? obj wheel%))
+
+(module+ test
+  (check-false (wheel? 1))
+  (check-exn exn:fail? (thunk (new wheel% [char-list '("ab")])))
+  (let ([wheel (new wheel% [char-list '("a" "b" "c")])])
+    (check-true (wheel? wheel))
+    (check-exn exn:fail? (thunk (send wheel click 1)))
+    (check-exn exn:fail? (thunk (send wheel current 1)))
+    (check-eq? (send wheel current) "a")
+    (check-false (send wheel click))
+    (check-eq? "b" (send wheel current))
+    (check-false (send wheel click))
+    (check-eq? "c" (send wheel current))
+    (check-true (send wheel click))
+    (check-eq? "a" (send wheel current))))
+
+; Define class for an 'odometer' made up of wheels.
+(define/contract meter%
+  (class/c (init [digits string?])
+           [current (->m string?)]
+           [click (->*m () ((listof wheel?)) boolean?)]
+           [collect (->*m () ((listof string?)) (listof string?))])
+  (class object%
+    (init digits)
+
+    (super-new)
+
+    (define wheels
+      (map (lambda (digit) (new wheel% [char-list (dict-ref t9 digit)]))
+           (string-split digits #rx"(?<=.)(?=.)")))
+
+    ; Return a string representing the current settings of odometer's wheels.
+    (define/public (current)
+      (string-join
+       (map (lambda (wheel) (send wheel current)) wheels)
+       ""))
+
+    ; Click odometer to its next setting.
+    ; Click wheels from end, continuing as long as
+    ; individual wheels signal carry-over by returning #t.
+    ; Returns true if the last (leftmost) wheel clicked returns #t,
+    ; indicating all wheels have carried over.
+    (define/public (click [wheel-list (reverse wheels)])
+      (cond
+        [(empty? wheel-list) #t]
+        [(not (send (car wheel-list) click)) #f]
+        [else (click (cdr wheel-list))]))
+
+    ; Collect the results by clicking through the odometer settings.
+    (define/public (collect [result-list '()])
+      (let ([results (cons (current) result-list)])
+        (if (click)
+            (reverse results)
+            (collect results))))
+    ))
+
+(module+ test
+  (check-exn exn:fail? (thunk (new meter% [digits "ab"])))
+  (check-exn exn:fail? (thunk (new meter% [digits 3])))
+  (let ([meter (new meter% [digits "12"])])
+    (check-equal? (send meter current) "1A")
+    (check-false (send meter click))
+    (check-equal? (send meter current) "1B")
+    (check-false (send meter click))
+    (check-equal? (send meter current) "1C")
+    (check-true (send meter click))))
+
+; Odometer solution to T9 problem.
+(define/contract (odometer digits)
+  (digits? . -> .  (listof string?))
+  (send (new meter% [digits digits]) collect))
+
+
+(module+ test
+  (check-exn exn:fail? (thunk (odometer)))
+  (check-exn exn:fail? (thunk (odometer 123))))