master
Matthew Butterick 5 years ago
parent 140c0476c6
commit 81cb14d964

@ -1,6 +1,7 @@
#lang debug racket/base #lang debug racket/base
(require racket/file (require racket/file
racket/fasl racket/fasl
racket/vector
"words.rkt") "words.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
@ -28,15 +29,15 @@
#:when (bitwise-bit-set? int i)) #:when (bitwise-bit-set? int i))
(bitindex->char i))) (bitindex->char i)))
(define charidx-file "data/charidx.rktd") (define charidx-file "compiled/charidx.rktd")
(define (regenerate-char-index!) (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 () (define charidx (let ()
(unless (file-exists? charidx-file) (unless (file-exists? charidx-file)
(regenerate-char-index!)) (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) (define (contains-char? charidx-entry c)
(bitwise-bit-set? charidx-entry (char->bitindex c))) (bitwise-bit-set? charidx-entry (char->bitindex c)))

Binary file not shown.

Binary file not shown.

Binary file not shown.

@ -1,16 +1,17 @@
#lang debug racket/base #lang debug racket/base
(require racket/file (require racket/file
racket/fasl racket/fasl
racket/vector
"words.rkt") "words.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(define lengthidx-file "data/lengthidx.rktd") (define lengthidx-file "compiled/lengthidx.rktd")
(define (regenerate-length-index!) (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 () (define lengthidx (let ()
(unless (file-exists? lengthidx-file) (unless (file-exists? lengthidx-file)
(regenerate-length-index!)) (regenerate-length-index!))
(list->vector (fasl->s-exp (open-input-file lengthidx-file))))) (fasl->s-exp (open-input-file lengthidx-file))))

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

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

Loading…
Cancel
Save