|
|
@ -1,6 +1,5 @@
|
|
|
|
#lang debug racket/base
|
|
|
|
#lang debug racket/base
|
|
|
|
(require racket/list
|
|
|
|
(require racket/list
|
|
|
|
racket/file
|
|
|
|
|
|
|
|
"index.rkt")
|
|
|
|
"index.rkt")
|
|
|
|
|
|
|
|
|
|
|
|
(define (make-words #:letters [letters "etaoinshrdluw"]
|
|
|
|
(define (make-words #:letters [letters "etaoinshrdluw"]
|
|
|
@ -14,23 +13,21 @@
|
|
|
|
#:initial-caps [initial-caps? #f])
|
|
|
|
#:initial-caps [initial-caps? #f])
|
|
|
|
(define mandatory-cs
|
|
|
|
(define mandatory-cs
|
|
|
|
(if mandatory (remove-duplicates (for/list ([c (in-string mandatory)])
|
|
|
|
(if mandatory (remove-duplicates (for/list ([c (in-string mandatory)])
|
|
|
|
(char-downcase c)) char=?) null))
|
|
|
|
(char-downcase c)) char=?) null))
|
|
|
|
(define letter-cs-charidx
|
|
|
|
(define letter-cs-charidx
|
|
|
|
(word->charidx
|
|
|
|
(word->charidx
|
|
|
|
(list->string
|
|
|
|
(list->string
|
|
|
|
(remove-duplicates
|
|
|
|
(remove-duplicates
|
|
|
|
(append (if letters
|
|
|
|
(append (if letters
|
|
|
|
(for/list ([c (in-string letters)])
|
|
|
|
(for/list ([c (in-string letters)])
|
|
|
|
(char-downcase c))
|
|
|
|
(char-downcase c))
|
|
|
|
null)
|
|
|
|
null)
|
|
|
|
mandatory-cs)
|
|
|
|
mandatory-cs)
|
|
|
|
char=?))))
|
|
|
|
char=?))))
|
|
|
|
|
|
|
|
(define caser (cond
|
|
|
|
(define caer (cond
|
|
|
|
[all-caps? string-upcase]
|
|
|
|
[all-caps? string-upcase]
|
|
|
|
[initial-caps? string-titlecase]
|
|
|
|
[initial-caps? string-titlecase]
|
|
|
|
[else values]))
|
|
|
|
[else values]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(for*/fold ([word-acc null]
|
|
|
|
(for*/fold ([word-acc null]
|
|
|
|
[count 0]
|
|
|
|
[count 0]
|
|
|
|
#:result word-acc)
|
|
|
|
#:result word-acc)
|
|
|
@ -44,10 +41,10 @@
|
|
|
|
;; word contains each mandatory char, case-insensitive
|
|
|
|
;; word contains each mandatory char, case-insensitive
|
|
|
|
(or (not mandatory)
|
|
|
|
(or (not mandatory)
|
|
|
|
(for/and ([mc (in-list mandatory-cs)])
|
|
|
|
(for/and ([mc (in-list mandatory-cs)])
|
|
|
|
(word-charidx . contains-char? . mc)))
|
|
|
|
(word-charidx . contains-char? . mc)))
|
|
|
|
;; word contains only letters + mandatory, case-insensitive
|
|
|
|
;; word contains only letters + mandatory, case-insensitive
|
|
|
|
(for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))])
|
|
|
|
(for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))])
|
|
|
|
(letter-cs-charidx . contains-char? . wc))
|
|
|
|
(letter-cs-charidx . contains-char? . wc))
|
|
|
|
;; maybe only proper names
|
|
|
|
;; maybe only proper names
|
|
|
|
(if proper-names?
|
|
|
|
(if proper-names?
|
|
|
|
(capitalized? word-charidx)
|
|
|
|
(capitalized? word-charidx)
|
|
|
@ -55,7 +52,7 @@
|
|
|
|
;; maybe hide plurals
|
|
|
|
;; maybe hide plurals
|
|
|
|
(or (not hide-plurals?)
|
|
|
|
(or (not hide-plurals?)
|
|
|
|
(not (word-rec-plural? rec)))))
|
|
|
|
(not (word-rec-plural? rec)))))
|
|
|
|
(values (cons (caer (word-rec-word rec)) word-acc) (add1 count))))
|
|
|
|
(values (cons (caser (word-rec-word rec)) word-acc) (add1 count))))
|
|
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
(module+ test
|
|
|
|
(require rackunit)
|
|
|
|
(require rackunit)
|
|
|
|