more

words/char-index.rkt

@@ -1,6 +1,7 @@
 #lang debug racket/base
 (require racket/file
          racket/fasl
+         racket/vector
          "words.rkt")
 (provide (all-defined-out))
 
@@ -28,15 +29,15 @@
              #:when (bitwise-bit-set? int i))
     (bitindex->char i)))
 
-(define charidx-file "data/charidx.rktd")
+(define charidx-file "compiled/charidx.rktd")
 
 (define (regenerate-char-index!)
-  (s-exp->fasl (map word->charidx usable-words) (open-output-file charidx-file #:exists 'replace)))
+  (s-exp->fasl (vector-map word->charidx usable-words) (open-output-file charidx-file #:exists 'replace)))
 
 (define charidx (let ()
                   (unless (file-exists? charidx-file)
                     (regenerate-char-index!))
-                  (list->vector (fasl->s-exp (open-input-file charidx-file)))))
+                  (fasl->s-exp (open-input-file charidx-file))))
 
 (define (contains-char? charidx-entry c)
   (bitwise-bit-set? charidx-entry (char->bitindex c)))

words/length-index.rkt

@@ -1,16 +1,17 @@
 #lang debug racket/base
 (require racket/file
          racket/fasl
+         racket/vector
          "words.rkt")
 (provide (all-defined-out))
 
-(define lengthidx-file "data/lengthidx.rktd")
+(define lengthidx-file "compiled/lengthidx.rktd")
 
 (define (regenerate-length-index!)
-  (s-exp->fasl (map string-length usable-words) (open-output-file lengthidx-file #:exists 'replace)))
+  (s-exp->fasl (vector-map string-length usable-words) (open-output-file lengthidx-file #:exists 'replace)))
 
 (define lengthidx (let ()
                   (unless (file-exists? lengthidx-file)
                     (regenerate-length-index!))
-                  (list->vector (fasl->s-exp (open-input-file lengthidx-file)))))
+                  (fasl->s-exp (open-input-file lengthidx-file))))
 

words/main.rkt

@@ -15,8 +15,10 @@
                   #: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))
+  (define mandatory-cs
+    (if mandatory (remove-duplicates (map char-downcase (string->list mandatory)) char=?) null))
+  (define letter-cs (remove-duplicates (append (if letters (map char-downcase (string->list letters)) null) mandatory-cs) char=?))
+  (define letter-cs-charidx (word->charidx (list->string letter-cs)))
   (for*/fold ([ws null]
               [count 0]
               #:result (map (cond
@@ -31,13 +33,13 @@
               #:when (and
                       ;; between min and max length
                       ((if (<= min-length max-length) <= >=) min-length w-lengthidx max-length)
-                      ;; contains each mandatory, case-insensitive
+                      ;; word contains each mandatory char, 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))
+                          (for/and ([mc (in-list mandatory-cs)])
+                                   (w-charidx . contains-char? . mc)))
+                      ;; word contains only letters + mandatory, case-insensitive
+                      (for/and ([wc (in-list (map char-downcase (charidx->chars w-charidx)))])
+                               (letter-cs-charidx . contains-char? . wc))
                       ;; maybe only proper names
                       (if proper-names? (capitalized? w-charidx) (not (capitalized? w-charidx)))
                       ;; maybe hide plurals
@@ -45,4 +47,7 @@
     (values (cons w ws) (add1 count))))
 
 (module+ test
-  (time (wordlist)))
+  (require rackunit)
+  (time (wordlist))
+  (check-equal? (sort (wordlist #:mandatory "xyz") string<?)
+                '("azoxy" "dysoxidize" "isazoxy" "oxytonize" "rhizotaxy" "zootaxy")))

words/words.rkt

@@ -19,7 +19,7 @@
       w))
   ws)
 
-(define wordidx-file "data/wordidx.rktd")
+(define wordidx-file "compiled/wordidx.rktd")
 
 (define (regenerate-word-index!)
   (s-exp->fasl (make-wordlist) (open-output-file wordidx-file #:exists 'replace)))