Cracking a Lock in Haskell With the De Bruijn Sequence, Pt. 2

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.

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:
> dataTree=BsTreeTree-- Bs (zero_bit) (one_bit)> |X-- incomplete word> |B-- final bit of word> derivingShowWe'll need to build a new tree from a list of bits, appending a final bit (1,
except for the initial tree):
> treeWithFinal1=mkTreeTrue> treeWithFinal0=mkTreeFalse>> mkTree::Bit->[Bit]->Tree> mkTreep=foldrmkBranch(ifpthenBsXBelseBsBX)> wheremkBranchb|b=BsX--1> |otherwise=flipBsX--0Finally, 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]> preferOneV2n=> letupB=2^n> -- the whole bit sequence (one period):> bs=takeupB(replicatenFalse++bs')> (wp0:wordPrefixes)=[take(n-1)w|w<-tailsbs]>> -- pass our Tree around in the State monad> state0=treeWithFinal0wp0>> -- thisBit is partially applied, after which we wrap the> -- function in a State constructor to make our :: m a> bsM'=mapM(State.thisBit)wordPrefixes> (bs',tree)=runStatebsM'state0>> -- an infinite stream is returned... because I can:> incyclebsWith 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)(BsXo)=(True,Bs(treeWithFinal1bs)o)-- last bit must be 1> thisBit(False:bs)(Bszo)=(id***flipBso)(thisBitbsz)...a One bit,
> thisBit(True:bs)(BszX)=(True,Bsz(treeWithFinal1bs))> thisBit(True:bs)(Bszo)=(id***Bsz)(thisBitbso)...or else propose a One for the last bit:
> thisBit[](Bs_o)=(b,(BszB))> -- we know that if the One bit has been seen (B) then we must> -- place a zero. we assume then that the Zero bit is (X):> where(b,z)=caseoof> -- this bit = 1, Zero branch = nil> X->(True,X)-- 1> -- this bit = 0, Zero branch = last word bit> _->(False,B)-- 0

TEST FUNCTIONS:

This code is copied from the previous post:

12345678910111213141516171819202122232425262728

We use Bool for bits, where False ==> 0, True ==> 1:
> typeBit=BoolOur garage-door lock model for testing the function:
> typeCombo=[Bit]> typeReceiver=Combo->BoolTrue means access granted:
> programReceiver::Combo->Receiver> programReceiver=isInfixOfTest out our function:
> main=letsecretCode=[True,True,False,False,True,> False,True,False,True,True]> receiver=programReceiversecretCode> crackingStream=preferOneV210>> inifreceivercrackingStream> thenprint"WE'RE IN!"> elseprint"...bugs">