You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

48 lines
2.3 KiB
Racket

#lang debug racket/base
(require racket/list
racket/file
"words.rkt"
"length-index.rkt"
"char-index.rkt")
(define (wordlist #:letters [letters "etaoinshrdluw"]
#:mandatory [mandatory #f]
#:min [min-length 5]
#:max [max-length 10]
#:hide-plurals [hide-plurals? #f]
#:proper-names [proper-names? #f]
#:random [random #t]
#:max-words [max-words 10]
#:all-caps [all-caps? #f]
#:initial-caps [initial-caps? #f])
(define mandatory-cs (if mandatory (string->list mandatory) null))
(define letter-cs (append (if letters (string->list letters) null) mandatory-cs))
(for*/fold ([ws null]
[count 0]
#:result (map (cond
[all-caps? string-upcase]
[initial-caps? string-titlecase]
[else values]) ws))
([idx (in-list ((if random shuffle values) (range (vector-length usable-words))))]
[w (in-value (vector-ref usable-words idx))]
[w-charidx (in-value (vector-ref charidx idx))]
[w-lengthidx (in-value (vector-ref lengthidx idx))]
#:break (= count (or max-words +inf.0))
#:when (and
;; between min and max length
((if (<= min-length max-length) <= >=) min-length w-lengthidx max-length)
;; contains each mandatory, case-insensitive
(or (not mandatory)
(for/or ([c (in-list (map char-downcase (charidx->chars w-charidx)))])
(memv c mandatory-cs)))
;; contains only letters + mandatory, case-insensitive
(for/and ([c (in-list (map char-downcase (charidx->chars w-charidx)))])
(memv c letter-cs))
;; maybe only proper names
(if proper-names? (capitalized? w-charidx) (not (capitalized? w-charidx)))
;; maybe hide plurals
(if hide-plurals? (not (regexp-match #rx"s$" w)) #t)))
(values (cons w ws) (add1 count))))
(module+ test
(time (wordlist)))