sorting etc

master
Matthew Butterick 4 years ago
parent 18044c5cd4
commit 64a404fa30

@ -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")))

@ -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)))
Loading…
Cancel
Save