Wordle solver

wordle.rkt

#lang typed/racket
(require bnf)

(Hint . ::= . (At [c : Char] [pos : Integer])
              (Present [c : Char] [but-not : Integer])
              (Absent [c : Char]))

(struct Accum ([pool : (Listof String)] [explored-letters : (Setof Char)]))

(: refine : Accum (Listof Hint) → Accum)
(define (refine acc feedback)
  (Accum (filter (matches-hints? feedback) (Accum-pool acc))
         (for/fold ([s (Accum-explored-letters acc)]) ([h feedback])
           (set-add s (match h
                        [(At c _) c]
                        [(Present c _) c]
                        [(Absent c) c])))))

(: matches-hints? : (Listof Hint) → String → Boolean)
(define ((matches-hints? hints) str)
  (andmap (match-lambda
            [(At c i) (equal? (string-ref str i) c)]
            [(Present c i) (and (string-contains? str (string c))
                                (not (equal? (string-ref str i) c)))]
            [(Absent c) (not (string-contains? str (string c)))])
          hints))

(define guess : (Accum → String)
  (match-lambda
    [(Accum pool cs)
     (argmax ; by how many more letters each word explores
      (λ ([w : String])
        (count (λ (c) (not (set-member? cs c))) (remove-duplicates (string->list w))))
      pool)]))

(module+ main
  (define (load-words) : (Listof String)
    (for/list ([w (string-split (with-output-to-string (λ () (system "aspell -d en dump master"))))]
               #:when (= 5 (string-length w))
               #:when (andmap (λ ([c : Char]) (char<=? #\a c #\z)) (string->list w)))
      w))

  (: read-feedback : String → (Listof Hint))
  (define (read-feedback guess) : (Listof Hint)
    (define cs (set #\Y #\y #\N #\n #\?))
    (printf "Feedback for \"~a\" if it's not it: (e.g. Y??NN) : " guess)
    (match (read-line)
      [(? string? (app string-trim (? (λ (s) (andmap (λ (c) (set-member? cs c)) (string->list s))) fs)))
       (for/list ([c (in-string guess)] [f (in-string fs)] [i (in-naturals)])
         (match f
           [(or #\Y #\y) (At c i)]
           [(or #\N #\n) (Absent c)]
           [#\? (Present c i)]))]
      [_ (displayln "No. Again.") (read-feedback guess)]))
  
  (let loop ([acc (Accum (load-words) (set))])
    (match (Accum-pool acc)
      [(list w) (printf "\"~a\" it is~n" w)]
      ['() (displayln "Beyond my vocabulary.")]
      [_ (define g (guess acc))
         (match-define (Accum pool cs) acc)
         (printf "Next guess (out of ~a candidates): ~a~n" (length pool) g)
         (loop (refine (Accum (remove g pool) cs) (read-feedback g)))])))