diff --git a/words/command.rkt b/words/command.rkt index b69c751..7420573 100755 --- a/words/command.rkt +++ b/words/command.rkt @@ -1,6 +1,7 @@ #lang debug racket (require racket/string - "main.rkt") + "main.rkt" + "kernscore.rkt") (module+ raco (define command-name (with-handlers ([exn:fail? (λ (exn) #f)]) @@ -19,6 +20,11 @@ (define count 20) (define hide-plurals #true) (define proper-names #false) + (define title-case #false) + (define uppercase #false) + (define sort-style #false) + (define omit #false) + (define reversed #false) (command-line #:program "words" #:argv (current-command-line-arguments) @@ -29,6 +35,10 @@ [("-m" "--mandatory") mandatory-arg "mandatory letters" (set! mandatory mandatory-arg)] + [("-o" "--omit") omit-arg + "forbidden letters" + (set! omit omit-arg)] + [("-c" "--combo") combo-arg "mandatory combo" (set! combo combo-arg)] @@ -42,18 +52,44 @@ "maximum word length" (set! max-size (string->number max-size-arg))] [("-s" "--show-plurals") - "show plural words" - (set! hide-plurals #false)] + "show plural words" + (set! hide-plurals #false)] [("-p" "--proper-names") - "show proper names" - (set! proper-names #true)]) - (displayln (string-join (make-words #:letters letters - #:mandatory mandatory - #:combo combo - #:count count - #:min min-size - #:max max-size - #:hide-plurals hide-plurals - #:proper-names proper-names) "\n"))) + "show proper names" + (set! proper-names #true)] + [("--sort") sort-arg + "sort order" + (set! sort-style sort-arg)] + [("-r" "--reverse") + "reverse order" + (set! reversed #true)] + #:once-any + [("-t" "--title-case") + "capitalize first letter" + (set! title-case #true)] + [("-u" "--uppercase") + "capitalize all letters" + (set! uppercase #true)]) + (define words (make-words #:letters letters + #:mandatory mandatory + #:omit omit + #:combo combo + #:count count + #:min min-size + #:max max-size + #:hide-plurals hide-plurals + #:proper-names proper-names + #:all-caps uppercase + #:initial-caps title-case)) + (define-values (sort-key sort-cmp) + (match sort-style + ["kernscore" (values kernscore <)] + ["alpha" (values values string<=?)] + [_ (values #false #false)])) + (define sorted-words (cond + [sort-key + (sort words sort-cmp #:key sort-key #:cache-keys? #true)] + [else words])) + (displayln (string-join ((if reversed reverse values) sorted-words) "\n"))) diff --git a/words/kernscore.rkt b/words/kernscore.rkt new file mode 100644 index 0000000..29b4482 --- /dev/null +++ b/words/kernscore.rkt @@ -0,0 +1,75 @@ +#lang debug racket +(require racket/dict) +(provide (all-defined-out)) + +(define letter-scores + '((A 4 4) + (B 1 3) + (C 2 3) + (D 1 2) + (E 1 3) + (F 1 3) + (G 2 3) + (H 1 1) + (I 1 1) + (J 3 1) + (K 1 3) + (L 1 4) + (M 1 1) + (N 1 1) + (O 2 2) + (P 1 3) + (Q 2 2) + (R 1 3) + (S 3 3) + (T 4 4) + (U 1 1) + (V 4 4) + (W 4 4) + (X 3 3) + (Y 4 4) + (Z 3 3) + (a 3 3) + (b 1 2) + (c 2 3) + (d 2 1) + (e 2 3) + (f 3 3) + (g 3 3) + (h 1 1) + (i 1.5 1.5) + (j 3 1) + (k 1 3) + (l 1.5 1.5) + (m 1 1) + (n 1 1) + (o 2 2) + (p 1 2) + (q 2 1) + (r 1 3) + (s 3 3) + (t 3 3) + (u 1 1) + (v 4 4) + (w 4 4) + (x 3 3) + (y 4 4) + (z 3 3))) + +(define left-score-table + (for/hasheqv ([(letter scores) (in-dict letter-scores)]) + (values (car (string->list (symbol->string letter))) (car scores)))) + +(define right-score-table + (for/hasheqv ([(letter scores) (in-dict letter-scores)]) + (values (car (string->list (symbol->string letter))) (cadr scores)))) + + +(define (kernscore word) + (define cs (string->list word)) + (/ (for/sum ([left-c (in-list cs)] + [right-c (in-list (cdr cs))]) + (* (hash-ref right-score-table left-c) + (hash-ref left-score-table right-c))) + (length cs))) +