diff --git a/words/main.rkt b/words/main.rkt index 76b71d2..29cd069 100644 --- a/words/main.rkt +++ b/words/main.rkt @@ -4,6 +4,7 @@ (define (make-words #:letters [letters "etaoinshrdluw"] #:mandatory [mandatory #f] + #:combo [combo #f] #:min [min-length 5] #:max [max-length 10] #:hide-plurals [hide-plurals? #t] @@ -12,39 +13,43 @@ #:all-caps [all-caps? #f] #:initial-caps [initial-caps? #f]) (define mandatory-cs - (if mandatory (remove-duplicates (for/list ([c (in-string mandatory)]) - (char-downcase c)) char=?) null)) + (if (or mandatory combo) + (remove-duplicates + (for/list ([c (in-string (string-append (or mandatory "") (or combo "")))]) + (char-downcase c)) char=?) null)) (define letter-cs-charidx (word->charidx (list->string (remove-duplicates (append (if letters (for/list ([c (in-string letters)]) - (char-downcase c)) + (char-downcase c)) null) mandatory-cs) char=?)))) (define caser (cond - [all-caps? string-upcase] - [initial-caps? string-titlecase] - [else values])) + [all-caps? string-upcase] + [initial-caps? string-titlecase] + [else values])) (for*/fold ([word-acc null] [count 0] #:result word-acc) ([idx (in-list (shuffle (range (vector-length wordrecs))))] [rec (in-value (vector-ref wordrecs idx))] [word-charidx (in-value (word-rec-charint rec))] + [word (in-value (word-rec-word rec))] #:break (= count (or max-words +inf.0)) #:when (and ;; between min and max length ((if (<= min-length max-length) <= >=) min-length (word-rec-length rec) max-length) ;; word contains each mandatory char, case-insensitive - (or (not mandatory) - (for/and ([mc (in-list mandatory-cs)]) - (word-charidx . contains-char? . mc))) + (for/and ([mc (in-list mandatory-cs)]) + (word-charidx . contains-char? . mc)) ;; word contains only letters + mandatory, case-insensitive (for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))]) - (letter-cs-charidx . contains-char? . wc)) + (letter-cs-charidx . contains-char? . wc)) + (or (not combo) + (regexp-match combo word)) ;; maybe only proper names (if proper-names? (capitalized? word-charidx) @@ -52,10 +57,10 @@ ;; maybe hide plurals (or (not hide-plurals?) (not (word-rec-plural? rec))))) - (values (cons (caser (word-rec-word rec)) word-acc) (add1 count)))) + (values (cons (caser word) word-acc) (add1 count)))) (module+ test (require rackunit) (time (make-words)) - (check-equal? (sort (make-words #:mandatory "xyz") string