First remove a single matching token, so duplicates cannot be reused:Equal game lengths are assumed. For each token,
pluck :: Eq a => a -> [a] -> Maybe [a]
pluck _ [] = Nothing
pluck x (y:ys)
| x == y = Just ys
| otherwise = case pluck x ys of
Nothing -> Nothing
Just zs -> Just (y:zs)
overlap :: Eq a => [a] -> [a] -> [a]
overlap [] _ = []
overlap (x:xs) ys = case pluck x ys of
Nothing -> overlap xs ys
Just zs -> x : overlap xs zs
scoreBC :: Eq a => [a] -> [a] -> (Int,Int)
scoreBC secret guess = (bulls, matches - bulls)
where
bulls = length [() | (s,g) <- zip secret guess, s == g]
matches = length (overlap guess secret)overlap retains exactly the smaller of its two multiplicities, so its length is the multiset overlap. It never spends a secret occurrence twice. Positional matches account for bulls; after reserving them, each token's remaining possible matches decrease by exactly its bull count. Hence matches - bulls counts precisely the cows. The source example gives (1,1). With equality as the only operation on tokens, these definitions take time for length .Use a distinct constructor for each mark, and reserve every bull before allocating any cow:The multiset
data Mark = Bull | Cow | Miss deriving (Eq,Show)
scoreWordle :: Eq a => [a] -> [a] -> [Mark]
scoreWordle secret guess = mark pairs pool
where
pairs = zip secret guess
pool = [s | (s,g) <- pairs, s /= g]
mark [] _ = []
mark ((s,g):ps) available
| s == g = Bull : mark ps available
| otherwise = case pluck g available of
Nothing -> Miss : mark ps available
Just rest -> Cow : mark ps restpool contains exactly the unused secret tokens after all bulls have been set aside. The recursive invariant is that available contains those tokens not yet allocated to cows. A successful pluck consumes one, and failure leaves the pool unchanged. This proves both multiplicity correctness and the priority of bulls over cows. Among duplicate non-bull guess tokens, the leftmost eligible ones receive cows. For secret "alpha" and guess "aaabb", the result is [Bull,Cow,Miss,Miss,Miss]. This implements duplicate-aware positional scoring.A scorer applies the same scoring rule, with the fixed secret, independently to each guess:The first score depends only on the first guess, and every later score only on the corresponding guess. Thus this player has no unguarded dependence on its own future output when connected to the guesser by a lazy feedback stream. Neither the dictionary nor a strategy is needed by a truthful scorer once the secret and scoring rule are fixed.
mkScorer :: (secret -> guess -> score)
-> secret -> [guess] -> [score]
mkScorer score secret = map (score secret)The score function takes a proposed secret first and a guess second:Assume that the initial dictionary contains the secret, that scores are truthful, and that
mkGuesser :: Eq score
=> (guess -> guess -> score)
-> ([guess] -> guess)
-> [guess] -> [score] -> [guess]
mkGuesser score strategy dictionary = play dictionary
where
play candidates replies =
let g = strategy candidates
in g : case replies of
[] -> []
r:rs -> play [s | s <- candidates, score s g == r] rsstrategy returns a candidate from its nonempty input. The candidate invariant is exactly the dictionary entries consistent with every score already received. Filtering by score s g == r establishes the same invariant after the next reply and retains the true secret.Crucially, the next guess
g is placed under the outer list constructor before replies is inspected. It depends on earlier replies only; the first guess depends on none. This guarded lazy feedback stream makes the mutually recursive game productive whenever the strategy and scoring operations terminate. Moving the case replies outside the constructor would create a circular demand before the first guess.Let be the number of distinct dictionary candidates. A wrong guess is itself a current candidate, but its actual score differs from its score against itself, which has all positions as bulls. Therefore each wrong reply removes at least that candidate while retaining the true secret. There can be at most wrong guesses. A correct guess leaves only the secret consistent with the all-bull reply. Hence every such infinite game's history eventually has the constant tailThis is the finite candidate elimination bound; it assumes a nonempty finite dictionary of fixed-length secrets and a strategy that chooses from the remaining candidates.
The stated end condition is identification, so stop when just one candidate remains, even if it has not been guessed. Replace the worker above byThe scorer can stay
play [] _ = []
play [_] _ = []
play candidates replies =
let g = strategy candidates
in g : case replies of
[] -> []
r:rs -> play [s | s <- candidates, score s g == r] rsmap (score secret): once the guess list ends, its score list ends too. The unchanged game then returns a finite history, with at most rounds; a singleton initial dictionary needs no round. If the identified secret is also wanted as an explicit output, return that sole surviving candidate alongside the history. Articles by others on the same topic
There are currently no matching articles.