Password-cracking elves, oh my!
Given a range of numbers to try, I had to determine how many fit a series of
rules. Since the rules mostly operated on the individual digits, I decided to
represent the passwords as
Then I encoded the rules as a list of functions
int list -> bool. If all of
them hold for a given password, then we are in the clear. Here they are:
val rules : rule list = [ fn p => List.all (fn i => 0 <= i andalso i <= 9) p ,fn p => length p = 6 ,fn p => let val p' = toInt p in #min r <= p' andalso p' <= #max r end ,fn p => List.exists (fn (a,b) => a=b) (ListPair.zip (p, tl p)) ,fn p => #2 (foldl (fn (curr, (prev, notDecr)) => (curr, notDecr andalso curr >= prev)) (~1, true) p) ]
The rest is some (poor) boiler-plate to set up the solution.
I rewrote the boiler-plate some, although there are some oddities. For example,
I had to re-convince myself that the composition of
elvesPasswdChecker was valid:
val elvesPasswdChecker : range -> passwd -> bool val countValid : (passwd -> bool) -> range -> int (* therefore *) val counter : range -> range -> int = countValid o elvesPasswdChecker
Checking the type shows why we have to feed the range in twice in the (simplified)
counter range range
The truly hardest part, however, was encoding the new rule: the pair of equal digits is not in a group of equal digits.
In order to check this, I wanted to examine the
pairs of a password, which
consist of two middle elements, with possibly an element on either side (the
int option * (int * int) * int option). Consider the password
abcdef: the pairs would be
(NONE, (a, b), SOME c) (SOME a, (b, c), SOME d) (SOME b, (c, d), SOME e) (SOME c, (d, e), SOME f) (SOME d, (e, f), NONE)
The key here is that, in the middle group, I need to check properties of all 4
integers (e.g., in
122223, I need to know about both sides of a 2 in the
middle). But for the ends, I only have to check one direction. The new rule is
fn p => List.exists (fn (a,(b,c),d) => case (a, d) of (* technically impossible *) (NONE, NONE) => b = c | (SOME a', NONE) => a' = b andalso b <> c | (NONE, SOME d') => b <> c andalso c = d' | (SOME a', SOME d') => a' <> b andalso b = c andalso c <> d') (pairs p)
But now, how to write
pairs : int list -> (int option * (int * int) * int
The trick is to have a
windows : int -> 'a list -> 'a list list, where each
sub-list of the result has exactly \(n\) elements (the first input). This cannot
be encoded in sml’s type-system, for it requires dependent types. Here are some
- windows 0 [1,2,3]; val it =  : int list list - windows 1 [1,2,3]; val it = [,,] : int list list - windows 2 [1,2,3]; val it = [[1,2],[2,3]] : int list list - windows 3 [1,2,3]; val it = [[1,2,3]] : int list list
Then I can encode
pairs as follows:
fun pairs p : (int option * (int * int) * int option) list = let val blocks = windows 4 p val blocks3 = windows 3 p val fst = hd blocks3 val lst = List.last blocks3 in ((fn [a,b,c] => (SOME a, (b,c), NONE)) fst) :: ((fn [b,c,d] => (NONE, (b,c), SOME d)) lst) :: (map (fn [a,b,c,d] => (SOME a, (b,c), SOME d)) blocks) end
Here I grab the middle elements with
windows 4 and the ends with
We go ahead and ignore the warnings about incomplete matches and construct the
list of pairs.
So we need
windows. The base cases are straightforward, as we handle the
simplest pieces first. The recursion is visible even in the example I gave
earlier, and spotting that is how I designed the algorithm.
windows n-1 = [[1,2], [2,3], [3,4]], we have some merging to do to get
windows n. We pair up the results into
[([1,2], [2,3]), ([2,3], [3,4])].
But before we concatenate (
@), we need to drop some elements! In fact, we need
to drop exactly
n-2 elements. This won’t raise the
because we have already handled the case for \(n = 1\); i.e., we can prove \(n
fun windows (n : int) (xs : 'a list) : 'a list list = if n = length xs then [xs] else if n <= 0 orelse null xs then  else if n = 1 then map (fn x => [x]) xs else let val prev = windows (n-1) (xs) fun merge (xs, ys) = xs @ (List.drop (ys, n-2)) in map merge (ListPair.zip (prev, (tl prev))) end
And that’s all!