diff --git a/words/main.rkt b/words/main.rkt index b429852..6fe3aec 100644 --- a/words/main.rkt +++ b/words/main.rkt @@ -1,8 +1,13 @@ #lang debug racket/base (require racket/list + racket/set "index.rkt") (provide make-words) +(define (string->set str) + (for/seteqv ([c (in-string (or str ""))]) + (char-downcase c))) + (define (make-words #:letters [letters-arg #f] #:mandatory [mandatory #f] #:omit [omit #f] @@ -13,33 +18,26 @@ #:proper-names [proper-names? #f] #:count [count 10] #:case [casing #f]) - (define letters (or letters-arg "abcdefghijklmnopqrstuvwxyz")) - (define mandatory-cs - (if (or mandatory combo) - (remove-duplicates - (for/list ([c (in-string (string-append (or mandatory "") (or combo "")))]) - (char-downcase c)) char=?) null)) - (define forbidden-cs - (remove-duplicates - (for/list ([c (in-string (or omit ""))]) - (char-downcase c)) char=?)) + + (define letter-set (string->set (or letters-arg "abcdefghijklmnopqrstuvwxyz"))) + (define mandatory-set (set-union (string->set mandatory) (string->set combo))) + (define omitted-set (string->set omit)) + (define letter-cs-charidx (word->charidx (list->string - (remove-duplicates - (append (if letters - (for/list ([c (in-string letters)]) - (char-downcase c)) - null) - mandatory-cs) - char=?)))) + (set->list + (set-subtract (set-union letter-set mandatory-set) omitted-set))))) + (define caser (case casing [(up upcase upper uppercase) string-upcase] [(title titlecase) string-titlecase] [(down downcase lower lowercase) string-downcase] [else values])) + (define min-length (or min-length-arg 0)) (define max-length (or max-length-arg +inf.0)) + (for*/fold ([word-acc null] [count-acc 0] #:result word-acc) @@ -52,27 +50,22 @@ ;; 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 - (for/and ([mc (in-list mandatory-cs)]) + (for/and ([mc (in-set mandatory-set)]) (word-charidx . contains-char? . mc)) - ;; word contains only letters + mandatory, case-insensitive + ;; word contains only (letters + mandatory) - forbidden, + ;; case-insensitive (for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))]) (letter-cs-charidx . contains-char? . wc)) (or (not combo) (regexp-match (string-downcase combo) word)) - ;; word does not contain forbidden characters - (for/and ([fc (in-list forbidden-cs)]) - (not (word-charidx . contains-char? . fc))) ;; maybe only proper names - (if proper-names? - (capitalized? word-charidx) - (not (capitalized? word-charidx))) + ((if proper-names? values not) (capitalized? word-charidx)) ;; maybe hide plurals - (or (not hide-plurals?) - (not (word-rec-plural? rec))))) + (or (not hide-plurals?) (not (word-rec-plural? rec))))) (values (cons (caser word) word-acc) (add1 count-acc)))) (module+ test (require rackunit) (time (make-words)) (check-equal? (sort (make-words #:mandatory "xyz" #:combo #false #:letters "etaoinshrdluw") string