master
Matthew Butterick 5 years ago
parent 9b7edaf7d2
commit 3d8a6e28c2

@ -1,6 +1,5 @@
#lang debug racket/base #lang debug racket/base
(require racket/list (require racket/list
racket/file
"index.rkt") "index.rkt")
(define (make-words #:letters [letters "etaoinshrdluw"] (define (make-words #:letters [letters "etaoinshrdluw"]
@ -14,23 +13,21 @@
#:initial-caps [initial-caps? #f]) #:initial-caps [initial-caps? #f])
(define mandatory-cs (define mandatory-cs
(if mandatory (remove-duplicates (for/list ([c (in-string mandatory)]) (if mandatory (remove-duplicates (for/list ([c (in-string mandatory)])
(char-downcase c)) char=?) null)) (char-downcase c)) char=?) null))
(define letter-cs-charidx (define letter-cs-charidx
(word->charidx (word->charidx
(list->string (list->string
(remove-duplicates (remove-duplicates
(append (if letters (append (if letters
(for/list ([c (in-string letters)]) (for/list ([c (in-string letters)])
(char-downcase c)) (char-downcase c))
null) null)
mandatory-cs) mandatory-cs)
char=?)))) char=?))))
(define caser (cond
(define caer (cond [all-caps? string-upcase]
[all-caps? string-upcase] [initial-caps? string-titlecase]
[initial-caps? string-titlecase] [else values]))
[else values]))
(for*/fold ([word-acc null] (for*/fold ([word-acc null]
[count 0] [count 0]
#:result word-acc) #:result word-acc)
@ -44,10 +41,10 @@
;; word contains each mandatory char, case-insensitive ;; word contains each mandatory char, case-insensitive
(or (not mandatory) (or (not mandatory)
(for/and ([mc (in-list mandatory-cs)]) (for/and ([mc (in-list mandatory-cs)])
(word-charidx . contains-char? . mc))) (word-charidx . contains-char? . mc)))
;; word contains only letters + mandatory, case-insensitive ;; word contains only letters + mandatory, case-insensitive
(for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))]) (for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))])
(letter-cs-charidx . contains-char? . wc)) (letter-cs-charidx . contains-char? . wc))
;; maybe only proper names ;; maybe only proper names
(if proper-names? (if proper-names?
(capitalized? word-charidx) (capitalized? word-charidx)
@ -55,7 +52,7 @@
;; maybe hide plurals ;; maybe hide plurals
(or (not hide-plurals?) (or (not hide-plurals?)
(not (word-rec-plural? rec))))) (not (word-rec-plural? rec)))))
(values (cons (caer (word-rec-word rec)) word-acc) (add1 count)))) (values (cons (caser (word-rec-word rec)) word-acc) (add1 count))))
(module+ test (module+ test
(require rackunit) (require rackunit)

Loading…
Cancel
Save