<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0"
	xmlns:content="http://purl.org/rss/1.0/modules/content/"
	xmlns:wfw="http://wellformedweb.org/CommentAPI/"
	xmlns:dc="http://purl.org/dc/elements/1.1/"
	xmlns:atom="http://www.w3.org/2005/Atom"
	xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
	xmlns:slash="http://purl.org/rss/1.0/modules/slash/"
	>

<channel>
	<title>LAMBDAPHONE &#187; monads</title>
	<atom:link href="http://coder.bsimmons.name/blog/tag/monads/feed/" rel="self" type="application/rss+xml" />
	<link>http://coder.bsimmons.name/blog</link>
	<description>fragmentary ideas  ䷿  intellectual what-nots  ䷷  and haskell programming  ䷴</description>
	<lastBuildDate>Tue, 27 Jul 2010 16:58:03 +0000</lastBuildDate>
	<generator>http://wordpress.org/?v=2.9.1</generator>
	<language>en</language>
	<sy:updatePeriod>hourly</sy:updatePeriod>
	<sy:updateFrequency>1</sy:updateFrequency>
			<item>
		<title>DeBruijn Sequences pt.3 &#8211; The &#8220;Prefer Opposite&#8221; algorithm</title>
		<link>http://coder.bsimmons.name/blog/2009/12/debruijn-sequences-pt3-the-prefer-opposite-algorithm/</link>
		<comments>http://coder.bsimmons.name/blog/2009/12/debruijn-sequences-pt3-the-prefer-opposite-algorithm/#comments</comments>
		<pubDate>Wed, 02 Dec 2009 02:29:29 +0000</pubDate>
		<dc:creator>jberryman</dc:creator>
				<category><![CDATA[haskell]]></category>
		<category><![CDATA[algorithm]]></category>
		<category><![CDATA[laziness]]></category>
		<category><![CDATA[monads]]></category>
		<category><![CDATA[sequences]]></category>

		<guid isPermaLink="false">http://coder.bsimmons.name/blog/?p=295</guid>
		<description><![CDATA[<p><em>This is the third post of mine on DeBruijn sequences, and is in preparation for another post to come which I hope should be an interesting investigation into a possible parallel algorithm. The first two posts are <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-1/">here</a> and</em>&#8230; <a href="http://coder.bsimmons.name/blog/2009/12/debruijn-sequences-pt3-the-prefer-opposite-algorithm/" class="read_more">   [ R E A D &#124; M O R E ]</a></p>]]></description>
			<content:encoded><![CDATA[<p><em>This is the third post of mine on DeBruijn sequences, and is in preparation for another post to come which I hope should be an interesting investigation into a possible parallel algorithm. The first two posts are <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-1/">here</a> and <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-2/">here</a>.</em><br />
<span id="more-295"></span><br />
&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;</p>
<p><div class="vimblock"><br />
This algorithm works identically to the Prefer One algorithm, however<br />
rather than choose a 1-bit if possible, we instead choose the opposite<br />
bit from the previous bit, if possible.<br />
<br />
This has the effect of evening out the locations of the zeros and ones<br />
throughout the sequence. We will exploit this in a later post where I<br />
will explore a possible parallel algorithm, which should be interesting<br />
I hope!<br />
<br />
Here's the code...<br />
<br />
<span class="Comment">&gt;</span>&nbsp;<span class="Type">module</span>&nbsp;Main<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">where</span><br />
<span class="Comment">&gt;</span><br />
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Data.List(tails)<br />
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Control.Monad.State<br />
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Control.Arrow<br />
<br />
<br />
We use Bool for bits, where False ==&gt; 0, True ==&gt; 1:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;<span class="Type">type</span>&nbsp;Bit&nbsp;<span class="Statement">=</span>&nbsp;<span class="Type">Bool</span><br />
<br />
<br />
We use a tree to search for the words already created in our bit stream:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;<span class="Type">data</span>&nbsp;Tree&nbsp;<span class="Statement">=</span>&nbsp;Bs&nbsp;Tree&nbsp;Tree&nbsp;&nbsp;<span class="Comment">-- Bs (zero_bit) (one_bit)</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;X&nbsp;<span class="Comment">-- incomplete word</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;B&nbsp;<span class="Comment">-- final bit of word</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">deriving</span>&nbsp;<span class="Type">Show</span><br />
<br />
<br />
We'll need to build a new tree from a list of bits, appending<br />
a final bit:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;treeWithFinal&nbsp;<span class="Statement">::</span>&nbsp;Bit&nbsp;<span class="Statement">-&gt;</span>&nbsp;[Bit]&nbsp;<span class="Statement">-&gt;</span>&nbsp;Tree<br />
<span class="Comment">&gt;</span>&nbsp;treeWithFinal&nbsp;p&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">foldr</span>&nbsp;mkBranch&nbsp;(<span class="Statement">if</span>&nbsp;p&nbsp;<span class="Statement">then</span>&nbsp;Bs&nbsp;X&nbsp;B&nbsp;<span class="Statement">else</span>&nbsp;Bs&nbsp;B&nbsp;X)&nbsp;&nbsp; <br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">where</span>&nbsp;mkBranch&nbsp;b&nbsp;<span class="Statement">|</span>&nbsp;b&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">=</span>&nbsp;Bs&nbsp;X&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Comment">--1</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">|</span>&nbsp;<span class="Identifier">otherwise</span>&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">flip</span>&nbsp;Bs&nbsp;X&nbsp;<span class="Comment">--0</span><br />
<br />
<br />
<br />
Finally, here is our new algorithm. The Tree which we use to search for<br />
previously-seen words is passed in the State monad, behind the scenes, <br />
with 'zipWithM', which in our case looks like:<br />
<br />
&nbsp;&nbsp;&nbsp;&nbsp;zipWithM :: (Bit -&gt; [Bit] -&gt; State Tree Bit) -&gt; <br />
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[Bit]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt; <br />
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[[Bit]]&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;-&gt; <br />
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;State Tree [Bit]<br />
<br />
The state monad is a little tricky sometimes:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;preferOpposite&nbsp;<span class="Statement">::</span>&nbsp;<span class="Type">Int</span>&nbsp;<span class="Statement">-&gt;</span>&nbsp;[&nbsp;Bit&nbsp;]<br />
<span class="Comment">&gt;</span>&nbsp;preferOpposite&nbsp;n&nbsp;<span class="Statement">=</span>&nbsp;<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- the whole bit sequence, except for the final 1:</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">let</span>&nbsp;bs&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">take</span>&nbsp;(<span class="Constant">2</span><span class="Statement">^</span>n<span class="Statement">-</span><span class="Constant">1</span>)&nbsp;(<span class="Identifier">replicate</span>&nbsp;n&nbsp;<span class="Constant">False</span>&nbsp;<span class="Statement">++</span>&nbsp;bs')<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- list of (n-1)-bit words:</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (wp0<span class="Statement">:</span>wordPrefixes)&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">map</span>&nbsp;(<span class="Identifier">take</span>&nbsp;(n<span class="Statement">-</span><span class="Constant">1</span>))&nbsp;(tails&nbsp;bs)<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- we know the first word is n 0's so we create our initial</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- tree from (n-1) 0's with a zero at the end:</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; state0&nbsp;<span class="Statement">=</span>&nbsp;treeWithFinal&nbsp;<span class="Constant">False</span>&nbsp;wp0<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- we zipWith a word with it's previous bit (so that we</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- can know which bit is the opposite) passing along the</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- Tree with help from the State monad:</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bsM' <span class="Statement">=</span>&nbsp;zipWithM&nbsp;thisBit&nbsp;(<span class="Constant">False</span><span class="Statement">:</span>bs')&nbsp;wordPrefixes<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bs' <span class="Statement">=</span>&nbsp;evalState&nbsp;bsM' state0<br />
<span class="Comment">&gt;</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- we place a 1 for the final bit:</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">in</span>&nbsp;bs&nbsp;<span class="Statement">++</span>&nbsp;[<span class="Constant">True</span>]<br />
<br />
If we wanted to be clever, we would have made the last line:<br />
<br />
&nbsp;&nbsp;&nbsp;&nbsp; in cycle (bs ++ [True])<br />
<br />
...as the sequence is actually cyclic.<br />
<br />
This helper function takes the previous bit and an n-1 bit word and returns <br />
a function :: Tree -&gt; (Bit,Tree), which takes the current search tree and<br />
checks the current word to see if the last bit of the word should be one<br />
or zero. The function :: Tree -&gt; (Bit,Tree) is wrapped in the State <br />
constructor, which is all you have to do to turn it into :: State Tree Bit<br />
<br />
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;<span class="Statement">::</span>&nbsp;Bit&nbsp;<span class="Statement">-&gt;</span>&nbsp;[&nbsp;Bit&nbsp;]&nbsp;<span class="Statement">-&gt;</span>&nbsp;State&nbsp;Tree&nbsp;Bit<br />
<br />
The wrapper function splits up the input tuple and tuples up the returned<br />
bit to make a proper St so that we can pass the last bit through the state<br />
monad.<br />
<br />
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;bP&nbsp;&nbsp; <span class="Statement">=</span>&nbsp;State&nbsp;<span class="Statement">.</span>&nbsp;thisBit'<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp; <span class="Type">where</span>&nbsp;bOpp&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">not</span>&nbsp;bP&nbsp;<br />
<br />
We start checking a word, moving down the tree:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; thisBit' (<span class="Constant">False</span><span class="Statement">:</span>bs)&nbsp;(Bs&nbsp;z&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;second&nbsp;(<span class="Identifier">flip</span>&nbsp;Bs&nbsp;o)&nbsp;(thisBit' bs&nbsp;z)<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; thisBit' (<span class="Constant">True</span><span class="Statement">:</span>bs)&nbsp;&nbsp;(Bs&nbsp;z&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;second&nbsp;(Bs&nbsp;z)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(thisBit' bs&nbsp;o)<br />
<br />
...or we walked off end of branch, so return opposite bit, and attach <br />
the rest of word to the tree:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; thisBit' bs&nbsp;X&nbsp;<span class="Statement">=</span>&nbsp;(bOpp,&nbsp;treeWithFinal&nbsp;bOpp&nbsp;bs)<br />
<br />
...or we reached the end of our word, so we prefer the opposite for the last <br />
bit, and check if it was seen:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; thisBit' []&nbsp;(Bs&nbsp;z&nbsp;o)&nbsp;<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;bOpp&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">=</span>&nbsp;<span class="Statement">case</span>&nbsp;o&nbsp;<span class="Statement">of</span>&nbsp;<span class="Comment">-- opposite bit is 1 (True)</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;X&nbsp;<span class="Statement">-&gt;</span>&nbsp;(bOpp,Bs&nbsp;z&nbsp;B)<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_&nbsp;<span class="Statement">-&gt;</span>&nbsp;(bP&nbsp;&nbsp;,Bs&nbsp;B&nbsp;B)<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;<span class="Identifier">otherwise</span>&nbsp;<span class="Statement">=</span>&nbsp;<span class="Statement">case</span>&nbsp;z&nbsp;<span class="Statement">of</span><br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;X&nbsp;<span class="Statement">-&gt;</span>&nbsp;(bOpp,Bs&nbsp;B&nbsp;o)<br />
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;_&nbsp;<span class="Statement">-&gt;</span>&nbsp;(bP&nbsp;&nbsp;,Bs&nbsp;B&nbsp;B)<br />
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br />
Finally, here are some functions to generate the actual sequences <br />
in 0s and 1s:<br />
<br />
<span class="Comment">&gt;</span>&nbsp;test&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">map</span>&nbsp;(<span class="Statement">\</span>x<span class="Statement">-&gt;</span><span class="Statement">if</span>&nbsp;x&nbsp;<span class="Statement">then</span>&nbsp;<span class="Constant">'1'</span>&nbsp;<span class="Statement">else</span>&nbsp;<span class="Constant">'0'</span>)&nbsp;<span class="Statement">.</span>&nbsp;preferOpposite&nbsp;<br />
<span class="Comment">&gt;</span><br />
<span class="Comment">&gt;</span>&nbsp;main&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">print</span>&nbsp;<span class="Statement">$</span>&nbsp;test&nbsp;<span class="Constant">10</span><br />
<br />
<br /></div></p>
]]></content:encoded>
			<wfw:commentRss>http://coder.bsimmons.name/blog/2009/12/debruijn-sequences-pt3-the-prefer-opposite-algorithm/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>The State Monad: a tutorial for the confused?</title>
		<link>http://coder.bsimmons.name/blog/2009/10/the-state-monad-a-tutorial-for-the-confused/</link>
		<comments>http://coder.bsimmons.name/blog/2009/10/the-state-monad-a-tutorial-for-the-confused/#comments</comments>
		<pubDate>Sat, 24 Oct 2009 00:16:57 +0000</pubDate>
		<dc:creator>jberryman</dc:creator>
				<category><![CDATA[haskell]]></category>
		<category><![CDATA[combinator]]></category>
		<category><![CDATA[monads]]></category>
		<category><![CDATA[state]]></category>
		<category><![CDATA[tutorial]]></category>

		<guid isPermaLink="false">http://coder.bsimmons.name/blog/?p=230</guid>
		<description><![CDATA[<p><em>I&#8217;ve written this <del>brief</del> tutorial on haskell&#8217;s <code>State</code> monad to help bridge some of the elusive gaps that I encountered in other explanations I&#8217;ve read, and to try to cut through all the sticky abstraction. This is written for someone</em>&#8230; <a href="http://coder.bsimmons.name/blog/2009/10/the-state-monad-a-tutorial-for-the-confused/" class="read_more">   [ R E A D &#124; M O R E ]</a></p>]]></description>
			<content:encoded><![CDATA[<p><em>I&#8217;ve written this <del>brief</del> tutorial on haskell&#8217;s <code>State</code> monad to help bridge some of the elusive gaps that I encountered in other explanations I&#8217;ve read, and to try to cut through all the sticky abstraction. This is written for someone who has a good understanding of the <code>Maybe</code> and <code>List</code> monads, but has gotten stuck trying to understand State. I hope it&#8217;s helpful!</em></p>
<h4>The Data Declaration:</h4>
<p>To understand a monad you look at it&#8217;s datatype and then at the definition for bind (<code>>>=</code>). Most monad tutorials start by showing you the data declaration of a <code>State s a</code> in passing, as if it needed no explanation:</p>
<p><blockquote class="vimblock"><br>
<span class="Type">newtype</span>&nbsp;State&nbsp;s&nbsp;a&nbsp;<span class="Statement">=</span>&nbsp;State&nbsp;{&nbsp;runState&nbsp;<span class="Statement">::</span>&nbsp;s&nbsp;<span class="Statement">-&gt;</span>&nbsp;(a,&nbsp;s)&nbsp;}<br>
<br></blockquote></p>
<p>But this <em>does</em> need explanation! This is crazy stuff and nothing like what we&#8217;ve seen before in the list monad or the Maybe monad:</p>
<ol>
<li>The constructor <code>State</code> <strong>holds a function</strong>, not just a simple value like Maybe&#8217;s <code>Just</code>. This looks weird.</li>
<li>Furthermore there is an accessor function <code>runState</code> <strong>with a weirdly imperative-sounding name</strong>.</li>
<li>Finally, there are <strong>two free variables</strong> on the left side, not just one.</li>
</ol>
<p>Yikes! Let&#8217;s try to get our head on straight and figure this out:</p>
<p>First of all the State monad is just <strong>an abstraction for a function that takes a state and returns an intermediate value and some new state value</strong>. To formalize this abstraction in haskell, we wrap the function in the newtype <code>State</code> allowing us to define a <code>Monad</code> instance.</p>
<p>Stepping back from the abstract and conceptual, what we have is <strong>the <code>State</code> constructor acting as a container for a function <code>:: s -> (a,s)</code></strong>, while the definition for bind just provides <strong>a mechanism for &#8220;composing&#8221; a function <code>state -> (val,state)</code> within the <code>State</code> wrapper</strong>.</p>
<p>Just as you can chain together functions using <code>(.)</code> as in <code>(+1) . (*3) . head :: (Num a) => [a] -> a</code>, <strong>the state monad gives you <code>(>>=)</code> to chain together functions that look essentially like <code>:: a -> s -> (a,s) </code>into a single function <code>:: s -> (a,s)</code></strong>.</p>
<p>Let&#8217;s bring the discussion back to actual code and try to make sure we understand those three points of weirdness outlined above. Here&#8217;s a stupid example of a function that can be &#8220;contained&#8221; in our state type:</p>
<p><blockquote class="vimblock"><br>
<span class="Comment">-- look at our counter and return &quot;foo&quot; or &quot;bar&quot;</span><br>
<span class="Comment">-- along with the incremented counter:</span><br>
fromStoAandS&nbsp;<span class="Statement">::</span>&nbsp;<span class="Type">Int</span>&nbsp;<span class="Statement">-&gt;</span>&nbsp;(<span class="Type">String</span>,<span class="Type">Int</span>)<br>
fromStoAandS&nbsp;c&nbsp;<span class="Statement">|</span>&nbsp;c&nbsp;<span class="Statement">`mod`</span>&nbsp;<span class="Constant">5</span>&nbsp;<span class="Statement">==</span>&nbsp;<span class="Constant">0</span>&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Constant">&quot;foo&quot;</span>,c<span class="Statement">+</span><span class="Constant">1</span>)<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;<span class="Identifier">otherwise</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Constant">&quot;bar&quot;</span>,c<span class="Statement">+</span><span class="Constant">1</span>)<br>
<br></blockquote></p>
<p>If we just wrap that in a <code>State</code> constructor, we&#8217;re in the State monad:</p>
<p><blockquote class="vimblock"><br>
stateIntString&nbsp;<span class="Statement">::</span>&nbsp;State&nbsp;<span class="Type">Int</span>&nbsp;<span class="Type">String</span><br>
stateIntString&nbsp;<span class="Statement">=</span>&nbsp;State&nbsp;fromStoAandS<br>
<br></blockquote></p>
<p>But what about <code>runState</code>? <strong>All that does of course is give us the &#8220;contents&#8221; of our State constructor: i.e. a single function <code>:: s -> (a,s)</code></strong>. It could have been named <code>stateFunction</code> but someone thought it would be really clever to be able to write things like:</p>
<p><blockquote class="vimblock"><br>
runState&nbsp;stateIntString&nbsp;<span class="Constant">1</span><br>
<br></blockquote></p>
<p>See, all we&#8217;ve done there is used <code>runState</code> to take our function (<code>fromStoAandS</code>) out of the State wrapper; it is then applied it to it&#8217;s initial state (<code>1</code>). We would do this <code>runState</code> business <strong>after building up our composed function with <code>(>>=)</code>, <code>mapM</code>, etc</strong>.</p>
<p>That leaves point 3 unanswered. Let&#8217;s start exploring the instance declaration for State.</p>
<h4>The Instance Declaration</h4>
<p>We&#8217;ll start with the first line:</p>
<p><blockquote class="vimblock"><br>
<span class="Type">instance</span>&nbsp;<span class="Type">Monad</span>&nbsp;(State&nbsp;s)&nbsp;<span class="Type">where</span><br>
<br></blockquote></p>
<p><strong>We create a Monad instance for (State s) not State</strong>. You can think of this as a <strong>partially-applied type</strong>, which is equivalent to a partially applied function: </p>
<blockquote><p><code>(State) <==> (+)</code><br />
<code>(State s) <==> (1+)</code><br />
<code>(State s a) <== (1+2)</code></p></blockquote>
<p><strong>So (<code>State s</code>) is the <code>m</code> in our <code>m a</code>.</strong> This means the <em>type</em> of our state will remain the same as we compose our function with <code>(>>=)</code>, whereas the intermediate values (the <code>a</code>s) may well change type as they move through the chain.</p>
<p>Before we move on to the meat of the instance declaration, I'd like to get your mind calibrated to look at the definitions for <code>return</code> and <code>(>>=)</code>:</p>
<p>Whenever you see <code>m a</code>, as in </p>
<blockquote><p><code>return :: (Monad m) => a -> m a</code> </p></blockquote>
<p>...remember that <code>m a</code> is actually </p>
<blockquote><p><code>State s a</code></p></blockquote>
<p>...and when you remember <code>(State s a)</code>, <em>think</em> </p>
<blockquote><p><code>(s -> (s,a))</code>. </p></blockquote>
<p><strong>So in your mind, <code>m a</code> becomes <code>function :: s -> (a,s)</code> everywhere you see it</strong>. Just forget about the silly State wrapper (<a href="http://www.haskell.org/haskellwiki/Newtype">the compiler does</a>)!</p>
<h4>The definition of return and Bind</h4>
<p>Let's wet out feet with the definition for <code>return</code>:</p>
<p><blockquote class="vimblock"><br>
&nbsp;&nbsp;&nbsp;&nbsp;<span class="Identifier">return</span>&nbsp;a&nbsp;<span class="Statement">=</span>&nbsp;State&nbsp;<span class="Statement">$</span>&nbsp;<span class="Statement">\</span>s&nbsp;<span class="Statement">-&gt;</span>&nbsp;(a,&nbsp;s)<br>
<br></blockquote></p>
<p>All return does is take some value a and make a function that takes a state value and returns (value, state value). If we ignore the whole State wrapping business, then return is just <code>(,) :: a -> b -> (a, b)</code></p>
<p>Now recall the definition of bind:</p>
<p><blockquote class="vimblock"><br>
(<span class="Statement">&gt;&gt;=</span>)&nbsp;<span class="Statement">::</span>&nbsp;(<span class="Type">Monad</span>&nbsp;m)&nbsp;<span class="Statement">=&gt;</span>&nbsp;m&nbsp;a&nbsp;<span class="Statement">-&gt;</span>&nbsp;(a&nbsp;<span class="Statement">-&gt;</span>&nbsp;m&nbsp;b)&nbsp;<span class="Statement">-&gt;</span>&nbsp;m&nbsp;b<br>
<br></blockquote></p>
<p>Which in our case is:</p>
<p><blockquote class="vimblock"><br>
(<span class="Statement">&gt;&gt;=</span>)&nbsp;<span class="Statement">::</span>&nbsp;&nbsp;State&nbsp;s&nbsp;a&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">-&gt;</span>&nbsp;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(a&nbsp;<span class="Statement">-&gt;</span>&nbsp;State&nbsp;s&nbsp;b)&nbsp;<span class="Statement">-&gt;</span>&nbsp;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;State&nbsp;s&nbsp;b<br>
<br></blockquote></p>
<p>And which is just a silly abstraction for the <strong>super special function composition</strong> that's going on, which looks like:</p>
<p><blockquote class="vimblock"><br>
(<span class="Statement">&gt;&gt;=</span>)&nbsp;<span class="Statement">::</span>&nbsp;&nbsp;(s&nbsp;<span class="Statement">-&gt;</span>&nbsp;(a,s))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">-&gt;</span>&nbsp;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(a&nbsp;<span class="Statement">-&gt;</span>&nbsp;s&nbsp;<span class="Statement">-&gt;</span>&nbsp;(a,s))&nbsp;&nbsp;<span class="Statement">-&gt;</span>&nbsp;<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(s&nbsp;<span class="Statement">-&gt;</span>&nbsp;(b,s))<br>
<br></blockquote></p>
<p>So on the left hand side of (<code>>>=</code>) is a function that takes some initial state and produces a <code>(value,new_state)</code>. On the right hand side is a function that takes that value and that new_state and generates it's own <code>(new_value, newer_state)</code>. <strong>The job of bind is simply to combine those two functions into one bigger function from the initial state to <code>(new_value,newer_state)</code></strong>, just like the simple function composition operator<code> (.) :: (b -> c) -> (a -> b) -> a -> c</code></p>
<p>At this point, we can show you bind's definition:</p>
<p><blockquote class="vimblock"><br>
&nbsp;&nbsp;&nbsp;&nbsp;m&nbsp;<span class="Statement">&gt;&gt;=</span>&nbsp;k&nbsp;&nbsp;<span class="Statement">=</span>&nbsp;State&nbsp;<span class="Statement">$</span>&nbsp;<span class="Statement">\</span>s&nbsp;<span class="Statement">-&gt;</span>&nbsp;<span class="Statement">let</span><br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(a,&nbsp;s')&nbsp;<span class="Statement">=</span>&nbsp;runState&nbsp;m&nbsp;s<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">in</span>&nbsp;runState&nbsp;(k&nbsp;a)&nbsp;s'<br>
<br></blockquote></p>
<p>You can work through that on your own, keeping in mind that we're doing function composition here. The main thing to remember is that the <code>s</code> at the top, right after <code>State</code>, <strong>won't actually be bound to a value until we unwrap the function with <code>runState</code> and pass it the initial state value</strong>, at which point we can evaluate the entire chain.</p>
<h4>A Final Note About The State Monad with <code>do</code> Notation</h4>
<p><code>State</code> is often used like this:</p>
<p><blockquote class="vimblock"><br>
stateFunction&nbsp;<span class="Statement">::</span>&nbsp;State&nbsp;[a]&nbsp;()<br>
stateFunction&nbsp;<span class="Statement">=</span>&nbsp;<span class="Statement">do</span>&nbsp;x&nbsp;<span class="Statement">&lt;-</span>&nbsp;pop<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pop<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; push&nbsp;x<br>
<br></blockquote></p>
<p>Remember that the functions above are desugaring to <code>m >>= \a-> f... </code>or if there is no left arrow on the previous line: <code>m >>= \_-> f...</code> That <code>a</code> in there is an intermediate value, the <code>fst</code> in the tuple. The push function might look like:</p>
<p><blockquote class="vimblock"><br>
push&nbsp;<span class="Statement">::</span>&nbsp;State&nbsp;[a]&nbsp;()<br>
push&nbsp;a&nbsp;<span class="Statement">=</span>&nbsp;State&nbsp;<span class="Statement">$</span>&nbsp;<span class="Statement">\</span>as&nbsp;<span class="Statement">-&gt;</span>&nbsp;(()&nbsp;,&nbsp;a<span class="Statement">:</span>as)<br>
<br></blockquote></p>
<p>The function doesn't return any meaningful <code>a</code> value, so we don't bind it by using the <code><-</code>. For more work with do notation and some fine pictures, see <a href="http://forums.somethingawful.com/showthread.php?threadid=2841145&#038;pagenumber=6#post346173552">Bonus's post on something awful</a>.</p>
]]></content:encoded>
			<wfw:commentRss>http://coder.bsimmons.name/blog/2009/10/the-state-monad-a-tutorial-for-the-confused/feed/</wfw:commentRss>
		<slash:comments>3</slash:comments>
		</item>
		<item>
		<title>Cracking a Lock in Haskell with the De Bruijn sequence, pt. 2</title>
		<link>http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-2/</link>
		<comments>http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-2/#comments</comments>
		<pubDate>Tue, 29 Sep 2009 22:10:58 +0000</pubDate>
		<dc:creator>jberryman</dc:creator>
				<category><![CDATA[haskell]]></category>
		<category><![CDATA[algorithm]]></category>
		<category><![CDATA[data]]></category>
		<category><![CDATA[library]]></category>
		<category><![CDATA[monads]]></category>
		<category><![CDATA[sequences]]></category>
		<category><![CDATA[Tree]]></category>

		<guid isPermaLink="false">http://coder.bsimmons.name/blog/?p=221</guid>
		<description><![CDATA[<p>For this post I will rework the <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-1/">Prefer One algorithm from<br />
the previous post</a> so that it is much more efficient. We will<br />
add words to a <a href="http://en.wikipedia.org/wiki/Patricia_tree">Patricia Tree</a>-like dictionary as we see them,<br />
passing&#8230; <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-2/" class="read_more">   [ R E A D &#124; M O R E ]</a></p>]]></description>
			<content:encoded><![CDATA[<p>For this post I will rework the <a href="http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-1/">Prefer One algorithm from<br />
the previous post</a> so that it is much more efficient. We will<br />
add words to a <a href="http://en.wikipedia.org/wiki/Patricia_tree">Patricia Tree</a>-like dictionary as we see them,<br />
passing the tree along in the State monad; to check if a new<br />
word has been seen we simply check in the tree, rather than<br />
in the array.</p>
<p>First, a little boilerplate&#8230;</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;<span class="Type">module</span>&nbsp;Main<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">where</span><br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Data.Array<br>
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Data.List(isInfixOf, tails)<br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Control.Monad.State<br>
<span class="Comment">&gt;</span>&nbsp;<span class="PreProc">import</span>&nbsp;Control.Arrow<br>
<br></div></p>
<h3>NEW IMPLEMENTATION:</h3>
<p>&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;-</p>
<p>In the previous implementation, to check if the word formed<br />
by adding a one has been seen, we had to iterate through each<br />
of the previous bits in the array, checking words.</p>
<p>For example for words of length 3, finding the 7th bit (?)<br />
by checking if 111 has already been seen:</p>
<pre>
        /-----\  ==>  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)
</pre>
<p>This is extremely inefficient. What we want is to be able to<br />
store all the previous words that we&#8217;ve encountered in an easily-<br />
searchable data structure. </p>
<p>In the example above, we would like the three words that we&#8217;ve<br />
seen to be stored in what might be called a Trie, so that our<br />
search instead looks like the following:</p>
<pre>
       /\
      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
</pre>
<p>Our new data structure will look like this:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;<span class="Type">data</span>&nbsp;Tree&nbsp;<span class="Statement">=</span>&nbsp;Bs&nbsp;Tree&nbsp;Tree&nbsp;&nbsp;<span class="Comment">-- Bs (zero_bit) (one_bit)</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;X&nbsp;<span class="Comment">-- incomplete word</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">|</span>&nbsp;B&nbsp;<span class="Comment">-- final bit of word</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">deriving</span>&nbsp;<span class="Type">Show</span><br>
<br></div></p>
<p>We&#8217;ll need to build a new tree from a list of bits, appending<br />
a final bit (1, except for the initial tree):</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;treeWithFinal1&nbsp;<span class="Statement">=</span>&nbsp;mkTree&nbsp;<span class="Constant">True</span><br>
<span class="Comment">&gt;</span>&nbsp;treeWithFinal0&nbsp;<span class="Statement">=</span>&nbsp;mkTree&nbsp;<span class="Constant">False</span><br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span>&nbsp;mkTree&nbsp;<span class="Statement">::</span>&nbsp;Bit&nbsp;<span class="Statement">-&gt;</span>&nbsp;[Bit]&nbsp;<span class="Statement">-&gt;</span>&nbsp;Tree<br>
<span class="Comment">&gt;</span>&nbsp;mkTree&nbsp;p&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">foldr</span>&nbsp;mkBranch&nbsp;(<span class="Statement">if</span>&nbsp;p&nbsp;<span class="Statement">then</span>&nbsp;Bs&nbsp;X&nbsp;B&nbsp;<span class="Statement">else</span>&nbsp;Bs&nbsp;B&nbsp;X)&nbsp;&nbsp; <br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">where</span>&nbsp;mkBranch&nbsp;b&nbsp;<span class="Statement">|</span>&nbsp;b&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">=</span>&nbsp;Bs&nbsp;X&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Comment">--1</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">|</span>&nbsp;<span class="Identifier">otherwise</span>&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">flip</span>&nbsp;Bs&nbsp;X&nbsp;<span class="Comment">--0</span><br>
<br>
<br></div></p>
<p>Finally, here is our new algorithm. The tree is passed in the<br />
State monad, through the use of mapM. The state monad is a little<br />
tricky sometimes:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;preferOneV2&nbsp;<span class="Statement">::</span>&nbsp;<span class="Type">Int</span>&nbsp;<span class="Statement">-&gt;</span>&nbsp;[&nbsp;Bit&nbsp;]<br>
<span class="Comment">&gt;</span>&nbsp;preferOneV2&nbsp;n&nbsp;<span class="Statement">=</span>&nbsp;<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">let</span>&nbsp;upB&nbsp;<span class="Statement">=</span>&nbsp;<span class="Constant">2</span><span class="Statement">^</span>n<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- the whole bit sequence (one period):</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bs&nbsp;<span class="Statement">=</span>&nbsp;&nbsp;<span class="Identifier">take</span>&nbsp;upB&nbsp;(<span class="Identifier">replicate</span>&nbsp;n&nbsp;<span class="Constant">False</span>&nbsp;<span class="Statement">++</span>&nbsp;bs')<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (wp0<span class="Statement">:</span>wordPrefixes)&nbsp;<span class="Statement">=</span>&nbsp;[&nbsp;<span class="Identifier">take</span>&nbsp;(n<span class="Statement">-</span><span class="Constant">1</span>)&nbsp;w&nbsp;<span class="Statement">|</span>&nbsp;w&nbsp;<span class="Statement">&lt;-</span>&nbsp;tails&nbsp;bs&nbsp;]<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- pass our Tree around in the State monad</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; state0&nbsp;<span class="Statement">=</span>&nbsp;treeWithFinal0&nbsp;wp0<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- thisBit is partially applied, after which we wrap the</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- function in a State constructor to make our :: m a</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bsM'&nbsp;&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">mapM</span>&nbsp;(State&nbsp;<span class="Statement">.</span>&nbsp;thisBit)&nbsp;wordPrefixes<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (bs',tree)&nbsp;<span class="Statement">=</span>&nbsp;runState&nbsp;bsM' state0<br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- an infinite stream is returned... because I can:&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">in</span>&nbsp;<span class="Identifier">cycle</span>&nbsp;bs<br>
<br>
<br></div></p>
<p>With the following function, after we apply it to the word we&#8217;re searching<br />
for, it becomes a function :: state -> (val,state), suitable for the<br />
State monad:</p>
<p>Takes a list of the last n-1 Bits (Bools) and traverses a Tree which we&#8217;ve<br />
been using to keep track of the words we&#8217;ve already seen. We fold the Bit<br />
list into the tree. When we get to the endo of the list, we look for a One.<br />
We return the new bit as well as the new Tree:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;<span class="Statement">::</span>&nbsp;[&nbsp;Bit&nbsp;]&nbsp;<span class="Statement">-&gt;</span>&nbsp;Tree&nbsp;<span class="Statement">-&gt;</span>&nbsp;(Bit,&nbsp;Tree)<br>
<br></div></p>
<p>We&#8217;re at a Zero bit,</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;(<span class="Constant">False</span><span class="Statement">:</span>bs)&nbsp;(Bs&nbsp;X&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Constant">True</span>,&nbsp;Bs&nbsp;(treeWithFinal1&nbsp;bs)&nbsp;o)&nbsp;<span class="Comment">-- last bit must be 1</span><br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;(<span class="Constant">False</span><span class="Statement">:</span>bs)&nbsp;(Bs&nbsp;z&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Identifier">id</span>&nbsp;<span class="Statement">***</span>&nbsp;<span class="Identifier">flip</span>&nbsp;Bs&nbsp;o)&nbsp;(thisBit&nbsp;bs&nbsp;z)<br>
<br></div></p>
<p>&#8230;a One bit,</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;(<span class="Constant">True</span><span class="Statement">:</span>bs)&nbsp;(Bs&nbsp;z&nbsp;X)&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Constant">True</span>,&nbsp;Bs&nbsp;z&nbsp;(treeWithFinal1&nbsp;bs))&nbsp;<br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;(<span class="Constant">True</span><span class="Statement">:</span>bs)&nbsp;(Bs&nbsp;z&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;(<span class="Identifier">id</span>&nbsp;<span class="Statement">***</span>&nbsp;Bs&nbsp;z)&nbsp;(thisBit&nbsp;bs&nbsp;o)<br>
<br></div></p>
<p>&#8230;or else propose a One for the last bit:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;thisBit&nbsp;[]&nbsp;(Bs&nbsp;_&nbsp;o)&nbsp;<span class="Statement">=</span>&nbsp;(b&nbsp;,&nbsp;(Bs&nbsp;z&nbsp;B))&nbsp;<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- we know that if the One bit has been seen (B) then we must</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- place a zero. we assume then that the Zero bit is (X):</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; <span class="Type">where</span>&nbsp;(b,&nbsp;z)&nbsp;<span class="Statement">=</span>&nbsp;<span class="Statement">case</span>&nbsp;o&nbsp;<span class="Statement">of</span>&nbsp;<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- this bit = 1, Zero branch = nil</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; X&nbsp;<span class="Statement">-&gt;</span>&nbsp;(<span class="Constant">True</span>,&nbsp;&nbsp;X)&nbsp;<span class="Comment">-- 1</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Comment">-- this bit = 0, Zero branch = last word bit</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; _&nbsp;<span class="Statement">-&gt;</span>&nbsp;(<span class="Constant">False</span>,&nbsp;B)&nbsp;<span class="Comment">-- 0</span><br>
<br>
<br></div></p>
<h3>TEST FUNCTIONS:</h3>
<p>&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;-</p>
<p>This code is copied from the previous post:</p>
<p>We use Bool for bits, where False ==> 0, True ==> 1:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;<span class="Type">type</span>&nbsp;Bit&nbsp;<span class="Statement">=</span>&nbsp;<span class="Type">Bool</span><br>
<br></div></p>
<p>Our garage-door lock model for testing the function:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;<span class="Type">type</span>&nbsp;Combo&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">=</span>&nbsp;[&nbsp;Bit&nbsp;]<br>
<span class="Comment">&gt;</span>&nbsp;<span class="Type">type</span>&nbsp;Receiver&nbsp;<span class="Statement">=</span>&nbsp;Combo&nbsp;<span class="Statement">-&gt;</span>&nbsp;<span class="Type">Bool</span><br>
<br></div></p>
<p>True means access granted:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;programReceiver&nbsp;<span class="Statement">::</span>&nbsp;Combo&nbsp;<span class="Statement">-&gt;</span>&nbsp;Receiver<br>
<span class="Comment">&gt;</span>&nbsp;programReceiver&nbsp;<span class="Statement">=</span>&nbsp;isInfixOf&nbsp;<br>
<br></div></p>
<p>Test out our function:</p>
<p><div class="vimblock"><br>
<span class="Comment">&gt;</span>&nbsp;main&nbsp;<span class="Statement">=</span>&nbsp;&nbsp;<span class="Statement">let</span>&nbsp;secretCode&nbsp;<span class="Statement">=</span>&nbsp;[<span class="Constant">True</span>,<span class="Constant">True</span>,<span class="Constant">False</span>,<span class="Constant">False</span>,<span class="Constant">True</span>,<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Constant">False</span>,<span class="Constant">True</span>,<span class="Constant">False</span>,<span class="Constant">True</span>,<span class="Constant">True</span>]<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; receiver&nbsp;<span class="Statement">=</span>&nbsp;programReceiver&nbsp;secretCode<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; crackingStream&nbsp;<span class="Statement">=</span>&nbsp;preferOneV2&nbsp;<span class="Constant">10</span><br>
<span class="Comment">&gt;</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Statement">in</span>&nbsp;<span class="Statement">if</span>&nbsp;receiver&nbsp;crackingStream<br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">then</span>&nbsp;<span class="Identifier">print</span>&nbsp;<span class="Constant">&quot;WE'RE IN!&quot;</span><br>
<span class="Comment">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span class="Statement">else</span>&nbsp;<span class="Identifier">print</span>&nbsp;<span class="Constant">&quot;...bugs&quot;</span><br>
<span class="Comment">&gt;</span><br>
<br></div></p>
<p>Stay tuned for one more post on these algorithms.</p>
]]></content:encoded>
			<wfw:commentRss>http://coder.bsimmons.name/blog/2009/09/cracking-a-lock-in-haskell-with-the-de-bruijn-sequence-pt-2/feed/</wfw:commentRss>
		<slash:comments>2</slash:comments>
		</item>
		<item>
		<title>Enumerating all n-integer Sets Which Sum to an Integer x</title>
		<link>http://coder.bsimmons.name/blog/2009/07/enumerating-all-n-integer-sets-which-sum-to-an-integer-x/</link>
		<comments>http://coder.bsimmons.name/blog/2009/07/enumerating-all-n-integer-sets-which-sum-to-an-integer-x/#comments</comments>
		<pubDate>Thu, 30 Jul 2009 01:27:34 +0000</pubDate>
		<dc:creator>jberryman</dc:creator>
				<category><![CDATA[haskell]]></category>
		<category><![CDATA[algorithm]]></category>
		<category><![CDATA[monads]]></category>
		<category><![CDATA[recursion]]></category>
		<category><![CDATA[short]]></category>

		<guid isPermaLink="false">http://coder.bsimmons.name/blog/?p=199</guid>
		<description><![CDATA[<p>I came up with what I think is an elegant use of monadic code, while working on a program to compute solutions to the <a href="http://en.wikipedia.org/wiki/Postage_stamp_problem">Postage Stamp Problem</a>. The problem asks: </p>
<blockquote><p><em>Consider that an envelope is able to hold</em></p></blockquote><p>&#8230; <a href="http://coder.bsimmons.name/blog/2009/07/enumerating-all-n-integer-sets-which-sum-to-an-integer-x/" class="read_more">   [ R E A D &#124; M O R E ]</a></p>]]></description>
			<content:encoded><![CDATA[<p>I came up with what I think is an elegant use of monadic code, while working on a program to compute solutions to the <a href="http://en.wikipedia.org/wiki/Postage_stamp_problem">Postage Stamp Problem</a>. The problem asks: </p>
<blockquote><p><em>Consider that an envelope is able to hold a limited number of postage stamps. Then, consider the set of the values of the stamps &#8212; positive integers only. Then, what is the smallest total postage which *cannot* be put onto the envelope?</em></p></blockquote>
<p>The algorithm below takes a <em>number of stamps that can fit</em> and a <em>total postage to apply</em> and returns a list of all the sets of different stamp values that can be combined to form the target postage sum:</p>
<p><div class="vimblock"><br>
<span class="Statement">&gt;</span>&nbsp;sumLists&nbsp;<span class="Statement">::</span>&nbsp;<span class="Type">Int</span>&nbsp;<span class="Statement">-&gt;</span>&nbsp;<span class="Type">Int</span>&nbsp;<span class="Statement">-&gt;</span>&nbsp;[[<span class="Type">Int</span>]]<br>
<span class="Statement">&gt;</span>&nbsp;sumLists&nbsp;<span class="Statement">=</span>&nbsp;f&nbsp;<span class="Constant">0</span>&nbsp;<span class="Type">where</span><br>
<span class="Statement">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; f&nbsp;_&nbsp;<span class="Constant">1</span>&nbsp;n&nbsp;<span class="Statement">=</span>&nbsp;<span class="Identifier">return</span>&nbsp;[n]&nbsp;&nbsp;<br>
<span class="Statement">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp; f&nbsp;i&nbsp;c&nbsp;n&nbsp;<span class="Statement">=</span>&nbsp;<span class="Statement">do</span>&nbsp;a&nbsp;&nbsp;<span class="Statement">&lt;-</span>&nbsp;[i<span class="Statement">..</span>&nbsp;<span class="Identifier">div</span>&nbsp;n&nbsp;c]&nbsp;<br>
<span class="Statement">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;as&nbsp;<span class="Statement">&lt;-</span>&nbsp;f&nbsp;(i<span class="Statement">+</span>a)&nbsp;(c<span class="Statement">-</span><span class="Constant">1</span>)&nbsp;(n<span class="Statement">-</span>a)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br>
<span class="Statement">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Identifier">return</span>&nbsp;(a&nbsp;<span class="Statement">:</span>&nbsp;as)&nbsp;<br>
<br></div></p>
<p>Thus the potential stamp combinations for a letter which can hold three stamps and costing 5 cents to mail would be:</p>
<blockquote><p>*Main> sumLists 3 5<br />
[[0,0,5],[0,1,4],[0,2,3],[1,1,3],[1,2,2]]</p></blockquote>
<p>As you can see, the algorithm also produces ordered lists naturally! </p>
<p>But perhaps all we care about are unique stamp values that. If we want to adjust our goal such that the algorithm returns <em>a list of all sets of unique stamp values sufficient to create the target postage</em>, we need only adjust the <code>return</code> line:</p>
<p><blockquote class="vimblock"><br>
<span class="Statement">&gt;</span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="Identifier">return</span>&nbsp;(a&nbsp;<span class="Statement">:</span>&nbsp;<span class="Identifier">dropWhile</span>&nbsp;(<span class="Statement">==</span>a)&nbsp;as)&nbsp;<br>
<br></blockquote></p>
<p>Similarly we could drop the zeros (which mean &#8220;no stamp&#8221; in our case) from the beginnings of each set if we desired. The above code have applications to many similar problems including <a href="http://en.wikipedia.org/wiki/Subset_sum">Subset Sum</a>, and <a href="http://en.wikipedia.org/wiki/Knapsack_problem">Knapsack</a> as well as other partitioning problems.</p>
]]></content:encoded>
			<wfw:commentRss>http://coder.bsimmons.name/blog/2009/07/enumerating-all-n-integer-sets-which-sum-to-an-integer-x/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
	</channel>
</rss>
