For this post I will rework the Prefer One algorithm from
the previous post so that it is much more efficient. We will
add words to a Patricia Tree-like dictionary as we see them,
passing the tree along in the State monad; to check if a new
word has been seen we simply check in the tree, rather than
in the array.
First, a little boilerplate…
module Main
where
import Data.Array
import Data.List(isInfixOf, tails)
import Control.Monad.State
import Control.Arrow
NEW IMPLEMENTATION:
———————————————————————-
In the previous implementation, to check if the word formed
by adding a one has been seen, we had to iterate through each
of the previous bits in the array, checking words.
For example for words of length 3, finding the 7th bit (?)
by checking if 111 has already been seen:
/-----\ ==> 111
0 0 0 1 1 1 (1)...
\----/ 000 == 111 No
\----/ 001 == 111 No
\----/ 011 == 111 No
\----/ 111 == 111 Yes, so this bit must be (0)
This is extremely inefficient. What we want is to be able to
store all the previous words that we’ve encountered in an easily-
searchable data structure.
In the example above, we would like the three words that we’ve
seen to be stored in what might be called a Trie, so that our
search instead looks like the following:
/\
0 1 1 - in tree, go right
/ \ \
0 1 1 1 - in tree, go right
/ \ \ \
0 1 1 1 1 - in tree, we've already seen 111,
so the last bit must be 0
Our new data structure will look like this:
data Tree = Bs Tree Tree
| X
| B
deriving Show
We’ll need to build a new tree from a list of bits, appending
a final bit (1, except for the initial tree):
treeWithFinal1 = mkTree True
treeWithFinal0 = mkTree False
mkTree :: Bit -> [Bit] -> Tree
mkTree p = foldr mkBranch (if p then Bs X B else Bs B X)
where mkBranch b | b = Bs X
| otherwise = flip Bs X
Finally, here is our new algorithm. The tree is passed in the
State monad, through the use of mapM. The state monad is a little
tricky sometimes:
preferOneV2 :: Int -> [ Bit ]
preferOneV2 n =
let upB = 2^n
bs = take upB (replicate n False ++ bs')
(wp0:wordPrefixes) = [ take (n-1) w | w <- tails bs ]
state0 = treeWithFinal0 wp0
bsM' = mapM (State . thisBit) wordPrefixes
(bs',tree) = runState bsM' state0
in cycle bs
With the following function, after we apply it to the word we’re searching
for, it becomes a function :: state -> (val,state), suitable for the
State monad:
Takes a list of the last n-1 Bits (Bools) and traverses a Tree which we’ve
been using to keep track of the words we’ve already seen. We fold the Bit
list into the tree. When we get to the endo of the list, we look for a One.
We return the new bit as well as the new Tree:
thisBit :: [ Bit ] -> Tree -> (Bit, Tree)
We’re at a Zero bit,
thisBit (False:bs) (Bs X o) = (True, Bs (treeWithFinal1 bs) o)
thisBit (False:bs) (Bs z o) = (id *** flip Bs o) (thisBit bs z)
…a One bit,
thisBit (True:bs) (Bs z X) = (True, Bs z (treeWithFinal1 bs))
thisBit (True:bs) (Bs z o) = (id *** Bs z) (thisBit bs o)
…or else propose a One for the last bit:
thisBit [] (Bs _ o) = (b , (Bs z B))
where (b, z) = case o of
X -> (True, X)
_ -> (False, B)
TEST FUNCTIONS:
———————————————————————-
This code is copied from the previous post:
We use Bool for bits, where False ==> 0, True ==> 1:
type Bit = Bool
Our garage-door lock model for testing the function:
type Combo = [ Bit ]
type Receiver = Combo -> Bool
True means access granted:
programReceiver :: Combo -> Receiver
programReceiver = isInfixOf
Test out our function:
main = let secretCode = [True,True,False,False,True,
False,True,False,True,True]
receiver = programReceiver secretCode
crackingStream = preferOneV2 10
in if receiver crackingStream
then print "WE'RE IN!"
else print "...bugs"
Stay tuned for one more post on these algorithms.