Find remaining valid word options or check a word

.a-wordle-script

A guess assistant, not a real solver.

.gitignore

sitejs.js
solution_words*.json
validonly_words*.json
.ionide

.fake

wordleworker.fsx

// intended to be used with F# Interactive
// Wordle hard mode assumed

// -------------------- setup --------------------
#r "nuget: FSharp.Data"
open FSharp.Data
#I __SOURCE_DIRECTORY__
open System

let sitePath =
    "https://www.nytimes.com/games/wordle/"

let siteHtml =
    HtmlDocument.Load sitePath

// scrape site for the js path
let jsFileName =
    siteHtml.Descendants [ "script" ]
    |> Seq.choose (fun elem ->
        elem.TryGetAttribute "src"
        |> Option.filter (fun a -> a.Value().StartsWith "main" && a.Value().EndsWith "js"))
    |> Seq.toList
    |> function
        | [a] -> a.Value ()
        | a::aa -> failwith "Too many JS files found, refine the filter. %A{a::aa}"
        | [ ] -> failwith "JS file name not found."

let siteJs =
    Http.RequestString (sitePath + jsFileName)

let indices (js:string) =
    //solnStartIdx,    middleIdx,           validEndIdx
    js.IndexOf "Ma=[", js.IndexOf "],Oa=[", js.IndexOf "],Ra="

// extract the hardcoded word lists from the js source
let wordLists (js:string) =
    let solnStartIdx, middleIdx, validEndIdx = indices js

    js.Substring (solnStartIdx + 3, middleIdx - solnStartIdx - 2) // include []
    ,js.Substring (middleIdx + 5, validEndIdx - middleIdx - 4) // include []

let saveWordLists (solutions, validonly) =
    System.IO.File.WriteAllText ("./solution_words.json", solutions)
    System.IO.File.WriteAllText ("./validonly_words.json", validonly)

let solutions, validonly =
    siteJs |> wordLists

(solutions, validonly) |> saveWordLists

let jsonToList (s:string) =
    System.Text.Json.JsonSerializer.Deserialize<List<string>> s

let loadWordLists () =
    try
        System.IO.File.ReadAllText "./solution_words.json"
        ,System.IO.File.ReadAllText "./validonly_words.json"
    with
    | ex ->
        printfn $"File error: {ex.Message}"
        "[]", "[]"

let solutionList, validOnlyList =
    try
        jsonToList solutions, jsonToList validonly
    with
    | ex ->
        printfn $"JS parse or JSON serialization error {ex.Message}" // let solutionList, validOnlyList =
        loadWordLists ()
        |> fun (s, v) -> jsonToList s, jsonToList v

let uuddlrlrbas word =
    if not ((DateTime.Today - new DateTime(2021,6,19)).Days |> fun d -> List.item d solutionList = word) then printfn "nope"                                                                 else printfn "found"

let charAt (word:string) posn =
    word.Substring(posn - 1, 1) |> char

let hasAllExact (exists:List<char * int>) word =
    List.forall (fun (c,p) -> charAt word p = c) exists

let hasAllHints (hints:List<char * int>) (word:string) =
    let hasHint (c:char) posn =
        word.Contains c && (charAt word posn <> c)
    List.forall (fun (c,p) -> hasHint c p) hints

let hasUnused unused word =
    let rec hasUnused' (unused:char list) (word:string) =
        match unused with
        | c::cs ->
            if word.Contains c then
                true
            else
                hasUnused' cs word
        | [] ->
            false
    hasUnused' unused word

let checkWord guesses word =
    let cont =
        List.contains word
    let v, s, g =
        cont validOnlyList, cont solutionList, List.map fst guesses |> cont

    if g then printfn "Already guessed."
    if v then printfn "Valid for hints but not a solution."
    if s && not g then printfn "Solution possible."
    if not s && not v then printfn "Invalid word."

let showPossibleSolutions (exact, hint, unused) (guesses:list<string * string>) =
    if not (guesses |> List.forall (fun (g,i) -> g.Length = i.Length)) then failwith "Input length mismatch."

    let chardata =
        guesses
        |> List.map (fun (g,i) ->
            List.map (fun posn -> charAt g posn, charAt i posn, posn) [1..g.Length])
        |> List.collect id
        |> List.distinct
    let e =
        chardata
        |> List.where (fun (_,i,_) -> i = exact)
        |> List.map (fun (g,_,p) -> g,p)
    let e' =
        e |> List.map fst
    let h =
        chardata
        |> List.where (fun (_,i,_) -> i = hint)
        |> List.map (fun (g,_,p) -> g,p)
    let h' =
        h |> List.map fst
    let u =
        chardata
        |> List.where (fun (_,i,_) -> i = unused)
        |> List.map (fun (g,_,_) -> g)
        |> List.filter (fun c -> List.contains c e' |> not && List.contains c h' |> not)
    let filters w =
        hasUnused u w |> not && hasAllExact e w && hasAllHints h w
    let solutions =
        solutionList |> List.filter filters

    if solutions.Length = 0 then printfn "0 solutions found, something is wrong!"
    printfn $"{solutions.Length} possible solutions found."
    solutions

// -------------------- work space --------------------

// configure symbols to represent tile info; any single character is valid
let exact, hint, unused =
      '@', '#', '_'

// input current guesses and tile info as a string pair
let guesses =
    [
        "fable", "_#__@" // #4 in the archive
        "suave", "__@_@"
    ]

showPossibleSolutions (exact, hint, unused) guesses

checkWord guesses "xyzzy"