Twan van Laarhoven's blog http://twanvl.nl/blog 2017-04-06T11:15:47Z Twan van Laarhoven blog@twanvl.nl A type theory based on indexed equality - Implementation http://twanvl.nl/blog/hott/indexed-equality-implementation 2017-04-06T11:15:47Z <p>In this post I would like to present the type theory I have been working on, where the usual equality is replaced by an equality type indexed by the homotopy interval. This results in ideas very similar to those from the <a href="https://www.math.ias.edu/~amortberg/papers/cubicaltt.pdf">cubical</a> system. I have a prototype implementation of this system in Haskell, which you can find on <a href="https://github.com/twanvl/ttie">github</a>. The system is unimaginatively called TTIE, a type theory with indexed equality. In this post I will focus on the introducing the type system and its implementation. I save the technical details for another post. </p><p>To recap: I have <a href="blog/hott/dependent-equality-with-the-interval">previously written about</a> the 'indexed equality' type. The idea is that if we have the homotopy interval type with two points and a path between them, </p><pre class="agda"><span class="comment">-- Pseudo Agda notation</span> <span class="keyword">data</span> <span class="conid">Interval</span> <span class="keyglyph">:</span> <span class="conid">Type</span> <span class="keyword">where</span> <span class="num">0</span> <span class="keyglyph">:</span> <span class="conid">Interval</span> <span class="num">1</span> <span class="keyglyph">:</span> <span class="conid">Interval</span> <span class="num">01</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> <span class="keyglyph">_</span> <span class="num">0</span> <span class="num">1</span> </pre><p>then we can then define a type of equality, 'indexed' by the interval: </p><pre class="agda"><span class="keyword">data</span> <span class="agda-fun">Eq</span> (A <span class="keyglyph">:</span> <span class="conid">Interval</span> <span class="keyglyph">→</span> <span class="conid">Type</span>) <span class="keyglyph">:</span> A <span class="num">0</span> <span class="keyglyph">→</span> A <span class="num">1</span> <span class="keyglyph">→</span> <span class="conid">Type</span> <span class="keyword">where</span> <span class="agda-fun">refl</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">Interval</span>) <span class="keyglyph">→</span> A <span class="varid">i</span>) <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> A (<span class="varid">x</span> <span class="num">0</span>) (<span class="varid">x</span> <span class="num">1</span>) </pre><p>Rather than using lambdas all the time in the argument of <tt><span class="agda-fun">Eq</span></tt> and <tt><span class="agda-fun">refl</span></tt>, in TTIE I write the bound variable in a subscript. So <tt class='complex'><span class="agda-fun">refl</span><sub>i</sub> (<span class="varid">x</span> <span class="varid">i</span>)</tt> means <tt class='complex'><span class="agda-fun">refl</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">i</span>)</tt> and <tt class='complex'><span class="conid">Eq</span><sub>i</sub> (A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span></tt> means <tt class='complex'><span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span></tt>. If we represent all paths with this indexed equality type, then we can actually take <tt class='complex'><span class="num">01</span> <span class="keyglyph">=</span> <span class="agda-fun">refl</span><sub>i</sub> <span class="varid">i</span></tt>. </p><p>Now the (dependent) eliminator for the interval is </p><pre class="agda"><span class="agda-fun">iv</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A} <span class="keyglyph">→</span> {<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="num">0</span>} <span class="keyglyph">→</span> {<span class="varid">y</span> <span class="keyglyph">:</span> A <span class="num">1</span>} <span class="keyglyph">→</span> (<span class="varid">xy</span> <span class="keyglyph">:</span> <span class="conid">Eq</span><sub>i</sub> (A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">Interval</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-fun">iv</span> {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="varid">x</span> <span class="agda-fun">iv</span> {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> <span class="num">1</span> <span class="keyglyph">=</span> <span class="varid">y</span> <span class="agda-fun">iv</span> {A} {<span class="varid">x</span>} {<span class="varid">y</span>} (<span class="agda-fun">refl</span><sub>i</sub> (<span class="varid">xy</span> <span class="varid">i</span>)) <span class="varid">i</span> <span class="keyglyph">=</span> <span class="varid">xy</span> <span class="varid">i</span> <span class="agda-fun">refl</span><sub>i</sub> (<span class="agda-fun">iv</span> {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> <span class="varid">i</span>) <span class="keyglyph">=</span> <span class="varid">xy</span> </pre><p>For readability, I write <tt class='complex'><span class="agda-fun">iv</span> <span class="varid">xy</span> <span class="varid">i</span></tt> as <tt class='complex'>xy<sup>i</sup></tt>. This combination already makes it possible to prove, for instance, congruence of functions without needing to use substitution (the J rule): </p><pre class="agda"><span class="agda-fun">cong</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A B <span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> (<span class="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) <span class="keyglyph">→</span> <span class="conid">Eq</span><sub>i</sub> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Eq</span><sub>i</sub> B (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">y</span>) <span class="agda-fun">cong</span> <span class="varid">f</span> <span class="varid">xy</span> <span class="keyglyph">=</span> <span class="agda-fun">refl</span><sub>i</sub> (<span class="varid">f</span> xy<sup>i</sup>) </pre><p>this can be generalized to dependent types </p><pre class="agda"><span class="agda-fun">cong</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A B <span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> (<span class="varid">f</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> B <span class="varid">x</span>) <span class="keyglyph">→</span> (<span class="varid">xy</span> <span class="keyglyph">:</span> <span class="conid">Eq</span><sub>i</sub> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="conid">Eq</span><sub>i</sub> (B xy<sup>i</sup>) (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">y</span>) <span class="agda-fun">cong</span> <span class="varid">f</span> <span class="varid">xy</span> <span class="keyglyph">=</span> <span class="agda-fun">refl</span><sub>i</sub> (<span class="varid">f</span> xy<sup>i</sup>) </pre><p>And we also get extensionality up to eta equality: </p><pre class="agda"><span class="varid">ext</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A B <span class="varid">f</span> <span class="varid">g</span>} <span class="keyglyph">→</span> ((<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="conid">Eq</span><sub>i</sub> (B <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">x</span>)) <span class="keyglyph">→</span> <span class="conid">Eq</span><sub>i</sub> ((<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> B <span class="varid">x</span>) (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varid">x</span>) (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">g</span> <span class="varid">x</span>) <span class="varid">ext</span> <span class="varid">fg</span> <span class="keyglyph">=</span> <span class="agda-fun">refl</span><sub>i</sub> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> (<span class="varid">fg</span> <span class="varid">x</span>)<sup>i</sup>) </pre><p>So far, however, we can not yet represent general substitution. I have found that the most convenient primitive is </p><pre class="agda"><span class="agda-fun">cast</span> <span class="keyglyph">:</span> (A <span class="keyglyph">:</span> I <span class="keyglyph">→</span> <span class="conid">Type</span>) <span class="keyglyph">→</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">Interval</span>) <span class="keyglyph">→</span> (<span class="varid">j</span> <span class="keyglyph">:</span> <span class="conid">Interval</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">j</span> </pre><p>where <tt class='complex'><span class="agda-fun">cast</span><sub>i</sub> A <span class="num">0</span> <span class="num">0</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">x</span></tt> and <tt class='complex'><span class="agda-fun">cast</span><sub>i</sub> A <span class="num">1</span> <span class="num">1</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">x</span></tt>. </p><p>This generalized cast makes all kinds of proofs really convenient. For instance, we would like that <tt class='complex'><span class="agda-fun">cast</span> A <span class="num">1</span> <span class="num">0</span> <span class="varop">∘</span> <span class="agda-fun">cast</span> A <span class="num">0</span> <span class="num">1</span> <span class="keyglyph">=</span> <span class="varid">id</span></tt>. But it is already the case that <tt class='complex'><span class="agda-fun">cast</span> A <span class="num">0</span> <span class="num">0</span> <span class="varop">∘</span> <span class="agda-fun">cast</span> A <span class="num">0</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="varid">id</span></tt>. So we just have to change some of those 0s to 1s, </p><pre class="agda"><span class="varid">lemma</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A <span class="keyglyph">:</span> <span class="conid">Type</span>} {<span class="varid">x</span>} <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> <span class="keyglyph">_</span> (<span class="agda-fun">cast</span><sub>i</sub> A <span class="num">1</span> <span class="num">0</span> (<span class="agda-fun">cast</span><sub>i</sub> A <span class="num">0</span> <span class="num">1</span> <span class="varid">x</span>)) <span class="varid">x</span> <span class="varid">lemma</span> {A} {<span class="varid">x</span>} <span class="keyglyph">=</span> <span class="agda-fun">cast</span><sub>j</sub> (<span class="agda-fun">Eq</span> <span class="keyglyph">_</span> (<span class="agda-fun">cast</span><sub>i</sub> A <span class="varid">j</span> <span class="num">0</span> (<span class="agda-fun">cast</span><sub>i</sub> A <span class="num">0</span> <span class="varid">j</span> <span class="varid">x</span>)) <span class="varid">x</span>) <span class="num">0</span> <span class="num">1</span> (<span class="agda-fun">refl</span><sub>i</sub> <span class="varid">x</span>) </pre><p>As another example, most type theories don't come with a built in dependent or indexed equalty type. Instead, a common approach is to take </p><pre class="agda"><span class="conid">Eq</span><sub>i</sub> (A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="agda-fun">Eq</span> (A <span class="num">0</span>) <span class="varid">x</span> (<span class="agda-fun">cast</span><sub>i</sub> (A <span class="varid">i</span>) <span class="num">1</span> <span class="num">0</span> <span class="varid">y</span>) </pre><p>or </p><pre class="agda"><span class="conid">Eq</span><sub>i</sub> (A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="agda-fun">Eq</span> (A <span class="num">1</span>) (<span class="agda-fun">cast</span><sub>i</sub> (A <span class="varid">i</span>) <span class="num">0</span> <span class="num">1</span> <span class="varid">x</span>) <span class="varid">y</span> </pre><p>We can prove that these are equivalent: </p><pre class="agda"><span class="varid">lemma'</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A} {<span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> <span class="conid">Type</span> (<span class="agda-fun">Eq</span> (A <span class="num">0</span>) <span class="varid">x</span> (<span class="agda-fun">cast</span><sub>i</sub> (A <span class="varid">i</span>) <span class="num">1</span> <span class="num">0</span> <span class="varid">y</span>)) (<span class="conid">Eq</span><sub>i</sub> (A <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span>) <span class="varid">lemma'</span> {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="keyglyph">=</span> <span class="agda-fun">refl</span><sub>j</sub> (<span class="conid">Eq</span><sub>k</sub> (A (<span class="varid">j</span> <span class="varop">&amp;&amp;</span> <span class="varid">k</span>)) <span class="varid">x</span> (<span class="agda-fun">cast</span><sub>i</sub> (A <span class="varid">i</span>) <span class="num">1</span> <span class="varid">j</span> <span class="varid">y</span>)) </pre><p>where <tt class='complex'><span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span></tt> is the and operator on intervals, i.e. </p><pre class="agda"><span class="keyglyph">_</span><span class="varop">&amp;&amp;</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="conid">Interval</span> <span class="keyglyph">→</span> <span class="conid">Interval</span> <span class="keyglyph">→</span> <span class="conid">Interval</span> <span class="num">0</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="num">1</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="varid">j</span> <span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="num">1</span> <span class="keyglyph">=</span> <span class="varid">i</span> </pre><p>We can even go one step further to derive the ultimate in substitution, the J axiom: </p><pre class="agda">J <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A <span class="keyglyph">:</span> <span class="conid">Type</span>} {<span class="varid">x</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (P <span class="keyglyph">:</span> (<span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Type</span>) <span class="keyglyph">→</span> (<span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> (<span class="varid">xy</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> P <span class="varid">x</span> (<span class="agda-fun">refl</span> <span class="varid">x</span>) <span class="keyglyph">→</span> P <span class="varid">y</span> <span class="varid">xy</span> J P <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">pxy</span> <span class="keyglyph">=</span> <span class="agda-fun">cast</span><sub>i</sub> (P xy<sup>i</sup> (<span class="agda-fun">refl</span><sub>j</sub> (xy<span class="varop">^</span>(<span class="varid">j</span> <span class="varop">&amp;&amp;</span> <span class="varid">i</span>)))) <span class="num">0</span> <span class="num">1</span> <span class="varid">pxy</span> </pre><p>With the <a href="https://github.com/twanvl/ttie">TTIE implementation</a>, you can type check the all of the above examples. The implementation comes with a REPL, where you can ask for types, evaluate expressions, and so on. Expressions and types can have holes, which will be inferred by unification, like in Agda. </p><p>On the other hand, this is by no means a complete programming language. For example, there are no inductive data types. You will instead have to work with product types (<tt class='complex'><span class="varid">x</span> , <span class="varid">y</span> <span class="keyglyph">:</span> A <span class="varop">*</span> B</tt>) and sum types (<tt class='complex'><span class="agda-fun">value</span> <span class="varid">foo</span> <span class="varid">x</span> <span class="keyglyph">:</span> <span class="keyword">data</span> {<span class="varid">foo</span> <span class="keyglyph">:</span> A; <span class="varid">bar</span> <span class="keyglyph">:</span> B}</tt>). See the readme for a full description of the syntax. </p> Stream fusion for streaming, without writing any code http://twanvl.nl/blog/haskell/streaming-vector 2016-06-07T21:02:00Z <p>I recently came accross the <a href="http://hackage.haskell.org/package/streaming">streaming library</a>. This library defines a type <tt class='complex'><span class="conid">Stream</span> (<span class="conid">Of</span> <span class="varid">a</span>) <span class="varid">m</span> <span class="varid">b</span></tt> for computations that produce zero or more values of type <tt><span class="varid">a</span></tt> in a monad <tt><span class="varid">m</span></tt>, and eventually produce a value of type <tt><span class="varid">b</span></tt>. This stream type can be used for efficient IO without having to load whole files into memory. The streaming library touts <a href="http://i.imgur.com/sSG5MvH.png">bechmark results</a> showing superior performance compared to other libraries like conduit, pipes and machines. </p><p>Looking at <a href="http://hackage.haskell.org/package/streaming-0.1.4.2/docs/Streaming-Internal.html#t:Stream">the datatype</a> definition, </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Stream</span> <span class="varid">f</span> <span class="varid">m</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="conid">Step</span> <span class="varop">!</span>(<span class="varid">f</span> (<span class="conid">Stream</span> <span class="varid">f</span> <span class="varid">m</span> <span class="varid">r</span>)) <span class="keyglyph">|</span> <span class="conid">Effect</span> (<span class="varid">m</span> (<span class="conid">Stream</span> <span class="varid">f</span> <span class="varid">m</span> <span class="varid">r</span>)) <span class="keyglyph">|</span> <span class="conid">Return</span> <span class="varid">r</span> </pre><p>it struck me how similar this type is to what is used in the stream fusion framework. The main difference being that the streaming library allows for interleaved monadic actions, and of course the lack of decoupling of the state from the stream to allow for fusion. But the vector library actually also uses such a monadic stream fusion framework, to allow for writing into buffers and such. This is type is defined in the module <a href="https://hackage.haskell.org/package/vector-0.11.0.0/docs/Data-Vector-Fusion-Stream-Monadic.html">Data.Vector.Fusion.Stream.Monadic</a>. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Stream</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="keyword">forall</span> <span class="varid">s</span><span class="varop">.</span> <span class="conid">Stream</span> (<span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> (<span class="conid">Step</span> <span class="varid">s</span> <span class="varid">a</span>)) <span class="varid">s</span> <span class="keyword">data</span> <span class="conid">Step</span> <span class="varid">s</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="conid">Yield</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">Step</span> <span class="varid">s</span> <span class="varid">a</span> <span class="conid">Skip</span> <span class="keyglyph">::</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">Step</span> <span class="varid">s</span> <span class="varid">a</span> <span class="conid">Done</span> <span class="keyglyph">::</span> <span class="conid">Step</span> <span class="varid">s</span> <span class="varid">a</span> </pre><p>So, why not try to use vector's stream type directly as a representation of streams? I <a href="https://gist.github.com/twanvl/4fb44b19b4875d9c0c113e9baa3ba91c">added this type as an extra alternative to the benchmark</a>, and without writing any more code, the results are pretty impressive: <br><a href="image/benchmark-vector-streaming.html"><img src="image/benchmark-vector-streaming.png" style="border:0"></a> </p><p>The only function that could be improved is <tt><span class="varid">scanL</span></tt>. In <tt><span class="varid">vector</span></tt> this function is implemented in terms of <tt><span class="varid">prescan</span></tt> (scanL without the first element) and <tt><span class="varid">cons</span></tt>, which makes it pretty inefficient. So I made a specialized implementation. </p><p>And that's all. A simple streaming 'library' with state of the art performance, while writing hardly any new code. Now to be fair, there are some reasons why you wouldn't always want to use these fusing streams. In particular, the resulting code could get quite large, and without fusion they may not be the most efficient. </p> Extra unsafe sequencing of IO actions http://twanvl.nl/blog/haskell/unsafe-sequence 2015-10-10T22:00:00Z <p>Warning: evil ahead! </p><p>A while ago Neil Mitchell wrote about <a href="http://neilmitchell.blogspot.co.uk/2015/09/making-sequencemapm-for-io-take-o1-stack.html">a different implementation of <tt><span class="varid">sequence</span></tt> for the <tt><span class="conid">IO</span></tt> monad</a>. The issue with the usual definition is that it is not tail recursive. Neil's version uses some hacks to essentially break out of the IO monad. But the solution does require two traversals of the list. </p><p>Now in any language other than Haskell this IO monad wouldn't exist at all, and with a bit of luck lists would be mutable. Then you could implement <tt><span class="varid">sequence</span></tt> by just appending items to the end of a list. In Haskell you can not do that. Or can you? </p><p>A obvious way to implement mutable lists in haskell is with <tt><span class="conid">IORef</span></tt>s. But then you end up with something that is not an ordinary list, and you would have to use the IO monad even for reading from it. Instead, why not be unsafe? Just because Haskell doesn't let you change the tail of a list doesn't mean that it is impossible. </p><p>Now obviously this requires something beyond ordinary haskell. And even doing it from C via the foreign function interface is hard, because GHC will try to marshall values you pass to C functions. But GHC also allows you to write primitive operations in C--, which is essentially a portable assembly language. In C-- you *can* just overwrite the tail pointer of a <tt class='complex'><span class="listcon">(:)</span></tt> constructor to point to something else. </p><p>So I wrote a simple <tt><span class="varid">unsafeSetField</span></tt> function. </p><pre class="c--">unsafeSetFieldzh (<span class="keyword">W_</span> i, <span class="keyword">gcptr</span> x, <span class="keyword">gcptr</span> y) { <span class="keyword">W_</span> bd; x <span class="varop">=</span> UNTAG(x); <span class="keyword">P_</span><span class="listcon">[</span>x <span class="varop">+</span> SIZEOF_StgHeader <span class="varop">+</span> WDS(i)<span class="listcon">]</span> <span class="varop">=</span> y; <span class="comment">// write in memory</span> <div class='empty-line'></div> bd <span class="varop">=</span> Bdescr(x); <span class="keyword">if</span> (bdescr_gen_no(bd) <span class="varop">!=</span> <span class="num">0</span> <span class="varop">::</span> <span class="keyword">bits16</span>) { recordMutableCap(x, TO_W_(bdescr_gen_no(bd))); <span class="keyword">return</span> (); } <span class="keyword">else</span> { <span class="keyword">return</span> (); } } </pre><p>There are several things going on here. First of all, GHC uses <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/HaskellExecution/PointerTagging">pointer</a> tagging, meaning that we need to untag the incomming pointer. Secondly, it might be the case that the <tt>x</tt> lives in the <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC/RememberedSets">old GC generation</a>, in which case we have to mark the fact that we changed it, since otherwise <tt>y</tt> might get garbage collected. By the way, the <tt>zh</tt> in the end of the function name is <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/SymbolNames">the z encoding</a> for the <tt class='complex'><span class="varop">#</span></tt> character. </p><p>Now to use this function from Haskell we import it and add some <tt>unsafeCoerce</tt>, </p><pre class="haskell"><span class="keyword">foreign</span> <span class="keyword">import</span> <span class="keyword">prim</span> <span class="str">&quot;unsafeSetFieldzh&quot;</span> <span class="varid">unsafeSetField</span><span class="varop">#</span> <span class="keyglyph">::</span> <span class="conid">Int</span><span class="varop">#</span> <span class="keyglyph">-&gt;</span> <span class="conid">Any</span> <span class="keyglyph">-&gt;</span> <span class="conid">Any</span> <span class="keyglyph">-&gt;</span> (<span class="varop">##</span>) <div class='empty-line'></div> <span class="varid">unsafeSetField</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">IO</span> () <span class="varid">unsafeSetField</span> (<span class="conid">I</span><span class="varop">#</span> <span class="varid">i</span>) <span class="varop">!</span><span class="varid">x</span> <span class="varid">y</span> <span class="varop">=</span> <span class="keyword">case</span> <span class="varid">unsafeSetField</span><span class="varop">#</span> <span class="varid">i</span> (<span class="varid">unsafeCoerce</span><span class="varop">#</span> <span class="varid">x</span> <span class="keyglyph">::</span> <span class="conid">Any</span>) (<span class="varid">unsafeCoerce</span><span class="varop">#</span> <span class="varid">y</span> <span class="keyglyph">::</span> <span class="conid">Any</span>) <span class="keyword">of</span> (<span class="varop">##</span>) <span class="keyglyph">-&gt;</span> <span class="varid">return</span> () <span class="pragma">{-# INLINEABLE unsafeSetField #-}</span> </pre><p>With it we can implement <tt><span class="varid">sequence</span></tt> as follows </p><pre class="haskell"><span class="varid">sequenceU</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">IO</span> <span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">IO</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="varid">sequenceU</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="varid">return</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">sequenceU</span> (<span class="varid">mx0</span><span class="listcon">:</span><span class="varid">xs0</span>) <span class="keyglyph">=</span> <span class="keyword">do</span> <span class="varid">x0</span> <span class="keyglyph">&lt;-</span> <span class="varid">mx0</span> <span class="keyword">let</span> <span class="varid">front</span> <span class="keyglyph">=</span> <span class="varid">x0</span><span class="listcon">:</span><span class="listcon">[</span><span class="listcon">]</span> <span class="varid">go</span> <span class="varid">front</span> <span class="varid">xs0</span> <span class="varid">return</span> <span class="varid">front</span> <span class="keyword">where</span> <span class="varid">go</span> <span class="varid">back</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="varid">return</span> () <span class="varid">go</span> <span class="varid">back</span> (<span class="varid">mx</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="keyglyph">=</span> <span class="keyword">do</span> <span class="varid">x</span> <span class="keyglyph">&lt;-</span> <span class="varid">mx</span> <span class="keyword">let</span> <span class="varid">back'</span> <span class="keyglyph">=</span> <span class="varid">x</span><span class="listcon">:</span><span class="listcon">[</span><span class="listcon">]</span> <span class="varid">unsafeSetField</span> <span class="num">1</span> <span class="varid">back</span> <span class="varid">back'</span> <span class="varid">go</span> <span class="varid">back'</span> <span class="varid">xs</span> <span class="pragma">{-# INLINEABLE sequenceT #-}</span> </pre><p>Now for the big questions: Does it work? The answer is that, yes it does! Benchmarking shows that the unsafe <tt><span class="varid">sequenceU</span></tt> is between 11% and 23% faster than Neil's <tt><span class="varid">sequenceIO</span></tt> in all cases. For small lists the standard <tt><span class="varid">sequence</span></tt> implementation is still marginally faster. </p><p>You should be aware that GHC sometimes shares values, so overwriting part of one might overwrite them all. And also that constant lists might become static values, meaning not allocated on the heap. So trying to overwrite parts of those will just crash the program. </p><p>I also wouldn't be surprised if the above code is subtly wrong. Perhaps I am missing a write barrier or doing something wrong with the generation check. So I wouldn't use it in production code if I were you. </p><p>What if you don't even know beforehand what constructor to use? The GHC runtime system has something called <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#Indirections">indirections</a>. These are used to replace a thunk with its result after evaluation. But we can also use indirections to replace a value itself. But because of pointer tagging you can't just replace one constructor by another, because the tag would be wrong. </p><p>Instead the idea is to first allocate a special "hole" value, and then later fill that hole by overwriting it with an indirection. Note that you can only do that once, because the runtime system will follow and remove indirections when possible. So you get an API that looks like </p><pre class="haskell"><span class="varid">newHole</span> <span class="keyglyph">::</span> <span class="conid">IO</span> <span class="varid">a</span> <span class="varid">setHole</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">IO</span> <span class="varid">a</span> </pre><p>It is also possible to implement <tt><span class="varid">sequence</span></tt> with holes. But, perhaps unsurprisingly, this turns out to be a bit slower. I'll leave the actual implementation as an exercise for the interested reader, as well as the question of what other evil you can commit with it. </p><p>I wanted to publish the functions from this post on hackage, but unfortunately I haven't yet figured out how to include C-- files in a cabal package. So instead everything is on <a href="https://github.com/twanvl/unsafe-sequence">github</a>. </p> Dependent equality with the interval http://twanvl.nl/blog/hott/dependent-equality-with-the-interval 2014-07-01T22:56:00Z <p>Here is a way to represent heterogeneous or dependent equalities, based on an interval type. In Homotopy Type Theory the interval is usually presented as a Higher Inductive Type with two constructors and a path between them. Here I will just give the two constructors, the path is implicit </p><pre class="agda"><span class="keyword">data</span> <span class="agda-fun">I</span> <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">:</span> <span class="agda-fun">I</span> <span class="agda-ctor">i₂</span> <span class="keyglyph">:</span> <span class="agda-fun">I</span> <span class="comment">-- there is usually a path, i-edge : i₁ ≡ i₂</span> </pre><p>The eliminator is </p><pre class="agda"><span class="agda-fun">i-elim</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="keyglyph">→</span> (<span class="varid">x₁</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₁</span>) <span class="keyglyph">→</span> (<span class="varid">x₂</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₂</span>) <span class="keyglyph">→</span> (<span class="agda-fun">Eq</span> A <span class="varid">x₁</span> <span class="varid">x₂</span>) <span class="keyglyph">→</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="agda-fun">I</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-fun">i-elim</span> <span class="varid">x₁</span> <span class="varid">x₂</span> <span class="varid">eq</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">=</span> <span class="varid">x₁</span> <span class="agda-fun">i-elim</span> <span class="varid">x₁</span> <span class="varid">x₂</span> <span class="varid">eq</span> <span class="agda-ctor">i₂</span> <span class="keyglyph">=</span> <span class="varid">x₂</span> </pre><p>Here the type <tt><span class="agda-fun">Eq</span></tt> is the dependent equality, which has type </p><pre class="agda"><span class="agda-fun">Eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="agda-fun">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> (<span class="varid">x₁</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₁</span>) <span class="keyglyph">→</span> (<span class="varid">x₂</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₂</span>) <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> </pre><p>so we take a type parametrized by an interval, and two values of that type at the two endpoints of this interval. We can also define "heterogeneous reflexivity", a generalization of the usual <tt><span class="agda-fun">refl</span></tt> function: </p><pre class="agda"><span class="agda-fun">refl</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="agda-fun">I</span>) <span class="keyglyph">→</span> A <span class="varid">i</span>) <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> A (<span class="varid">x</span> <span class="agda-ctor">i₁</span>) (<span class="varid">x</span> <span class="agda-ctor">i₂</span>) </pre><p>This function can be used to extract the third part of <tt class='complex'><span class="agda-fun">i-elim</span></tt>, with the reduction </p><pre class="agda"><span class="agda-fun">refl</span> (<span class="agda-fun">i-elim</span> <span class="varid">x₁</span> <span class="varid">x₂</span> <span class="varid">eq</span>) <span class="keyglyph">=</span> <span class="varid">eq</span> </pre><p>I believe this can be used as the basis for an observational type theory, where <tt class='complex'><span class="agda-fun">Eq</span> A</tt> and <tt class='complex'><span class="agda-fun">refl</span> <span class="varid">x</span></tt> reduce. The above is the first case for <tt><span class="agda-fun">refl</span></tt>, the rest is "just" tedious structural recursion such as </p><pre class="agda"><span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varop">×</span> B <span class="varid">i</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="agda-fun">Eq</span> A (<span class="agda-proj">proj₁</span> <span class="varid">x</span>) (<span class="agda-proj">proj₁</span> <span class="varid">y</span>) <span class="varop">×</span> <span class="agda-fun">Eq</span> B (<span class="agda-proj">proj₂</span> <span class="varid">x</span>) (<span class="agda-proj">proj₂</span> <span class="varid">y</span>) <span class="agda-fun">refl</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">i</span> , <span class="varid">y</span> <span class="varid">i</span>) <span class="keyglyph">=</span> <span class="agda-fun">refl</span> <span class="varid">x</span> , <span class="agda-fun">refl</span> <span class="varid">y</span> </pre><p>and </p><pre class="agda"><span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="keyglyph">→</span> B <span class="varid">i</span>) <span class="varid">f</span> <span class="varid">g</span> <span class="keyglyph">=</span> {<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₁</span>} <span class="keyglyph">→</span> {<span class="varid">y</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₂</span>} <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> B (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">y</span>) <span class="agda-fun">refl</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="keyglyph">\</span>(<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varid">i</span>) <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varid">i</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="keyglyph">\</span>{<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> <span class="keyglyph">→</span> <span class="agda-fun">refl</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varid">i</span> (<span class="agda-fun">i-elim</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">i</span>)) </pre><p>or we can actually use the dependent equality and be more general </p><pre class="agda"><span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Σ</span> (<span class="varid">x₁</span> <span class="keyglyph">:</span> A <span class="varid">i</span>) (B <span class="varid">i</span> <span class="varid">x₁</span>)) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="agda-fun">Σ</span> (<span class="varid">x₁y₁</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> A (<span class="agda-proj">proj₁</span> <span class="varid">x</span>) (<span class="agda-proj">proj₁</span> <span class="varid">y</span>)) (<span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B <span class="varid">i</span> (<span class="agda-fun">i-elim</span> (<span class="agda-proj">proj₁</span> <span class="varid">x</span>) (<span class="agda-proj">proj₁</span> <span class="varid">y</span>) <span class="varid">x₁y₁</span> <span class="varid">i</span>)) (<span class="agda-proj">proj₂</span> <span class="varid">x</span>) (<span class="agda-proj">proj₂</span> <span class="varid">y</span>)) <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varid">i</span>) <span class="keyglyph">→</span> B <span class="varid">i</span>) <span class="varid">f</span> <span class="varid">g</span> <span class="keyglyph">=</span> {<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₁</span>} <span class="keyglyph">→</span> {<span class="varid">y</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₂</span>} <span class="keyglyph">→</span> (<span class="varid">xy</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B <span class="varid">i</span> (<span class="agda-fun">i-elim</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">i</span>)) (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">y</span>) </pre><p>Of course there is a lot more to it, but that is not the subject of this post. </p><p>As a final remark: if you are not too touchy about typing, then <tt><span class="agda-fun">refl</span></tt> could even be implemented with the path <tt class='complex'><span class="agda-ctor">i-edge</span></tt> between <tt class='complex'><span class="agda-ctor">i₁</span></tt> and <tt class='complex'><span class="agda-ctor">i₂</span></tt> </p><pre class="agda"><span class="agda-ctor">i-edge</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="agda-fun">I</span>) <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₂</span> <span class="agda-fun">i-elim</span> <span class="varid">x₁</span> <span class="varid">x₂</span> <span class="varid">eq</span> <span class="agda-ctor">i-edge</span> <span class="keyglyph">=</span> <span class="varid">eq</span> <span class="agda-fun">refl</span> <span class="varid">foo</span> <span class="keyglyph">=</span> <span class="varid">foo</span> <span class="agda-ctor">i-edge</span> </pre><p>But I'd rather not do that. </p> cong from refl in univalent OTT http://twanvl.nl/blog/agda/cong-from-refl 2013-07-04T16:00:00Z <p>This is a follow up on <a href="blog/agda/subst-from-cong">last week's post</a>. There I showed that in a univalent Observational Type Theory, you can derive <tt><span class="agda-fun">subst</span></tt> from <tt><span class="agda-fun">cong</span></tt>. Now I am going to go one step further. </p><p>Suppose we change the definition of paths for functions from </p><pre class="agda"><span class="conid">Path</span> (A <span class="keyglyph">→</span> B) <span class="varid">f</span> <span class="varid">g</span> <span class="varop">≡</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varid">x</span> <span class="varop">≡</span> <span class="varid">g</span> <span class="varid">x</span> </pre><p>to </p><pre class="agda"><span class="conid">Path</span> (A <span class="keyglyph">→</span> B) <span class="varid">f</span> <span class="varid">g</span> <span class="varop">≡</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varid">x</span> <span class="varop">≡</span> <span class="varid">g</span> <span class="varid">y</span> </pre><p>Then for a function <tt><span class="varid">f</span></tt>, <tt class='complex'><span class="agda-ctor">refl</span> <span class="varid">f</span></tt> is actually the same thing as <tt class='complex'><span class="agda-fun">cong</span> <span class="varid">f</span></tt>!. So that's one less primitive to worry about. In fact the only two path related primitives that remain are <tt><span class="conid">Path</span></tt> and <tt><span class="agda-ctor">refl</span></tt>. The rest is just in the computation rules. </p><p>Here are the changes in the agda code compared to last week: </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Path-→</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">f</span> <span class="varid">g</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) <span class="keyglyph">→</span> <span class="conid">Path</span> (A <span class="keyglyph">→</span> B) <span class="varid">f</span> <span class="varid">g</span> <span class="varop">≡</span> ((<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Path</span> B (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">y</span>)) <div class='empty-line'></div> <span class="comment">-- cong = refl</span> <span class="agda-fun">cong</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} <span class="keyglyph">→</span> (<span class="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Path</span> B (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">y</span>) <span class="agda-fun">cong</span> <span class="varid">f</span> <span class="varid">x=y</span> <span class="keyglyph">=</span> <span class="varid">Meta.subst</span> <span class="varid">id</span> (<span class="conid">Path-→</span> <span class="varid">f</span> <span class="varid">f</span>) (<span class="agda-ctor">refl</span> <span class="keyglyph">_</span> <span class="varid">f</span>) <span class="keyglyph">_</span> <span class="keyglyph">_</span> <span class="varid">x=y</span> <div class='empty-line'></div> <span class="comment">-- subst is the same as last time</span> <span class="agda-fun">subst</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} (B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>) <span class="keyglyph">→</span> {<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (<span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> B <span class="varid">x</span> <span class="keyglyph">→</span> B <span class="varid">y</span> <span class="agda-fun">subst</span> B {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">p</span> <span class="keyword">with</span> <span class="varid">Meta.subst</span> <span class="varid">id</span> (<span class="conid">Path-Type</span> (B <span class="varid">x</span>) (B <span class="varid">y</span>)) (<span class="agda-fun">cong</span> B <span class="varid">p</span>) <span class="varop">...</span> <span class="keyglyph">|</span> <span class="varid">lift</span> (<span class="varid">fw</span> , <span class="varid">bw</span> , <span class="keyglyph">_</span> , <span class="keyglyph">_</span>) <span class="keyglyph">=</span> <span class="varid">fw</span> <div class='empty-line'></div> <span class="comment">-- and paths for dependent functions</span> <span class="keyword">postulate</span> <span class="conid">Path-Π</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">f</span> <span class="varid">g</span> <span class="keyglyph">:</span> <span class="agda-fun">Π</span> A B) <span class="keyglyph">→</span> <span class="conid">Path</span> (<span class="agda-fun">Π</span> A B) <span class="varid">f</span> <span class="varid">g</span> <span class="varop">≡</span> ((<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> (<span class="varid">pa</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="conid">Path</span> (B <span class="varid">y</span>) (<span class="agda-fun">subst</span> B <span class="varid">pa</span> (<span class="varid">f</span> <span class="varid">x</span>)) (<span class="varid">g</span> <span class="varid">y</span>)) </pre><p>Of course this doesn't really change anything, since defining <tt><span class="agda-ctor">refl</span></tt> for function types is no easier than defining <tt><span class="agda-fun">cong</span></tt>. </p><h2><a name="representation"></a>Representation </h2> <p>You might also notice that for all types <tt>A</tt> (except <tt><span class="agda-fun">Set</span></tt>), the structure of <tt class='complex'><span class="conid">Path</span> A</tt> is essentially the same as that of <tt>A</tt>. In fact, for a (non-indexed) data type </p><pre class="agda"><span class="keyword">data</span> <span class="conid">Foo</span> <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="varid">foo₀</span> <span class="keyglyph">:</span> <span class="conid">Foo</span> <span class="varid">foo₁</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="conid">Foo</span> <span class="varid">foo₂</span> <span class="keyglyph">:</span> <span class="conid">Foo</span> <span class="keyglyph">→</span> <span class="conid">Foo</span> <span class="keyglyph">→</span> <span class="conid">Foo</span> </pre><p>you can mechanically derive its path type to be </p><pre class="agda"><span class="keyword">data</span> <span class="conid">Path</span> <span class="conid">Foo</span> <span class="keyglyph">:</span> <span class="conid">Foo</span> <span class="keyglyph">→</span> <span class="conid">Foo</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="varid">refl-foo₀</span> <span class="keyglyph">:</span> <span class="conid">Path</span> (<span class="varid">foo₀</span> <span class="varid">x</span>) (<span class="varid">foo₀</span> <span class="varid">x</span>) <span class="varid">cong₁-foo₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">x'</span>} <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x'</span> <span class="keyglyph">→</span> <span class="conid">Path</span> <span class="conid">Foo</span> (<span class="varid">foo₁</span> <span class="varid">x</span>) (<span class="varid">foo₁</span> <span class="varid">x'</span>) <span class="varid">cong₂-foo₂</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">x'</span> <span class="varid">y</span> <span class="varid">y'</span>} <span class="keyglyph">→</span> <span class="conid">Path</span> <span class="conid">Foo</span> <span class="varid">x</span> <span class="varid">x'</span> <span class="keyglyph">→</span> <span class="conid">Path</span> <span class="conid">Foo</span> <span class="varid">y</span> <span class="varid">y'</span> <span class="keyglyph">→</span> <span class="conid">Path</span> <span class="conid">Foo</span> (<span class="varid">foo₂</span> <span class="varid">x</span> <span class="varid">y</span>) (<span class="varid">foo₂</span> <span class="varid">x'</span> <span class="varid">y'</span>) </pre><p>In theory this allows for a nice implementation trick: we can take the representation of <tt><span class="varid">x</span></tt> and <tt class='complex'><span class="agda-ctor">refl</span> <span class="varid">x</span></tt> to be the same. So for example <tt class='complex'><span class="num">5</span> <span class="keyglyph">:</span> <span class="conid">Path</span> <span class="conid">Int</span> <span class="num">5</span> <span class="num">5</span></tt> is a path that asserts that 5 = 5, and it is the only such path. </p><p>Originally I thought that an implementation would have to pass <tt class='complex'><span class="agda-fun">cong</span> <span class="varid">f</span></tt> along with every parameter <tt><span class="varid">f</span></tt> of a function type (which would suck). But in this way we don't have to, since <tt><span class="varid">f</span></tt> and <tt class='complex'><span class="agda-fun">cong</span> <span class="varid">f</span></tt> are the same function. </p><p>This also corresponds nicely to the idea that extra path constructors can be added in Higher Inductive Types. But I am not quite sure yet how that works out. </p><h2><a name="food-for-thought"></a>Food for thought </h2> <ul><li> What is <tt class='complex'><span class="agda-ctor">refl</span> <span class="keyglyph">_</span><span class="keyglyph">→</span><span class="keyglyph">_</span></tt>?</li> <li> What is <tt class='complex'><span class="agda-ctor">refl</span> <span class="agda-ctor">refl</span></tt>? Does this even make sense?</li> <li> For the representation of <tt class='complex'><span class="varid">x</span> <span class="keyglyph">:</span> A</tt> and <tt class='complex'><span class="agda-ctor">refl</span> <span class="varid">x</span></tt> to be the same, <tt>A</tt> and <tt class='complex'><span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x</span></tt> also need to have the same representation. That seems works for functions and inductive types, but what about <tt><span class="agda-fun">Set</span></tt>?</li> <li> Is <tt><span class="conid">Path</span></tt> an applicative functor in some sense? With <tt><span class="agda-ctor">refl</span></tt> as return and <tt><span class="agda-fun">cong</span></tt> as ap?</li> </ul> Substitution from congruence in univalent OTT http://twanvl.nl/blog/agda/subst-from-cong 2013-06-22T14:51:00Z <p>In this post I will show that in an univalence style observational type theory, it is enough to take congruence as a primitive, rather than the more complicated substitution or J axioms. This post is literate Agda, so here are some boring import declarations </p><pre class="agda"><span class="keyword">module</span> <span class="varid">subst-from-cong</span> <span class="keyword">where</span> <div class='empty-line'></div> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Level</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Function</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Unit</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Bool</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Empty</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Product</span> </pre><p>I will be using the standard propositional equality as a meta equality, </p><pre class="agda"><span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Relation.Binary.PropositionalEquality</span> <span class="varid">as</span> <span class="conid">Meta</span> <span class="varid">using</span> (<span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span>) </pre><p>while postulating a path type (equality type) and its computation rules for me to prove things about, </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Path</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} <span class="keyglyph">→</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> A <span class="keyglyph">→</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="keyword">postulate</span> <span class="agda-ctor">refl</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} <span class="keyglyph">→</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x</span> </pre><p>The idea of Observational Type Theory (OTT) is that <tt><span class="conid">Path</span></tt> is actually defined by case analysis on the structure of the argument type. For the finite types this is simple, there is a path if and only if the values are the same, </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Path-⊤</span> <span class="keyglyph">:</span> <span class="conid">Path</span> ⊤ <span class="varid">tt</span> <span class="varid">tt</span> <span class="varop">≡</span> ⊤ <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="conid">Path-Bool00</span> <span class="keyglyph">:</span> <span class="conid">Path</span> <span class="conid">Bool</span> <span class="varid">false</span> <span class="varid">false</span> <span class="varop">≡</span> ⊤ <span class="keyword">postulate</span> <span class="conid">Path-Bool01</span> <span class="keyglyph">:</span> <span class="conid">Path</span> <span class="conid">Bool</span> <span class="varid">false</span> <span class="varid">true</span> <span class="varop">≡</span> ⊥ <span class="keyword">postulate</span> <span class="conid">Path-Bool10</span> <span class="keyglyph">:</span> <span class="conid">Path</span> <span class="conid">Bool</span> <span class="varid">true</span> <span class="varid">false</span> <span class="varop">≡</span> ⊥ <span class="keyword">postulate</span> <span class="conid">Path-Bool11</span> <span class="keyglyph">:</span> <span class="conid">Path</span> <span class="conid">Bool</span> <span class="varid">true</span> <span class="varid">true</span> <span class="varop">≡</span> ⊤ </pre><p>A path for functions is a function to paths, which also means that we have functional extensionality. </p><pre class="agda"><span class="agda-fun">Π</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) (B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>) <span class="keyglyph">→</span> <span class="agda-fun">Set</span> (<span class="varid">a</span> ⊔ <span class="varid">b</span>) <span class="agda-fun">Π</span> A B <span class="keyglyph">=</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> B <span class="varid">x</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="conid">Path-Π</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">f</span> <span class="varid">g</span> <span class="keyglyph">:</span> <span class="agda-fun">Π</span> A B) <span class="keyglyph">→</span> <span class="conid">Path</span> (<span class="agda-fun">Π</span> A B) <span class="varid">f</span> <span class="varid">g</span> <span class="varop">≡</span> ((<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="conid">Path</span> (B <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">x</span>)) </pre><p>In their <a href="http://www.cs.nott.ac.uk/~txa/publ/obseqnow.pdf">original OTT paper</a>, Alternkirch et.al. defined equality for types also by structure matching. I.e. Π types are equal to Π types with equal arguments, Σ types are equal to Σ types, etc. But this is incompatible with the univalence axiom from Homotopy Type Theory. That axiom states that equivalent or isomorphic types are equal. So, what happens if we take isomorphism as our definition of equality between types? </p><pre class="agda"><span class="agda-fun">Iso</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} <span class="keyglyph">→</span> (A B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="agda-fun">Iso</span> {<span class="varid">a</span>} A B <span class="keyglyph">=</span> <span class="agda-fun">Σ</span> (A <span class="keyglyph">→</span> B) <span class="keyglyph">\</span><span class="varid">fw</span> <span class="keyglyph">→</span> <span class="agda-fun">Σ</span> (B <span class="keyglyph">→</span> A) <span class="keyglyph">\</span><span class="varid">bw</span> <span class="keyglyph">→</span> (<span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="conid">Path</span> A (<span class="varid">bw</span> (<span class="varid">fw</span> <span class="varid">x</span>)) <span class="varid">x</span>) <span class="varop">×</span> (<span class="keyglyph">∀</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Path</span> B (<span class="varid">fw</span> (<span class="varid">bw</span> <span class="varid">y</span>)) <span class="varid">y</span>) <div class='empty-line'></div> <span class="varid">id-Iso</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} <span class="keyglyph">→</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> <span class="agda-fun">Iso</span> A A <span class="varid">id-Iso</span> A <span class="keyglyph">=</span> (<span class="varid">id</span> , <span class="varid">id</span> , <span class="agda-ctor">refl</span> A , <span class="agda-ctor">refl</span> A) <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="conid">Path-Type</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> <span class="conid">Path</span> (<span class="agda-fun">Set</span> <span class="varid">a</span>) A B <span class="varop">≡</span> <span class="conid">Lift</span> {<span class="varid">a</span>} {<span class="agda-ctor">suc</span> <span class="varid">a</span>} (<span class="agda-fun">Iso</span> A B) </pre><p>Now suppose that we have a congruence, i.e. that all functions preserve paths. So from a path between <tt><span class="varid">x</span></tt> and <tt><span class="varid">y</span></tt>, we can construct a path between <tt class='complex'><span class="varid">f</span> <span class="varid">x</span></tt> and <tt class='complex'><span class="varid">f</span> <span class="varid">y</span></tt> for any function <tt><span class="varid">f</span></tt>. </p><pre class="agda"><span class="comment">-- we have congruence for non-dependent functions</span> <span class="keyword">postulate</span> <span class="agda-fun">cong</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} <span class="keyglyph">→</span> (<span class="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="conid">Path</span> B (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">y</span>) </pre><p>Then this is enough to define substitution, since the paths for a type <tt class='complex'>B <span class="varid">x</span></tt> are isomorphisms, and we can apply these in the forward direction </p><pre class="agda"><span class="agda-fun">subst</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} (B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>) {<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (<span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> B <span class="varid">x</span> <span class="keyglyph">→</span> B <span class="varid">y</span> <span class="agda-fun">subst</span> B {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">p</span> <span class="keyword">with</span> <span class="varid">Meta.subst</span> <span class="varid">id</span> (<span class="conid">Path-Type</span> (B <span class="varid">x</span>) (B <span class="varid">y</span>)) (<span class="agda-fun">cong</span> B <span class="varid">p</span>) <span class="varop">...</span> <span class="keyglyph">|</span> <span class="varid">lift</span> (<span class="varid">fw</span> , <span class="varid">bw</span> , <span class="keyglyph">_</span> , <span class="keyglyph">_</span>) <span class="keyglyph">=</span> <span class="varid">fw</span> </pre><p>With substitution we can now finally define what paths are for dependent Σ types. A path between pairs is a pair of paths, </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Path-Σ</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> <span class="agda-fun">Σ</span> A B) <span class="keyglyph">→</span> <span class="conid">Path</span> (<span class="agda-fun">Σ</span> A B) <span class="varid">x</span> <span class="varid">y</span> <span class="varop">≡</span> <span class="agda-fun">Σ</span> (<span class="conid">Path</span> A (<span class="agda-proj">proj₁</span> <span class="varid">x</span>) (<span class="agda-proj">proj₁</span> <span class="varid">y</span>)) (<span class="keyglyph">\</span><span class="varid">pa</span> <span class="keyglyph">→</span> <span class="conid">Path</span> (B (<span class="agda-proj">proj₁</span> <span class="varid">y</span>)) (<span class="agda-fun">subst</span> B <span class="varid">pa</span> (<span class="agda-proj">proj₂</span> <span class="varid">x</span>)) (<span class="agda-proj">proj₂</span> <span class="varid">y</span>)) </pre><p>Substitution is not the most general eliminator for paths. It is not enough to prove properties about paths. For that we need the general induction principle for paths, often called J </p><pre class="agda">J <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {<span class="varid">x</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (B <span class="keyglyph">:</span> (<span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>) <span class="keyglyph">→</span> {<span class="varid">y</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> B <span class="varid">x</span> (<span class="agda-ctor">refl</span> A <span class="varid">x</span>) <span class="keyglyph">→</span> B <span class="varid">y</span> <span class="varid">p</span> </pre><p>Unfortunately, I was unable to prove J from just congruence. For that I needed an additional lemma, </p><pre class="agda"><span class="keyword">postulate</span> <span class="varid">subst-refl</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="varid">p</span> <span class="varop">≡</span> <span class="agda-fun">subst</span> (<span class="conid">Path</span> A <span class="varid">x</span>) <span class="varid">p</span> (<span class="agda-ctor">refl</span> A <span class="varid">x</span>) </pre><p>Since <tt class='complex'><span class="conid">Path</span> A</tt> is inductively defined, I believe that <tt class='complex'><span class="varid">subst-refl</span></tt> should be provable by case analysis on <tt>A</tt>, but I have not yet done so. We can now implement J by using <tt><span class="agda-fun">subst</span></tt> with a dependent pair. Note that here I have to manually apply the comptuation rules for <tt class='complex'><span class="conid">Path</span> (<span class="agda-fun">Σ</span> <span class="keyglyph">_</span> <span class="keyglyph">_</span>)</tt> and use the <tt class='complex'><span class="varid">subst-refl</span></tt> lemma. </p><pre class="agda">J {A <span class="keyglyph">=</span> A} {<span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">x</span>} B {<span class="varid">y</span>} <span class="varid">p</span> <span class="keyglyph">=</span> <span class="agda-fun">subst</span> (<span class="varid">uncurry</span> B) (<span class="varid">Meta.subst</span> <span class="varid">id</span> (<span class="varid">Meta.sym</span> <span class="varop">\$</span> <span class="conid">Path-Σ</span> (<span class="varid">x</span> , <span class="agda-ctor">refl</span> A <span class="varid">x</span>) (<span class="varid">y</span> , <span class="varid">p</span>)) <span class="varop">\$</span> (<span class="varid">p</span> , <span class="varid">Meta.subst</span> (<span class="keyglyph">\</span><span class="varid">q</span> <span class="keyglyph">→</span> <span class="conid">Path</span> (<span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="varid">q</span> <span class="varid">p</span>) (<span class="varid">subst-refl</span> <span class="varid">p</span>) (<span class="agda-ctor">refl</span> (<span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">y</span>) <span class="varid">p</span>))) </pre><h2><a name="does-it-compute"></a>Does it compute </h2> <p>An important question to ask is whether this style of OTT is actually implementable. We can certainly implement the definitions, but would they allow us to compute? </p><p>The type <tt class='complex'><span class="conid">Path</span> A</tt> certainly reduces, by definition. Similarly, it is not hard to implemenent <tt><span class="agda-ctor">refl</span></tt>. The hard part is defining what <tt><span class="agda-fun">cong</span></tt> means for various functions, and then proving <tt class='complex'><span class="varid">subst-refl</span></tt>. Somewhere in there we should put the fact that paths are transitive and symmetric, since we have not used that property so far. For what I have done up till now I could equally well have taken <tt class='complex'><span class="agda-fun">Iso</span> A B <span class="keyglyph">=</span> A <span class="keyglyph">→</span> B</tt>. </p><p>Here are the implementations of <tt><span class="agda-ctor">refl</span></tt>, </p><pre class="agda"><span class="keyglyph">_</span><span class="varop">≡[</span><span class="keyglyph">_</span><span class="varop">]≡</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> A <span class="varop">≡</span> B <span class="keyglyph">→</span> B <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="varid">a</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="varid">p</span><span class="small-space"> </span><span class="varop">]≡</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">Meta.subst</span> <span class="varid">id</span> <span class="varid">p</span> <span class="varid">a</span> <span class="varop">≡</span> <span class="varid">b</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="varid">refl-⊤</span> <span class="keyglyph">:</span> <span class="agda-ctor">refl</span> ⊤ <span class="varid">tt</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-⊤</span><span class="small-space"> </span><span class="varop">]≡</span> <span class="varid">tt</span> <span class="varid">refl-Bool0</span> <span class="keyglyph">:</span> <span class="agda-ctor">refl</span> <span class="conid">Bool</span> <span class="varid">false</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-Bool00</span><span class="small-space"> </span><span class="varop">]≡</span> <span class="varid">tt</span> <span class="varid">refl-Bool1</span> <span class="keyglyph">:</span> <span class="agda-ctor">refl</span> <span class="conid">Bool</span> <span class="varid">true</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-Bool11</span><span class="small-space"> </span><span class="varop">]≡</span> <span class="varid">tt</span> <span class="varid">refl-Π</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">f</span> <span class="keyglyph">:</span> <span class="agda-fun">Π</span> A B) <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">Π</span> A B) <span class="varid">f</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-Π</span> <span class="varid">f</span> <span class="varid">f</span><span class="small-space"> </span><span class="varop">]≡</span> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (B <span class="varid">x</span>) (<span class="varid">f</span> <span class="varid">x</span>)) <span class="varid">refl-Type</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">Set</span> <span class="varid">a</span>) A <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-Type</span> A A<span class="small-space"> </span><span class="varop">]≡</span> <span class="varid">lift</span> (<span class="varid">id-Iso</span> A) </pre><p>For <tt class='complex'><span class="agda-ctor">refl</span> (<span class="agda-fun">Σ</span> <span class="keyglyph">_</span> <span class="keyglyph">_</span>)</tt> we need yet another lemma, which is a bit a dual to <tt class='complex'><span class="varid">subst-refl₁</span></tt>, allowing <tt><span class="agda-ctor">refl</span></tt> in the second argument instead of the third. </p><pre class="agda"><span class="keyword">postulate</span> <span class="varid">subst-refl₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">x</span> <span class="keyglyph">:</span> A} {<span class="varid">y</span> <span class="keyglyph">:</span> B <span class="varid">x</span>} <span class="keyglyph">→</span> <span class="varid">y</span> <span class="varop">≡</span> <span class="agda-fun">subst</span> B (<span class="agda-ctor">refl</span> A <span class="varid">x</span>) <span class="varid">y</span> <div class='empty-line'></div> <span class="varid">refl-Σ</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="varid">x</span> <span class="keyglyph">:</span> <span class="agda-fun">Σ</span> A B) <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">Σ</span> A B) <span class="varid">x</span> <span class="varop">≡[</span><span class="small-space"> </span><span class="conid">Path-Σ</span> <span class="varid">x</span> <span class="varid">x</span><span class="small-space"> </span><span class="varop">]≡</span> (<span class="agda-ctor">refl</span> A (<span class="agda-proj">proj₁</span> <span class="varid">x</span>) , <span class="varid">Meta.subst</span> (<span class="keyglyph">\</span><span class="varid">x1</span> <span class="keyglyph">→</span> <span class="conid">Path</span> (B (<span class="agda-proj">proj₁</span> <span class="varid">x</span>)) <span class="varid">x1</span> (<span class="agda-proj">proj₂</span> <span class="varid">x</span>)) (<span class="varid">subst-refl₁</span> {B <span class="keyglyph">=</span> B} {<span class="varid">y</span> <span class="keyglyph">=</span> <span class="agda-proj">proj₂</span> <span class="varid">x</span>}) (<span class="agda-ctor">refl</span> (B (<span class="agda-proj">proj₁</span> <span class="varid">x</span>)) (<span class="agda-proj">proj₂</span> <span class="varid">x</span>))) </pre><p>And here is a start of the implementation of <tt><span class="agda-fun">cong</span></tt>, </p><pre class="agda"><span class="keyword">postulate</span> <span class="varid">cong-const</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">x</span> <span class="varid">x'</span>} {<span class="varid">y</span>} {<span class="varid">p</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x'</span>} <span class="keyglyph">→</span> <span class="agda-fun">cong</span> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">y</span>) <span class="varid">p</span> <span class="varop">≡</span> <span class="agda-ctor">refl</span> B <span class="varid">y</span> <span class="varid">cong-id</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {<span class="varid">x</span> <span class="varid">x'</span>} {<span class="varid">p</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x'</span>} <span class="keyglyph">→</span> <span class="agda-fun">cong</span> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">x</span>) <span class="varid">p</span> <span class="varop">≡</span> <span class="varid">p</span> <span class="varid">cong-∘</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {<span class="varid">x</span> <span class="varid">x'</span>} {<span class="varid">p</span> <span class="keyglyph">:</span> <span class="conid">Path</span> A <span class="varid">x</span> <span class="varid">x'</span>} {B <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {C <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">c</span>} {<span class="varid">f</span> <span class="keyglyph">:</span> B <span class="keyglyph">→</span> C} {<span class="varid">g</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B} <span class="keyglyph">→</span> <span class="agda-fun">cong</span> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">f</span> (<span class="varid">g</span> <span class="varid">x</span>)) <span class="varid">p</span> <span class="varop">≡</span> <span class="agda-fun">cong</span> <span class="varid">f</span> (<span class="agda-fun">cong</span> <span class="varid">g</span> <span class="varid">p</span>) <span class="comment">-- etc.</span> </pre><p>At some point I think you will also need a dependent <tt><span class="agda-fun">cong</span></tt>. </p><p>But this is enough postulating for one day. </p> The complete correctness of sorting http://twanvl.nl/blog/agda/sorting 2013-05-23T12:43:33Z <p>A while ago I set out to prove the correctness of <a href="http://en.wikipedia.org/wiki/Merge_sort">merge sort</a> in Agda. Of course this has been done before. But <a href="http://mazzo.li/posts/AgdaSort.html">most</a> <a href="http://www.iis.sinica.edu.tw/~scm/2007/agda-exercise-proving-that-mergesort-returns-ordered-list/">proofs</a> you find are far from complete. All they prove is a lemma such as </p><pre class="agda"><span class="varid">is-sorted</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> (<span class="varid">xs</span> <span class="keyglyph">:</span> <span class="conid">List</span> A) <span class="keyglyph">→</span> <span class="conid">IsSortedList</span> (<span class="varid">sort</span> <span class="varid">xs</span>) </pre><p>Maybe even restricted to lists of natural numbers. While it is nice that a sort function indeed produces a sorted output, that is only half of the story. Consider this function: </p><pre class="agda"><span class="varid">cheat-sort</span> <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="conid">List</span> A <span class="varid">cheat-sort</span> <span class="keyglyph">_</span> <span class="keyglyph">=</span> <span class="varop">[]</span> </pre><p>Clearly the empty list is sorted. So we are done. What is missing is the second half of correctness of sorting: that the output is a permutation of the input. You want something like: </p><pre class="agda"><span class="varid">sort</span> <span class="keyglyph">:</span> (<span class="varid">xs</span> <span class="keyglyph">:</span> <span class="conid">List</span> A) <span class="keyglyph">→</span> <span class="conid">Sorted'</span> A <span class="keyword">record</span> <span class="conid">Sorted'</span> (<span class="varid">xs</span> <span class="keyglyph">:</span> <span class="conid">List</span> A) <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="keyword">field</span> <span class="varid">ys</span> <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="varid">isSorted</span> <span class="keyglyph">:</span> <span class="conid">IsSorted</span> <span class="varid">ys</span> <span class="varid">isPerm</span> <span class="keyglyph">:</span> <span class="conid">IsPermutation</span> <span class="varid">ys</span> <span class="varid">xs</span> </pre><p>While I was at it, I decided to add the third half of correctness: a bound on the runtime or computational complexity. In the end I was able to define: </p><pre class="agda"><span class="varid">insertion-sort</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">xs</span> <span class="keyglyph">→</span> (<span class="conid">Sorted</span> <span class="varid">xs</span>) <span class="varop">in-time</span> (<span class="varid">length</span> <span class="varid">xs</span> <span class="varop">*</span> <span class="varid">length</span> <span class="varid">xs</span>) <span class="varid">selection-sort</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">xs</span> <span class="keyglyph">→</span> (<span class="conid">Sorted</span> <span class="varid">xs</span>) <span class="varop">in-time</span> (<span class="varid">length</span> <span class="varid">xs</span> <span class="varop">*</span> <span class="varid">length</span> <span class="varid">xs</span>) <span class="varid">merge-sort</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">xs</span> <span class="keyglyph">→</span> (<span class="conid">Sorted</span> <span class="varid">xs</span>) <span class="varop">in-time</span> (<span class="varid">length</span> <span class="varid">xs</span> <span class="varop">*</span> <span class="varop">⌈log₂</span> <span class="varid">length</span> <span class="varid">xs</span> <span class="varop">⌉</span>) </pre><p>This was not as easy as I would have hoped. In this post I will not bore you with all the details, I'll just go over some of the highlights. The <a href="https://gist.github.com/twanvl/5635740">full code is on github</a>. </p><h2><a name="what-it-means-to-be-sorted"></a>What it means to be sorted </h2> <p>There are roughly two ways to define sorted lists that I know of: </p><ol><li> Parametrize the sorted list by a lower bound on the values it contains. For a cons cell the head should be smaller than the lower bound, and the tail should be larger than the head. This requires the type to have a smallest element, but you can adjoin -∞ with a new datatype.</li> <li> Parametrize the sorted list by a list of all values in it. For a cons cell require that the head is smaller than all the values in the tail.</li> </ol><p>Since I already need to parametrize by all values in the list to show that the sorted list contains a permutation of them, I went with the second approach: </p><pre class="agda"><span class="comment">-- A proof that x is less than all values in xs</span> <span class="keyword">data</span> <span class="keyglyph">_</span><span class="varop">≤*</span><span class="keyglyph">_</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="varop">[]</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">≤*</span> <span class="varop">[]</span> <span class="keyglyph">_</span>∷<span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">y</span> <span class="varid">ys</span>} <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="varop">≤</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">≤*</span> <span class="varid">ys</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">≤*</span> (<span class="varid">y</span> ∷ <span class="varid">ys</span>) <div class='empty-line'></div> <span class="comment">-- Proof that a list is sorted</span> <span class="keyword">data</span> <span class="conid">IsSorted</span> <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="varop">[]</span> <span class="keyglyph">:</span> <span class="conid">IsSorted</span> <span class="varop">[]</span> <span class="keyglyph">_</span>∷<span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">xs</span>} <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">≤*</span> <span class="varid">xs</span> <span class="keyglyph">→</span> <span class="conid">IsSorted</span> <span class="varid">xs</span> <span class="keyglyph">→</span> <span class="conid">IsSorted</span> (<span class="varid">x</span> ∷ <span class="varid">xs</span>) </pre><h2><a name="what-it-means-to-be-a-permutation"></a>What it means to be a permutation </h2> <p>To show that one list is a permutation of another I again used two data types. Suppose that we know that <tt><span class="varid">xs</span></tt> is a permutation of <tt><span class="varid">ys</span></tt>. Then when is <tt class='complex'><span class="varid">x</span> ∷ <span class="varid">xs</span></tt> a permutation of some list <tt><span class="varid">xys</span></tt>? Well, we can permute <tt><span class="varid">xs</span></tt> to <tt><span class="varid">ys</span></tt>, and insert <tt><span class="varid">x</span></tt> anywhere. I used <tt class='complex'><span class="varop">◂</span></tt> to denote this insertion, </p><pre class="agda"><span class="comment">-- x ◂ xs ≡ xys means that xys is equal to xs with x inserted somewhere</span> <span class="keyword">data</span> <span class="keyglyph">_</span><span class="varop">◂</span><span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="agda-ctor">here</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">xs</span>} <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">◂</span> <span class="varid">xs</span> <span class="varop">≡</span> (<span class="varid">x</span> ∷ <span class="varid">xs</span>) <span class="agda-ctor">there</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">y</span>} {<span class="varid">xs</span>} {<span class="varid">xys</span>} <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">◂</span> <span class="varid">xs</span> <span class="varop">≡</span> <span class="varid">xys</span>) <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">◂</span> (<span class="varid">y</span> ∷ <span class="varid">xs</span>) <span class="varop">≡</span> (<span class="varid">y</span> ∷ <span class="varid">xys</span>) </pre><pre class="agda"><span class="comment">-- Proof that a list is a permutation of another one</span> <span class="keyword">data</span> <span class="conid">IsPermutation</span> <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varop">[]</span> <span class="keyglyph">:</span> <span class="conid">IsPermutation</span> <span class="varop">[]</span> <span class="varop">[]</span> <span class="keyglyph">_</span>∷<span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">xs</span> <span class="varid">ys</span> <span class="varid">xys</span>} <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">◂</span> <span class="varid">ys</span> <span class="varop">≡</span> <span class="varid">xys</span>) <span class="keyglyph">→</span> (<span class="varid">ps</span> <span class="keyglyph">:</span> <span class="conid">IsPermutation</span> <span class="varid">xs</span> <span class="varid">ys</span>) <span class="keyglyph">→</span> <span class="conid">IsPermutation</span> (<span class="varid">x</span> ∷ <span class="varid">xs</span>) <span class="varid">xys</span> </pre><p>Now the <tt><span class="conid">Sorted</span></tt> data type has three components: the sorted list, a proof that it is sorted, and a proof that it is a permutation of the input. These parts are either all <tt class='complex'><span class="varop">[]</span></tt>, or they are all <tt class='complex'><span class="keyglyph">_</span>∷<span class="keyglyph">_</span></tt>. It turns out to be much nicer to combine the parts together, </p><pre class="agda"><span class="comment">-- Sorted permutations of a list</span> <span class="keyword">data</span> <span class="conid">Sorted</span> <span class="keyglyph">:</span> <span class="conid">List</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="varop">[]</span> <span class="keyglyph">:</span> <span class="conid">Sorted</span> <span class="varop">[]</span> <span class="varid">cons</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> {<span class="varid">xs</span> <span class="varid">xxs</span>} <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">◂</span> <span class="varid">xs</span> <span class="varop">≡</span> <span class="varid">xxs</span>) <span class="comment">-- inserting x somewhere into xs gives xxs</span> <span class="keyglyph">→</span> (<span class="varid">least</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">≤*</span> <span class="varid">xs</span>) <span class="comment">-- x is the smallest element of the list</span> <span class="keyglyph">→</span> (<span class="varid">rest</span> <span class="keyglyph">:</span> <span class="conid">Sorted</span> <span class="varid">xs</span>) <span class="comment">-- and we have also sorted xs</span> <span class="keyglyph">→</span> <span class="conid">Sorted</span> <span class="varid">xxs</span> </pre><p>Of course <tt><span class="conid">Sorted</span></tt> and <tt class='complex'><span class="conid">Sorted'</span></tt> are equivalent. </p><p>As an aside, these are all the ingredients necessary for proving </p><pre class="agda"><span class="varid">sorted-unique</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">xs</span>} <span class="keyglyph">→</span> (<span class="varid">ys</span> <span class="varid">zs</span> <span class="keyglyph">:</span> <span class="conid">Sorted</span> <span class="varid">xs</span>) <span class="keyglyph">→</span> <span class="varid">sorted-to-List</span> <span class="varid">ys</span> <span class="varop">≡</span> <span class="varid">sorted-to-List</span> <span class="varid">zs</span> </pre><h2><a name="a-monad-for-keeping-track-of-the-runtime"></a>A monad for keeping track of the runtime </h2> <p>To be able to reason about the runtime, as measured in the number of comparisons performed, I decided to use a monad. The type is simply </p><pre class="agda"><span class="keyword">data</span> <span class="keyglyph">_</span><span class="varop">in-time</span><span class="keyglyph">_</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>) (<span class="varid">n</span> <span class="keyglyph">:</span> <span class="conop">ℕ</span>) <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">box</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> C A <span class="varid">n</span> </pre><p>the constructor <tt><span class="varid">box</span></tt> is private, and it can only be accessed through the standard monad operations, </p><pre class="agda"><span class="varid">return</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A <span class="varid">n</span>} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> A <span class="varop">in-time</span> <span class="varid">n</span> <div class='empty-line'></div> <span class="keyglyph">_</span><span class="varop">&gt;&gt;=</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A B} {<span class="varid">m</span> <span class="varid">n</span>} <span class="keyglyph">→</span> A <span class="varop">in-time</span> <span class="varid">n</span> <span class="keyglyph">→</span> (A <span class="keyglyph">→</span> B <span class="varop">in-time</span> <span class="varid">m</span>) <span class="keyglyph">→</span> B <span class="varop">in-time</span> (<span class="varid">n</span> <span class="varop">+</span> <span class="varid">m</span>) </pre><p>Then the sorting functions will be parametrized by a function that for some partial order decides between <tt class='complex'><span class="varid">x</span> <span class="varop">≤</span> <span class="varid">y</span></tt> and <tt class='complex'><span class="varid">y</span> <span class="varop">≤</span> <span class="varid">x</span></tt> in one step, using the monad we defined above: </p><pre class="agda"><span class="keyword">module</span> <span class="conid">Sorting</span> {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>} {<span class="varid">l</span>} {<span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="conid">Rel</span> A <span class="varid">l</span>} (<span class="varid">isPartialOrder</span> <span class="keyglyph">:</span> <span class="conid">IsPartialOrder</span> <span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> <span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span>) (<span class="keyglyph">_</span><span class="varop">≤?</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="varop">≤</span> <span class="varid">y</span> <span class="conop">⊎</span> <span class="varid">y</span> <span class="varop">≤</span> <span class="varid">x</span>) <span class="varop">in-time</span> <span class="num">1</span>) <span class="keyword">where</span> <span class="varop">...</span> </pre><p>Note that I specify that <tt class='complex'><span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span></tt> is a <em>partial</em> order, because the Agda standard library definition of a total order actually comes with a function </p><pre class="agda"><span class="varid">total</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="varop">≤</span> <span class="varid">y</span>) <span class="conop">⊎</span> (<span class="varid">y</span> <span class="varop">≤</span> <span class="varid">x</span>) </pre><p>which would defeat the whole prupose of <tt class='complex'><span class="keyglyph">_</span><span class="varop">≤?</span><span class="keyglyph">_</span></tt>. In fact, the standard <tt><span class="conid">TotalOrder</span></tt>s are decidable up to base equality, and if the base equality is propositional equality, then they are decidable. I.e. </p><pre class="agda"><span class="varid">total-decidable</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">r</span>} {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="keyglyph">→</span> (<span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="conid">Rel</span> A <span class="varid">r</span>) <span class="keyglyph">→</span> <span class="conid">IsTotalOrder</span> <span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> <span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="conid">IsDecTotalOrder</span> <span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> <span class="keyglyph">_</span><span class="varop">≤</span><span class="keyglyph">_</span> </pre><p>See the source for the proof of this side theorem. It relies on a trick to show that <tt class='complex'><span class="varid">total</span> <span class="varid">x</span> <span class="varid">y</span></tt> can only be different from <tt class='complex'><span class="varid">total</span> <span class="varid">y</span> <span class="varid">x</span></tt> if <tt class='complex'><span class="varid">x</span> <span class="varop">≢</span> <span class="varid">y</span></tt>. Which holds for propositional equality, but not in general. </p><h2><a name="logarithms"></a>Logarithms </h2> <p>To be able to complete the specification of merge sort, we still need to add some missing functions on natural numbers. In particular, we need a logarithm. This logarithm turns out to be surprisingly tricky to define in Agda. Why? Because the usual definition uses non-structural recursion. In haskell you would write </p><pre class="haskell"><span class="comment">-- @log n@ calculates ⌊log₂ (n+1)⌋</span> <span class="varid">log</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">log</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="num">1</span> <span class="varop">+</span> <span class="varid">log</span> (<span class="varid">n</span> <span class="varop">`div`</span> <span class="num">2</span>) </pre><p>But Agda is not able to see that <tt class='complex'><span class="varid">n</span> <span class="varop">`div`</span> <span class="num">2</span></tt> (or in agda notation, <tt class='complex'>⌊ <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋</tt>) is smaller than <tt><span class="varid">n</span></tt>. There are two approaches to circumvent this problem: </p><ol><li> Use a different algorithm: Convert <tt><span class="varid">n</span></tt> to a binary representation, and count the number of digits.</li> <li> Use well-founded recursion, manually supplying a proof that <tt class='complex'>⌊ <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋ <span class="varop">&lt;</span> <span class="varid">n</span></tt>.</li> </ol><p>I went with the second option, because I will also be using the same shape of recursion inside merge sort itself. The standard way to use well-founded recursion is through the function <tt class='complex'><span class="keyglyph">&lt;-</span><span class="varid">rec</span></tt>, which works a bit like <tt><span class="varid">fix</span></tt> in haskell, except that you need to pass in a proof that the argument is smaller. The code would look like this: </p><pre class="haskell"><span class="varid">log</span> <span class="keyglyph">=</span> <span class="keyglyph">&lt;-</span><span class="varid">rec</span> <span class="varid">log'</span> <span class="keyword">where</span> <span class="varid">log</span>′ <span class="varid">self</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">log</span>′ <span class="varid">self</span> (<span class="varid">suc</span> <span class="varid">n</span>) <span class="keyglyph">=</span> <span class="num">1</span> <span class="varop">+</span> <span class="varid">self</span> ⌊ <span class="varid">suc</span> <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋ (<span class="comment">{-proof ommitted-}</span>) </pre><p>But this leads to a problem as soon as you want to prove a property of logarithms. For example, you would think that <tt class='complex'><span class="varid">log</span> (<span class="varid">suc</span> <span class="varid">n</span>) ≡ <span class="num">1</span> <span class="varop">+</span> (<span class="varid">log</span> ⌊ <span class="varid">suc</span> <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋)</tt>. But that is not definitionally true, since one <tt class='complex'><span class="keyglyph">&lt;-</span><span class="varid">rec</span></tt> is not like another. I found that the well-founded recursion library was in general a pain to work with, especially because it uses so many type synonyms. My solution was to use the slightly lower level accessibility relation. A value of type <tt class='complex'><span class="conid">Acc</span> <span class="varid">_</span><span class="varop">&lt;</span>′<span class="varid">_</span> <span class="varid">n</span></tt> allows you to do recursion with any <tt class='complex'><span class="varid">m</span> <span class="varop">&lt;</span>′ <span class="varid">n</span></tt>. Now I can use actual recursion: </p><pre class="haskell"><span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span> <span class="listcon">:</span> ∀ <span class="varid">n</span> → <span class="conid">Acc</span> <span class="varid">_</span><span class="varop">&lt;</span>′<span class="varid">_</span> <span class="varid">n</span> → <span class="conid">ℕ</span> <span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span> <span class="num">0</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span> (<span class="varid">suc</span> <span class="varid">n</span>) (<span class="varid">acc</span> <span class="varid">more</span>) <span class="keyglyph">=</span> <span class="num">1</span> <span class="varop">+</span> <span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span> ⌊ <span class="varid">suc</span> <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋ (<span class="varid">more</span> <span class="varid">_</span> <span class="comment">{-proof ommitted-}</span>) </pre><p>And use the well-foundedness of ℕ to get an <tt><span class="conid">Acc</span></tt> for any number: </p><pre class="haskell"><span class="varid">log</span> <span class="listcon">:</span> <span class="conid">ℕ</span> → <span class="conid">ℕ</span> <span class="varid">log</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span> <span class="varid">n</span> (<span class="keyglyph">&lt;-</span><span class="varid">well</span><span class="varop">-</span><span class="varid">founded</span> <span class="varid">n</span>) <div class='empty-line'></div> ⌈<span class="varid">log₂_</span>⌉ <span class="listcon">:</span> <span class="conid">ℕ</span> → <span class="conid">ℕ</span> ⌈<span class="varid">log₂</span> <span class="varid">n</span> ⌉ <span class="keyglyph">=</span> <span class="varid">log</span> (<span class="varid">pred</span> <span class="varid">n</span>) </pre><p>There is still a snag when proving properties of <tt><span class="varid">log</span></tt> or <tt class='complex'><span class="varid">log</span><span class="varop">-</span><span class="varid">acc</span></tt>, namely that you need to prove that <tt class='complex'>(<span class="varid">more</span> <span class="varid">n</span> <span class="varop">...</span>) ≡ <span class="keyglyph">&lt;-</span><span class="varid">well</span><span class="varop">-</span><span class="varid">founded</span> <span class="varid">n</span></tt>. But the accessibility relation doesn't actually matter for the computation, so I decided to just postulate </p><pre class="haskell"><span class="varid">postulate</span> <span class="varid">acc</span><span class="varop">-</span><span class="varid">irrelevance</span> <span class="listcon">:</span> ∀ {<span class="varid">n</span> <span class="listcon">:</span> <span class="conid">ℕ</span>} → {<span class="varid">a</span> <span class="varid">b</span> <span class="listcon">:</span> <span class="conid">Acc</span> <span class="varid">_</span><span class="varop">&lt;</span>′<span class="varid">_</span> <span class="varid">n</span>} → <span class="varid">a</span> ≡ <span class="varid">b</span> <span class="comment">-- this also follows from function extensionality</span> </pre><p>If anyone knows a better way to prove properties of functions defined with well-founded recursion, I am open to suggestions. </p><h2><a name="vectors-versus-lists"></a>Vectors versus lists </h2> <p>While working on the proofs I had to choose: Do I use fixed length <tt><span class="conid">Vec</span></tt>s or variable length <tt><span class="conid">List</span></tt>s? Both have their pros and cons. </p><p>On the one hand, the sorting functions with vectors look a bit nicer, because we can use <tt><span class="varid">n</span></tt> instead of <tt class='complex'><span class="varid">length</span> <span class="varid">xs</span></tt>: </p><pre class="haskell"><span class="varid">merge</span><span class="varop">-</span><span class="varid">sort</span> <span class="listcon">:</span> ∀ {<span class="varid">n</span>} (<span class="varid">xs</span> <span class="listcon">:</span> <span class="conid">Vec</span> <span class="conid">A</span> <span class="varid">n</span>) → <span class="conid">Sorted</span> <span class="varid">xs</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> (<span class="varid">n</span> <span class="varop">*</span> ⌈<span class="varid">log₂</span> <span class="varid">n</span> ⌉) </pre><p>Additionally, with lists we can only do recursion on the input list, with vectors we can do recursion on the length of the list. The former works fine for insertion sort, where in each step you do something with the head element of the list; but it fails for selection and merge sort. </p><p>On the other hand, with vectors you sometimes can't even <em>state</em> the property that one vector is equal to another. For the term <tt class='complex'><span class="varid">xs</span> ≡ <span class="varid">ys</span> <span class="varop">++</span> <span class="varid">zs</span></tt> to be well-typed, <tt><span class="varid">xs</span></tt> must have the type <tt class='complex'><span class="conid">Vec</span> <span class="conid">A</span> (<span class="varid">m</span> <span class="varop">+</span> <span class="varid">n</span>)</tt>. </p><p>I went back and forth a couple of times between vectors and lists. In the end I settled for using vectors only when needed, and specifying properties in terms of lists. For example the split function for merge sort has the type </p><pre class="haskell"><span class="varid">splitHalf</span> <span class="listcon">:</span> ∀ {<span class="varid">n</span>} → (<span class="varid">xs</span> <span class="listcon">:</span> <span class="conid">Vec</span> <span class="conid">A</span> <span class="varid">n</span>) → ∃₂ <span class="keyglyph">\</span>(<span class="varid">ys</span> <span class="listcon">:</span> <span class="conid">Vec</span> <span class="conid">A</span> ⌈ <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌉) (<span class="varid">zs</span> <span class="listcon">:</span> <span class="conid">Vec</span> <span class="conid">A</span> ⌊ <span class="varid">n</span> <span class="varop">/</span><span class="num">2</span>⌋) → <span class="varid">toList</span> <span class="varid">ys</span> <span class="varop">++</span> <span class="varid">toList</span> <span class="varid">zs</span> ≡ <span class="varid">toList</span> <span class="varid">xs</span> </pre><p>So instead of using <tt class='complex'><span class="conid">Vec</span><span class="varop">.</span><span class="varid">_</span><span class="varop">++</span><span class="varid">_</span></tt>, I use <tt class='complex'><span class="conid">List</span><span class="varop">.</span><span class="varid">_</span><span class="varop">++</span><span class="varid">_</span></tt>. In this style 'select' from selection sort looks like </p><pre class="haskell"><span class="varid">select</span> <span class="listcon">:</span> ∀ {<span class="varid">n</span>} (<span class="varid">xs</span> <span class="listcon">:</span> <span class="conid">Vec</span> <span class="conid">A</span> (<span class="varid">suc</span> <span class="varid">n</span>)) → (∃₂ <span class="keyglyph">\</span><span class="varid">y</span> <span class="varid">ys</span> → (<span class="varid">y</span> ◂ <span class="varid">toList</span> <span class="varid">ys</span> ≡ <span class="varid">toList</span> <span class="varid">xs</span>) × (<span class="varid">y</span> ≤<span class="varop">*</span> <span class="varid">toList</span> <span class="varid">ys</span>)) <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">n</span> </pre><p>I.e. given a <em>vector</em> <tt><span class="varid">xs</span></tt> with <tt class='complex'><span class="varid">n</span><span class="varop">+</span><span class="num">1</span></tt> elements, return a vector <tt><span class="varid">ys</span></tt> with <tt><span class="varid">n</span></tt> elements, such that inserting <tt><span class="varid">y</span></tt> into it gives us back <tt><span class="varid">xs</span></tt>. And this item <tt><span class="varid">y</span></tt> should be the smallest one. </p><h2><a name="extension-expected-runtime"></a>Extension: expected runtime </h2> <p>An extension of this post would be to look at randomized sorting algorithms. In particular, quick sort with a randomly chosen pivot has expected runtime <tt class='complex'><span class="conid">O</span>(<span class="varid">n</span> <span class="varop">*</span> <span class="varid">log</span> <span class="varid">n</span>)</tt>. At first I thought that all that would be needed is a function </p><pre class="haskell"><span class="varid">expected</span> <span class="listcon">:</span> ∀ {<span class="conid">P</span>} → (<span class="varid">ns</span> <span class="listcon">:</span> <span class="conid">List</span> <span class="conid">ℕ</span>) <span class="comment">-- A list of numbers</span> → <span class="conid">All</span> (<span class="keyglyph">\</span><span class="varid">n</span> → <span class="conid">P</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">n</span>) <span class="varid">ns</span> <span class="comment">-- for each n we have P in-time n</span> → <span class="conid">P</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> ⌈<span class="varid">mean</span> <span class="varid">ns</span> ⌉ <span class="comment">-- then expect time is mean of ns</span> </pre><p>But that is not quite right, since if we actually knew the runtimes <tt><span class="varid">ns</span></tt> we could just pick the fastest one. With the randomized quicksort you will end up in a situation where you have two or more computations to choose from, and you know that some are faster than the others, but you don't yet know which one. That sounds a bit classical. A second idea is to return the runtimes at a later time, something like </p><pre class="haskell"><span class="varid">expected</span> <span class="listcon">:</span> ∀ {<span class="conid">P</span>} {<span class="varid">long</span><span class="varop">-</span><span class="varid">time</span>} → (<span class="varid">xs</span> <span class="listcon">:</span> <span class="conid">List</span> (<span class="keyglyph">\</span><span class="varid">ex</span> <span class="varid">n</span> <span class="conid">P</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">n</span>) <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">long</span><span class="varop">-</span><span class="varid">time</span>) → <span class="conid">P</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> ⌈<span class="varid">mean</span> <span class="varid">map</span> <span class="varid">proj1</span> <span class="varid">xs</span> ⌉ </pre><p>But this is not quite right either, since after <tt class='complex'><span class="varid">long</span><span class="varop">-</span><span class="varid">time</span></tt> computing <tt><span class="conid">P</span></tt> (i.e. a sorting) can be done in 0 time. Rather, we need to decouple the proof about the runtime from the computation. This is not possible with the <tt class='complex'><span class="varid">_in</span><span class="varop">-</span><span class="varid">time_</span></tt> monad. We would need to get rid of the runtime from the type, and store it as a value instead. </p><p>I have tried redoing the proofs in this post with the monad </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Timed</span> (<span class="conid">A</span> <span class="listcon">:</span> <span class="conid">Set</span>) <span class="listcon">:</span> <span class="conid">Set</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">_in</span><span class="varop">-</span><span class="varid">time_</span> <span class="listcon">:</span> <span class="conid">A</span> → <span class="conid">ℕ</span> → <span class="conid">Timed</span> <span class="conid">A</span> <span class="varid">runtime</span> <span class="listcon">:</span> <span class="conid">Timed</span> <span class="conid">A</span> → <span class="conid">ℕ</span> </pre><p>But I didn't succeed; I ended up with the baffling error message </p><pre class="haskell"><span class="varid">runtime</span> (<span class="varid">big</span><span class="varop">-</span><span class="varid">lambda</span><span class="varop">-</span><span class="varid">term</span> (<span class="varid">unbox</span> (<span class="varid">x</span> ≤? <span class="varid">u</span>))) <span class="varop">!=</span> <span class="varid">runtime</span> (<span class="varid">big</span><span class="varop">-</span><span class="varid">lambda</span><span class="varop">-</span><span class="varid">term</span> (<span class="varid">unbox</span> (<span class="varid">x</span> ≤? <span class="varid">u</span>))) </pre><h2><a name="another-extension-lower-bound-on-runtime"></a>Another extension: lower bound on runtime </h2> <p>So far I have proved that you can sort a list in time <tt class='complex'><span class="varid">n</span> <span class="varop">*</span> <span class="varid">log</span> <span class="varid">n</span></tt>. It would also be interesting to look at the well known <a href="http://planetmath.org/LowerBoundForSorting">lower bound on the runtime of sorting</a>, and prove a theorem such as </p><pre class="haskell"><span class="varid">can't</span><span class="varop">-</span><span class="varid">sort</span><span class="varop">-</span><span class="keyword">in</span><span class="varop">-</span><span class="varid">linear</span><span class="varop">-</span><span class="varid">time</span> <span class="listcon">:</span> ¬ ∃ <span class="keyglyph">\</span><span class="varid">k</span> → ∀ <span class="varid">xs</span> → <span class="conid">Sorted</span> <span class="varid">xs</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">k</span> <span class="varop">*</span> <span class="varid">length</span> <span class="varid">xs</span> </pre><p>unfortunately this statement is not actually true for all types. For finite sets you actually <em>can</em> sort in linear time with counting sort. It also fails if we happen to have some decidable total order for that type lying around. But it might be possible to prove </p><pre class="haskell"><span class="varid">can't</span><span class="varop">-</span><span class="varid">sort</span><span class="varop">-</span><span class="keyword">in</span><span class="varop">-</span><span class="varid">linear</span><span class="varop">-</span><span class="varid">time</span> <span class="listcon">:</span> (<span class="varid">no</span><span class="varop">-</span><span class="varid">fast</span><span class="varop">-</span><span class="varid">compare</span> <span class="listcon">:</span> ∀ <span class="varid">x</span> <span class="varid">y</span> → (<span class="varid">x</span> ≤ <span class="varid">y</span> ⊎ <span class="varid">y</span> ≤ <span class="varid">x</span>) <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="num">0</span> → <span class="varid">x</span> ≡ <span class="varid">y</span>) → ¬ ∃ <span class="keyglyph">\</span><span class="varid">k</span> → ∀ <span class="varid">xs</span> → <span class="conid">Sorted</span> <span class="varid">xs</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="varid">k</span> <span class="varop">*</span> <span class="varid">length</span> <span class="varid">xs</span> </pre><p>But you have to be really careful with a term like <tt class='complex'><span class="varid">no</span><span class="varop">-</span><span class="varid">fast</span><span class="varop">-</span><span class="varid">compare</span></tt>, because inside the runtime monad we do have values of type <tt class='complex'>(<span class="varid">x</span> ≤ <span class="varid">y</span> ⊎ <span class="varid">y</span> ≤ <span class="varid">x</span>)</tt>. And so you can derive <tt class='complex'>∀ <span class="varid">x</span> <span class="varid">y</span> → <span class="varid">x</span> ≡ <span class="varid">y</span> <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="num">1</span></tt>, and therefore also <tt class='complex'>⊥ <span class="keyword">in</span><span class="varop">-</span><span class="varid">time</span> <span class="num">1</span></tt> for non trivial types. Which certainly looks wrong to me. </p><p>I don't know a way around this problem, but it might be related to the same issue as expected runtime. I.e. the problem is that all information about the runtime is bundled together with the return value. The lower bound proof essentially asks to sort a 'random' list, and by a counting argument shows that at least a certain number of comparisons are needed to be able to produce all outputs. </p> Categories over pairs of types http://twanvl.nl/blog/haskell/categories-over-pairs-of-types 2012-07-26T19:33:00Z <p>Today <a href="http://unknownparallel.wordpress.com/2012/07/26/pipes-and-conduits-part-2-upstream-results/">Dan Burton remarked that</a> Pipe is a category-like thing, and to express it we would need "type bundling". I myself <a href="blog/haskell/results-of-upstream-pipes">said something similar</a> a while ago. More formally, rather than a category where the objects are Haskell types, we have a category where the objects are pairs of types. </p><p>It turns out that with a bunch of recent Ghc extensions we <em>can</em> actually write this in Haskell. </p><pre class="haskell"><span class="pragma">{-# LANGUAGE PolyKinds, DataKinds, KindSignatures #-}</span> <span class="pragma">{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}</span> </pre><p>For the purposes of this blogpost I'll use a dummy type for <tt><span class="conid">Pipe</span></tt>, there are plenty of other blog posts that give an actually functional one. The important thing to note is that in the type of <tt class='complex'>(<span class="varop">&gt;+&gt;</span>)</tt>, there are two types that are composed over, input/output <tt><span class="varid">io</span></tt> and upstream/downstream result <tt><span class="varid">ur</span></tt>. </p><pre class="haskell"><span class="comment">-- Ceci n'est pas une pipe</span> <span class="keyword">data</span> <span class="conid">Pipe</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">u</span> <span class="varid">m</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> { <span class="varid">runPipe</span> <span class="keyglyph">::</span> <span class="conid">Either</span> <span class="varid">i</span> <span class="varid">u</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> (<span class="conid">Either</span> <span class="varid">o</span> <span class="varid">r</span>) } <div class='empty-line'></div> (<span class="varop">&gt;+&gt;</span>) <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Pipe</span> <span class="varid">io<sub>1</sub></span> <span class="varid">io<sub>2</sub></span> <span class="varid">ur<sub>1</sub></span> <span class="varid">m</span> <span class="varid">ur<sub>2</sub></span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">io<sub>2</sub></span> <span class="varid">io<sub>3</sub></span> <span class="varid">ur<sub>2</sub></span> <span class="varid">m</span> <span class="varid">ur<sub>3</sub></span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">io<sub>1</sub></span> <span class="varid">io<sub>3</sub></span> <span class="varid">ur<sub>1</sub></span> <span class="varid">m</span> <span class="varid">ur<sub>3</sub></span> (<span class="varop">&gt;+&gt;</span>) (<span class="conid">Pipe</span> <span class="varid">f</span>) (<span class="conid">Pipe</span> <span class="varid">g</span>) <span class="keyglyph">=</span> <span class="conid">Pipe</span> (<span class="varid">f</span> <span class="varop">&gt;=&gt;</span> <span class="varid">g</span>) <div class='empty-line'></div> <span class="varid">idP</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Pipe</span> <span class="varid">i</span> <span class="varid">i</span> <span class="varid">r</span> <span class="varid">m</span> <span class="varid">r</span> <span class="varid">idP</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> <span class="varid">return</span> </pre><p>With the <tt><span class="conid">PolyKinds</span></tt> extension we can make a variant of <tt><span class="conid">Category</span></tt> that works for tuples of types as well as for normal types. This class looks exactly the same as the normal one: </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Category</span> <span class="varid">cat</span> <span class="keyword">where</span> <span class="varid">id</span> <span class="keyglyph">::</span> <span class="varid">cat</span> <span class="varid">a</span> <span class="varid">a</span> (<span class="varop">.</span>) <span class="keyglyph">::</span> <span class="varid">cat</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">cat</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">cat</span> <span class="varid">a</span> <span class="varid">c</span> </pre><p>But because of <tt><span class="conid">PolyKinds</span></tt> it magically becomes more general. You can see this by comparing their kinds </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="listcon">:</span><span class="varid">kind</span> <span class="conid">Category</span> <span class="conid">Category</span> <span class="keyglyph">::</span> (<span class="conid">AnyK</span> <span class="keyglyph">-&gt;</span> <span class="conid">AnyK</span> <span class="keyglyph">-&gt;</span> <span class="varop">*</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Constraint</span> <span class="input">λ&gt;</span> <span class="listcon">:</span><span class="varid">kind</span> <span class="conid">Control.Category.Category</span> <span class="conid">Control.Category.Category</span> <span class="keyglyph">::</span> (<span class="varop">*</span> <span class="keyglyph">-&gt;</span> <span class="varop">*</span> <span class="keyglyph">-&gt;</span> <span class="varop">*</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Constraint</span> </pre><p>With <tt><span class="conid">DataKinds</span></tt> it becomes possible to have tuples of types, which are written as <tt class='complex'><span class="varop">'</span>(<span class="conid">Type1</span>,<span class="conid">Type2</span>)</tt>. Unfortunately we can not (yet?) pattern match on these directly in data declarations. So we need type families to unwrap them: </p><pre class="haskell"><span class="keyword">type family</span> <span class="conid">Fst</span> (<span class="varid">xy</span> <span class="keyglyph">::</span> (<span class="varop">*</span>,<span class="varop">*</span>)) <span class="keyglyph">::</span> <span class="varop">*</span> <span class="keyword">type family</span> <span class="conid">Snd</span> (<span class="varid">xy</span> <span class="keyglyph">::</span> (<span class="varop">*</span>,<span class="varop">*</span>)) <span class="keyglyph">::</span> <span class="varop">*</span> <span class="keyword">type</span> <span class="keyword">instance</span> <span class="conid">Fst</span> <span class="varop">'</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="keyglyph">=</span> <span class="varid">x</span> <span class="keyword">type</span> <span class="keyword">instance</span> <span class="conid">Snd</span> <span class="varop">'</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="keyglyph">=</span> <span class="varid">y</span> </pre><p>Note that the kind signatures are necessary. Without them Ghc will give errors like </p><pre>Couldn't match kind `BOX' against `*' </pre><p>With these type functions in hand we can write </p><pre class="haskell"><span class="keyword">newtype</span> <span class="conid">WrapPipe</span> <span class="varid">m</span> <span class="varid">iu</span> <span class="varid">or</span> <span class="keyglyph">=</span> <span class="conid">WrapPipe</span> { <span class="varid">unWrapPipe</span> <span class="keyglyph">::</span> <span class="conid">Pipe</span> (<span class="conid">Fst</span> <span class="varid">iu</span>) (<span class="conid">Fst</span> <span class="varid">or</span>) (<span class="conid">Snd</span> <span class="varid">iu</span>) <span class="varid">m</span> (<span class="conid">Snd</span> <span class="varid">or</span>) } <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Category</span> (<span class="conid">WrapPipe</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">id</span> <span class="keyglyph">=</span> <span class="conid">WrapPipe</span> <span class="varid">idP</span> <span class="varid">x</span> <span class="varop">.</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">WrapPipe</span> (<span class="varid">unWrapPipe</span> <span class="varid">y</span> <span class="varop">&gt;+&gt;</span> <span class="varid">unWrapPipe</span> <span class="varid">x</span>) </pre><p>And that's it. We now have a category whose objects are not Haskell types, but rather pairs of Haskell types. In Ghc's terms, an instance of <tt class='complex'><span class="conid">Category</span> (<span class="varop">*</span>,<span class="varop">*</span>)</tt> instead of <tt class='complex'><span class="conid">Category</span> <span class="varop">*</span></tt>. The kind parameter is why we need <tt><span class="conid">MultiParamTypeClasses</span></tt>. </p><p>With this same trick we can also define <tt><span class="conid">Category</span></tt> instances for product categories and lens families. Or going the other way, you can wrap <tt><span class="conid">Monoids</span></tt> as a <tt><span class="conid">Category</span></tt> over objects of kind <tt class='complex'>()</tt>. You could even go one step further and have a category for lists of functions of different types. </p><p>There is a big downside, however. And that is that the type inference engine is not able to see past the type families. You need to give an explicit type annotation on the wrapped pipe. Compare </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="keyword">type</span> <span class="conid">MyWPipe</span> <span class="keyglyph">=</span> <span class="conid">WrapPipe</span> <span class="conid">IO</span> <span class="varop">'</span>(<span class="conid">Int</span>,<span class="conid">String</span>) <span class="varop">'</span>(<span class="conid">Int</span>,<span class="conid">String</span>) <span class="input">λ&gt;</span> <span class="varid">runPipe</span> (<span class="varid">unWrapPipe</span> (<span class="varid">id</span> <span class="varop">.</span> <span class="varid">id</span> <span class="keyglyph">::</span> <span class="conid">MyWPipe</span>)) <span class="varop">\$</span> <span class="conid">Right</span> <span class="str">&quot;done&quot;</span> <span class="conid">Right</span> <span class="str">&quot;done&quot;</span> </pre><p>with </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="keyword">type</span> <span class="conid">MyPipe</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> <span class="conid">Int</span> <span class="conid">Int</span> <span class="conid">String</span> <span class="conid">IO</span> <span class="conid">String</span> <span class="input">λ&gt;</span> <span class="varid">runPipe</span> (<span class="varid">unWrapPipe</span> (<span class="varid">id</span> <span class="varop">.</span> <span class="varid">id</span>) <span class="keyglyph">::</span> <span class="conid">MyPipe</span>) <span class="varop">\$</span> <span class="conid">Right</span> <span class="str">&quot;done&quot;</span> <span class="input">&lt;interactive&gt;</span><span class="listcon">:</span><span class="num">2</span><span class="listcon">:</span><span class="num">10</span><span class="conop">:</span> <span class="conid">Couldn't</span> <span class="varid">match</span> <span class="keyword">type</span> `<span class="conid">Fst</span> <span class="varid">or0'</span> <span class="varid">with</span> `<span class="conid">Int'</span> <span class="varid">blah</span>, <span class="varid">blah</span>, <span class="varid">blah</span>, <span class="varid">etc</span><span class="varop">.</span> </pre><p>This makes sense, since Ghc doesn't know that there are no other instances of <tt><span class="conid">Fst</span></tt> and <tt><span class="conid">Snd</span></tt>. Ideally we would like to write </p><pre class="ghci"><span class="keyword">newtype</span> <span class="conid">WrapPipe</span> <span class="varid">m</span> <span class="varop">'</span>(<span class="varid">i</span>,<span class="varid">u</span>) <span class="varop">'</span>(<span class="varid">o</span>,<span class="varid">r</span>) <span class="keyglyph">=</span> <span class="conid">WrapPipe</span> { <span class="varid">unWrapPipe</span> <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">u</span> <span class="varid">m</span> <span class="varid">r</span> } </pre> Benchmark: unpacked values in containers http://twanvl.nl/blog/haskell/benchmarking-unpacked-containers 2012-06-08T21:59:00Z <p>Inspired by <a href="http://www.haskell.org/pipermail/glasgow-haskell-users/2012-March/022079.html">a discussion on the ghc mailing list</a>, I wondered how much performance can be gained by specializing and unboxing certain data types. In particular, I looked at <tt class='complex'><span class="conid">Data.Map</span></tt>. Suppose that you have a map from ints to ints. First of all, you should be using <tt class='complex'><span class="conid">Data.IntMap</span></tt> instead, but that is besides the point. </p><p>If you know that the keys and values are always strict integers, then the data type could be specialized from </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Map</span> <span class="varid">k</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Bin</span> <span class="pragma">{-# UNPACK #-}</span> <span class="varop">!</span><span class="conid">Size</span> <span class="varop">!</span><span class="varid">k</span> <span class="varid">a</span> <span class="varop">!</span>(<span class="conid">Map</span> <span class="varid">k</span> <span class="varid">a</span>) <span class="varop">!</span>(<span class="conid">Map</span> <span class="varid">k</span> <span class="varid">a</span>) <span class="keyglyph">|</span> <span class="conid">Tip</span> </pre><p>to </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">MapIntInt</span> <span class="keyglyph">=</span> <span class="conid">Tip</span> <span class="keyglyph">|</span> <span class="conid">Bin</span> <span class="pragma">{-# UNPACK #-}</span> <span class="varop">!</span><span class="conid">Size</span> <span class="pragma">{-# UNPACK #-}</span> <span class="varop">!</span><span class="conid">Int</span> <span class="pragma">{-# UNPACK #-}</span> <span class="varop">!</span><span class="conid">Int</span> <span class="varop">!</span>(<span class="conid">MapIntInt</span>) <span class="varop">!</span>(<span class="conid">MapIntInt</span>) </pre><p>It would be great if this could be generated automatically by the compiler. But as was pointed out, that is really hard to do, because the size of the constructors would change, depending on the type arguments. So generic functions become impossible. It would also require multiple different info tables for the garbage collector, among other problems. </p><p>So, it's probably easier to do this specialization manually. I was thinking of using template haskell, in combination with type families. This would allow you to write something like </p><pre class="haskell"><span class="varid">deriveSpecializedUnboxedType</span> <span class="listcon">[</span><span class="varid">d</span><span class="keyglyph">|</span><span class="keyword">type</span> <span class="conid">UnboxedMapIntInt</span> <span class="keyglyph">=</span> <span class="conid">Map</span> <span class="varop">!</span><span class="conid">Int</span> <span class="varop">!</span><span class="conid">Int</span> <span class="listcon">|]</span> </pre><p>but before going there, let's first see whether this is worth the effort at all. </p><p>So, I did the specialization by hand for <tt class='complex'><span class="conid">Map</span> <span class="conid">Int</span> <span class="conid">Int</span></tt>, and ran the containers benchmarks. Here is a representative part of the results, <br><a href="files/bench-MapIntInt.html"><img src="image/benchmark-MapIntInt.png" style="margin:.1em 1em;"></a><br> click for full the criterion report. The horribly hacky code is available <a href="https://github.com/twanvl/containers/blob/specialize/benchmarks/MapIntInt.hs">on github</a>. </p><p>In this graph </p><ul><li> generic = generic <tt class='complex'><span class="conid">Map</span> <span class="conid">Int</span> <span class="conid">Int</span></tt>.</li> <li> unboxed = <tt><span class="conid">Map</span></tt> with both key and value specialized to strict and unpacked <tt><span class="conid">Int</span></tt>.</li> <li> gintmap = value generic <tt class='complex'><span class="conid">IntMap</span> <span class="conid">Int</span></tt></li> <li> uintmap = <tt><span class="conid">IntMap</span></tt> with values specialized to unpacked <tt><span class="conid">Int</span></tt>.</li> </ul><p>As you can see, specializing and unboxing gives a modest performance improvement. There is probably also an improvement in memory usage, but this benchmark doesn't directly measure that. Switching to a better data structure, i.e. patricia tries instead of balanced trees helps a lot more for some benchmarks, such as <tt><span class="varid">delete</span></tt>, but very little for others such as <tt><span class="varid">map</span></tt>. </p><p>Overall, it seems like specialization can definitely be worth it; in some cases improving performance by 40%. And it never has a negative impact, at least in this benchmark. Real life might be different though, especially if there are also Maps with other types of keys and values around. </p><p>Note also that this benchmark was compiled for a 32-bit architecture. On 64-bit, pointers and hence boxed values have more overhead. </p> Building pipes with monad transformers http://twanvl.nl/blog/haskell/building-pipes-with-monad-transformers 2012-06-02T23:32:00Z <p>In this post I show another way to implement pipes, by combining a producer and consumer monad transformer. This implementation is for educational and entertainment purposes only: you probably shouldn't try to use it in production software. To quote Donald Knuth: I have only proved it correct, not tried it. One obvious thing that is missing is finalization, but that could be added by passing along a finalizer with each call to <tt><span class="varid">yield</span></tt>, <a href="http://www.haskellforall.com/2012/05/pipes-20-pipe-finalization.html">as described by Gabriel Gonzalez</a>. </p><h2><a name="producers"></a>Producers </h2> <p>Let's start with producers. A producer can produce a stream of values of type <tt><span class="varid">o</span></tt>, and then ends with a value of type <tt><span class="varid">a</span></tt>. At each step, it performs a monad action. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">ProducerT'</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">a</span> <span class="keyglyph">|</span> <span class="conid">More</span> <span class="varid">o</span> (<span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span>) <span class="keyword">newtype</span> <span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> { <span class="varid">runProducerT</span> <span class="keyglyph">::</span> <span class="varid">m</span> (<span class="conid">ProducerT'</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span>) } </pre><p>This monad transformer is similar to <a href="http://www.haskell.org/haskellwiki/ListT_done_right">the ListT-done-right monad transformer</a>. The difference is that the producer has a value at the end, while <tt><span class="conid">ListT</span></tt> ends with an empty list. More importantly, <tt><span class="conid">ListT</span></tt> is a monad over the list items, while <tt><span class="conid">ProducerT</span></tt> is a monad over the end value. It can't be a monad over the stream values, because then <tt><span class="varid">return</span></tt> would have to conjure a value of type <tt><span class="varid">a</span></tt> out of nowhere. </p><p>The <tt><span class="conid">Monad</span></tt> and <tt><span class="conid">MonadTrans</span></tt> instances are straightforward: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Monad</span> (<span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">return</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">.</span> <span class="varid">return</span> <span class="varop">.</span> <span class="conid">Done</span> <span class="varid">a</span> <span class="varop">&gt;&gt;=</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">\$</span> <span class="varid">runProducerT</span> <span class="varid">a</span> <span class="varop">&gt;&gt;=</span> <span class="varid">bind'</span> <span class="keyword">where</span> <span class="varid">bind'</span> (<span class="conid">Done</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="varid">runProducerT</span> (<span class="varid">b</span> <span class="varid">x</span>) <span class="varid">bind'</span> (<span class="conid">More</span> <span class="varid">o</span> <span class="varid">k</span>) <span class="keyglyph">=</span> <span class="varid">return</span> (<span class="conid">More</span> <span class="varid">o</span> (<span class="varid">k</span> <span class="varop">&gt;&gt;=</span> <span class="varid">b</span>)) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">MonadTrans</span> (<span class="conid">ProducerT</span> <span class="varid">o</span>) <span class="keyword">where</span> <span class="varid">lift</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">.</span> <span class="varid">liftM</span> <span class="conid">Done</span> </pre><p>The point of producers is that they can produce values. So, let's make a function for that </p><pre class="haskell"><span class="varid">yield</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="varid">o</span> <span class="keyglyph">-&gt;</span> <span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> () <span class="varid">yield</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">\$</span> <span class="varid">return</span> <span class="varop">\$</span> <span class="conid">More</span> <span class="varid">x</span> (<span class="varid">return</span> ()) </pre><p>Given a producer, we can try to extract the first value. This succeeds if the stream is not empty, otherwise it returns the end value. In both cases we also return a the remaining producer: </p><pre class="haskell"><span class="varid">headProducerT</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> (<span class="conid">Either</span> <span class="varid">a</span> <span class="varid">o</span>, <span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span>) <span class="varid">headProducerT</span> <span class="keyglyph">=</span> <span class="varid">liftM</span> <span class="varid">step</span> <span class="varop">.</span> <span class="varid">runProducerT</span> <span class="keyword">where</span> <span class="varid">step</span> (<span class="conid">Done</span> <span class="varid">x</span>) <span class="keyglyph">=</span> (<span class="conid">Left</span> <span class="varid">x</span>, <span class="varid">return</span> <span class="varid">x</span>) <span class="varid">step</span> (<span class="conid">More</span> <span class="varid">o</span> <span class="varid">k</span>) <span class="keyglyph">=</span> (<span class="conid">Right</span> <span class="varid">o</span>, <span class="varid">k</span>) </pre><p>This head function will form the building block for building consumers. If you look at the function's type, you might notice that it is very similar to that of a state monad. We could imagine a consumer as something that keeps track of the input producer, and repeatedly takes the head of it. So, a first idea might be </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">ConsumerT'</span> <span class="varid">i</span> <span class="varid">t</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">StateT</span> (<span class="conid">ProducerT</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">t</span>) <span class="varid">m</span> <span class="varid">await'</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">ConsumerT'</span> <span class="varid">i</span> <span class="varid">t</span> <span class="varid">m</span> (<span class="conid">Either</span> <span class="varid">t</span> <span class="varid">i</span>) <span class="varid">await'</span> <span class="keyglyph">=</span> <span class="conid">StateT</span> <span class="varid">headProducerT</span> </pre><p>This seems to work. We can compose a producer and a consumer very easily with <tt><span class="varid">evalStateT</span></tt>: </p><pre class="haskell"><span class="varid">compose<sub>pc</sub></span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">ProducerT</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="conid">ConsumerT'</span> <span class="varid">i</span> <span class="varid">t</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">compose<sub>pc</sub></span> <span class="keyglyph">=</span> <span class="varid">flip</span> <span class="varid">evalStateT</span> </pre><p>In terms of pipes, we have composed a pipe with no input together with a pipe that produces no output, to give a 'pipe' with neither input nor output. </p><h2><a name="pipes"></a>Pipes </h2> <p>A general pipe is a computation that is both a producer and a consumer. There are two obvious ways of building one: with the consumer on the outside, or with the producer on the outside. </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">Pipe<sub>CP</sub></span> <span class="varid">i</span> <span class="varid">a</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">ConsumerT'</span> <span class="varid">i</span> <span class="varid">a</span> (<span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span>) <span class="varid">b</span> <span class="keyword">type</span> <span class="conid">Pipe<sub>PC</sub></span> <span class="varid">i</span> <span class="varid">a</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varid">o</span> (<span class="conid">ConsumerT'</span> <span class="varid">i</span> <span class="varid">a</span> <span class="varid">m</span>) <span class="varid">b</span> </pre><p>These types are <em>not</em> the same. <tt><span class="conid">Pipe<sub>CP</sub></span></tt> first consumes a whole bunch of input, and then produces a whole bunch of output. In particular, it is impossible to stop early. In <tt><span class="conid">Pipe<sub>PC</sub></span></tt>, the operations are interleaved; before each output there can be more consuming. This second formulation is therefore the one that we want. </p><p>Before doing fully general composition, let's first compose a producer with a pipe, </p><pre class="haskell"><span class="varid">compose<sub>p</sub></span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">ProducerT</span> <span class="varid">b</span> <span class="varid">m</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe<sub>PC</sub></span> <span class="varid">b</span> <span class="varid">s</span> <span class="varid">c</span> <span class="varid">m</span> <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="conid">ProducerT</span> <span class="varid">c</span> <span class="varid">m</span> <span class="varid">t</span> </pre><p>Remember that a value <tt><span class="varid">p<sub>1</sub></span></tt> of type <tt><span class="conid">Pipe<sub>PC</sub></span></tt> can look something like this: </p><pre class="haskell"><span class="varid">p<sub>1</sub></span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">\$</span> <span class="conid">StateT</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">s<sub>1</sub></span> <span class="keyglyph">-&gt;</span> <span class="varid">act</span> <span class="varop">&gt;&gt;</span> <span class="varid">return</span> (<span class="conid">More</span> <span class="varid">o<sub>1</sub></span> <span class="varid">p<sub>2</sub></span>, <span class="varid">s<sub>2</sub></span>) </pre><p>As before, the upstream producer is the state for the downstream consumer. So, we can fill in the upstream producer for <tt><span class="varid">s<sub>1</sub></span></tt>. Once we do so, we get access to <tt><span class="varid">s<sub>2</sub></span></tt>, which should be filled in into <tt><span class="varid">p<sub>2</sub></span></tt>, etc. In this way we turn the pipe from a <tt class='complex'><span class="conid">ProducerT</span> <span class="varid">o</span> (<span class="conid">StateT</span> <span class="listcon">..</span> <span class="varid">m</span>) <span class="varid">a</span></tt> into a <tt class='complex'><span class="conid">ProducerT</span> <span class="varid">o</span> <span class="varid">m</span> <span class="varid">a</span></tt>. So more generally, we change the base monad of a monad transformer. </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">MonadTransRebase</span> <span class="varid">t</span> <span class="keyword">where</span> <span class="varid">rebase</span> <span class="keyglyph">::</span> <span class="conid">NestTrans</span> <span class="varid">m</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">t</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">t</span> <span class="varid">n</span> <span class="varid">a</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">MonadTransRebase</span> (<span class="conid">ProducerT</span> <span class="varid">o</span>) <span class="keyword">where</span> <span class="varid">rebase</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="conid">ProducerT</span> <span class="varop">.</span> <span class="varid">runNestTrans</span> <span class="varid">f</span> <span class="varid">rebase'</span> <span class="varop">.</span> <span class="varid">runProducerT</span> <span class="keyword">where</span> <span class="varid">rebase'</span> <span class="varid">f'</span> (<span class="conid">Done</span> <span class="varid">d</span>) <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">d</span> <span class="varid">rebase'</span> <span class="varid">f'</span> (<span class="conid">More</span> <span class="varid">x</span> <span class="varid">k</span>) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">x</span> (<span class="varid">rebase</span> <span class="varid">f'</span> <span class="varid">k</span>) </pre><p>The type <tt><span class="conid">NestTrans</span></tt> is a function from <tt class='complex'><span class="varid">m</span> <span class="varid">a</span></tt> to <tt class='complex'><span class="varid">n</span> <span class="varid">b</span></tt>, where the transformation inside the monadic values can use a different <tt><span class="conid">NestTrans</span></tt>. Hence the 'nested' part of the name. </p><pre class="haskell"><span class="keyword">newtype</span> <span class="conid">NestTrans</span> <span class="varid">m</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="conid">NestTrans</span> { <span class="varid">runNestTrans</span> <span class="keyglyph">::</span> <span class="keyword">forall</span> <span class="varid">a</span> <span class="varid">b</span><span class="varop">.</span> (<span class="conid">NestTrans</span> <span class="varid">m</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">n</span> <span class="varid">b</span>) } </pre><p>As said above, given the initial state, we can pass this state through the transfomer. Then the new state is used for nested <tt><span class="conid">StateT</span></tt> computations. </p><pre class="haskell"><span class="varid">nestTransStateT</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">NestTrans</span> (<span class="conid">StateT</span> <span class="varid">s</span> <span class="varid">m</span>) <span class="varid">m</span> <span class="varid">nestTransStateT</span> <span class="varid">s</span> <span class="keyglyph">=</span> <span class="conid">NestTrans</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">f</span> <span class="varid">m</span> <span class="varop">-&gt;</span> <span class="varid">liftM</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">s'</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> (<span class="varid">nestTransStateT</span> <span class="varid">s'</span>) <span class="varid">a</span>) (<span class="varid">runStateT</span> <span class="varid">m</span> <span class="varid">s</span>) </pre><p>This is all we need to define the composition: </p><pre class="haskell"><span class="varid">compose<sub>p</sub></span> <span class="varid">u</span> <span class="varid">v</span> <span class="keyglyph">=</span> <span class="varid">rebase</span> (<span class="varid">nestTransStateT</span> <span class="varid">u</span>) <span class="varid">v</span> </pre><p>Note that it is possible to write all this without the <tt><span class="conid">NestTrans</span></tt> newtype, but to do so generically requires rank 3 types (the first time that I have ever needed those). I leave that solution as an exercise to the reader. </p><h2><a name="consumers-take-2"></a>Consumers, take 2 </h2> <p>Now let's also try to do this the other way around, and compose a pipe with a consumer, </p><pre class="ghci"><span class="varid">compose<sub>c</sub></span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Pipe<sub>PC</sub></span> <span class="varid">a</span> <span class="varid">r</span> <span class="varid">b</span> <span class="varid">m</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">ConsumerT'</span> <span class="varid">b</span> <span class="varid">s</span> <span class="varid">m</span> <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="conid">ConsumerT'</span> <span class="varid">a</span> <span class="varid">r</span> <span class="varid">m</span> <span class="varid">t</span> </pre><p>But immediately we hit a problem. The downstream consumer expects its state to be of type <tt class='complex'><span class="conid">ProducerT</span> <span class="varid">b</span> <span class="varid">m</span> <span class="varid">s</span></tt>, but the upstream has type <tt class='complex'><span class="conid">ProducerT</span> <span class="varid">b</span> (<span class="conid">ConsumerT</span> <span class="listcon">..</span> <span class="varid">m</span>) <span class="varid">s</span></tt>. This is still a producer, but over a different base monad. In fact, the upstream producer's base monad is of the form <tt class='complex'>(<span class="varid">t</span> <span class="varid">m</span>)</tt>, where <tt><span class="varid">t</span></tt> is another monad transformer. We can't just get rid of the <tt><span class="conid">ConsumerT</span></tt>, like we did on the downstream side, because we still need to be able to pass in the state later on. </p><p>The solution is to make the state type more general, and allow it to be <tt><span class="conid">ProducerT</span></tt> over any transformation of a given base monad. Effectively we replace the state type <tt class='complex'><span class="varid">s</span> <span class="varid">m</span> <span class="varid">a</span></tt> by <tt class='complex'><span class="keyword">forall</span> <span class="varid">t</span><span class="varop">.</span> <span class="varid">s</span> (<span class="varid">t</span> <span class="varid">m</span>) <span class="varid">a</span></tt>. This gives us the <em>transformed state monad</em>: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">TStateT</span> <span class="varid">s</span> <span class="varid">a</span> <span class="varid">m</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">TStateT</span> { <span class="varid">runTStateT</span> <span class="keyglyph">::</span> <span class="keyword">forall</span> <span class="varid">t</span><span class="varop">.</span> (<span class="conid">MonadTrans</span> <span class="varid">t</span>, <span class="conid">Monad</span> (<span class="varid">t</span> <span class="varid">m</span>)) <span class="keyglyph">=&gt;</span> <span class="varid">s</span> (<span class="varid">t</span> <span class="varid">m</span>) <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">t</span> <span class="varid">m</span> (<span class="varid">b</span>, <span class="varid">s</span> (<span class="varid">t</span> <span class="varid">m</span>) <span class="varid">a</span>) } </pre><p>Note that <tt><span class="varid">s</span></tt> is not a state <em>type</em>, but a state <em>monad transformer</em>. The instances are straightforward, and look identical to the instances for <tt><span class="conid">StateT</span></tt>, with the exception of an extra <tt><span class="varid">lift</span></tt> in the <tt><span class="conid">MonadTrans</span></tt> instance. </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Monad</span> (<span class="conid">TStateT</span> <span class="varid">s</span> <span class="varid">t</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">return</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">TStateT</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="varid">return</span> (<span class="varid">a</span>, <span class="varid">s</span>) <span class="varid">m</span> <span class="varop">&gt;&gt;=</span> <span class="varid">k</span> <span class="keyglyph">=</span> <span class="conid">TStateT</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="keyword">do</span> (<span class="varid">a</span>,<span class="varid">s'</span>) <span class="keyglyph">&lt;-</span> <span class="varid">runTStateT</span> <span class="varid">m</span> <span class="varid">s</span> <span class="varid">runTStateT</span> (<span class="varid">k</span> <span class="varid">a</span>) <span class="varid">s'</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">MonadTrans</span> (<span class="conid">TStateT</span> <span class="varid">s</span> <span class="varid">t</span>) <span class="keyword">where</span> <span class="varid">lift</span> <span class="varid">mx</span> <span class="keyglyph">=</span> <span class="conid">TStateT</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="varid">lift</span> <span class="varop">\$</span> <span class="varid">liftM</span> (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">-&gt;</span> (<span class="varid">x</span>,<span class="varid">s</span>)) <span class="varid">mx</span> </pre><p>The new consumer type is just a <tt><span class="conid">TState</span></tt> with <tt><span class="conid">ProducerT</span></tt> as the state: </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">ConsumerT</span> <span class="varid">i</span> <span class="keyglyph">=</span> <span class="conid">TStateT</span> (<span class="conid">ProducerT</span> <span class="varid">i</span>) <span class="keyword">type</span> <span class="conid">GPipe</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="varid">o</span> (<span class="varid">i</span> <span class="varid">m</span>) <span class="keyword">type</span> <span class="conid">Pipe</span> <span class="varid">i</span> <span class="varid">a</span> <span class="varid">o</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">GPipe</span> (<span class="conid">ConsumerT</span> <span class="varid">i</span> <span class="varid">a</span>) (<span class="conid">ProducerT</span> <span class="varid">o</span>) <span class="varid">m</span> </pre><p>Awaiting looks much like before, </p><pre class="haskell"><span class="varid">await</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Pipe</span> <span class="varid">i</span> <span class="varid">t</span> <span class="varid">o</span> <span class="varid">m</span> (<span class="conid">Either</span> <span class="varid">t</span> <span class="varid">i</span>) <span class="varid">await</span> <span class="keyglyph">=</span> <span class="varid">lift</span> <span class="varop">\$</span> <span class="conid">TStateT</span> <span class="varid">headProducerT</span> </pre><p>All we need to do now to define composition is to make a <tt><span class="conid">NestTrans</span></tt> for <tt><span class="conid">TStateT</span></tt>. The function to do this is essentially the same as <tt><span class="varid">nestTransStateT</span></tt> above: </p><pre class="haskell"><span class="varid">nestTransTStateT</span> <span class="keyglyph">::</span> (<span class="conid">Monad</span> (<span class="varid">t</span> <span class="varid">m</span>), <span class="conid">MonadTrans</span> <span class="varid">t</span>) <span class="keyglyph">=&gt;</span> <span class="varid">s</span> (<span class="varid">t</span> <span class="varid">m</span>) <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">NestTrans</span> (<span class="conid">TStateT</span> <span class="varid">s</span> <span class="varid">a</span> <span class="varid">m</span>) (<span class="varid">t</span> <span class="varid">m</span>) <span class="varid">nestTransTStateT</span> <span class="varid">s</span> <span class="keyglyph">=</span> <span class="conid">NestTrans</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">f</span> <span class="varid">m</span> <span class="varop">-&gt;</span> <span class="varid">liftM</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">s'</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> (<span class="varid">nestTransTStateT</span> <span class="varid">s'</span>) <span class="varid">a</span>) (<span class="varid">runTStateT</span> <span class="varid">m</span> <span class="varid">s</span>) </pre><p>and by magic, we get composition: </p><pre class="ghci"><span class="varid">compose</span> <span class="keyglyph">::</span> <span class="conid">Monad</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Pipe</span> <span class="varid">a</span> <span class="varid">r</span> <span class="varid">b</span> <span class="varid">m</span> <span class="varid">s</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">b</span> <span class="varid">s</span> <span class="varid">c</span> <span class="varid">m</span> <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">a</span> <span class="varid">r</span> <span class="varid">c</span> <span class="varid">m</span> <span class="varid">t</span> <span class="varid">compose</span> <span class="keyglyph">=</span> <span class="varid">rebase</span> <span class="varop">.</span> <span class="varid">nestTransTStateT</span> </pre><h2><a name="general-consumers-and-producers"></a>General consumers and producers </h2> <p>There is nothing specific to <tt><span class="conid">ConsumerT</span></tt> or <tt><span class="conid">ProducerT</span></tt> in the composition function. All we require is that the 'consumer' on the left is a monad transformer, and that 'producer' on the right can be rebased. This leads to the more general type of compose: </p><pre class="haskell"><span class="varid">compose</span> <span class="keyglyph">::</span> (<span class="conid">MonadTransRebase</span> <span class="varid">t</span>, <span class="conid">MonadTrans</span> <span class="varid">r</span>, <span class="conid">Monad</span> (<span class="varid">r</span> <span class="varid">m</span>)) <span class="keyglyph">=&gt;</span> <span class="conid">GPipe</span> <span class="varid">r</span> <span class="varid">s</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">GPipe</span> (<span class="conid">TStateT</span> <span class="varid">s</span> <span class="varid">a</span>) <span class="varid">t</span> <span class="varid">m</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">GPipe</span> <span class="varid">r</span> <span class="varid">t</span> <span class="varid">m</span> <span class="varid">b</span> </pre><p>There are some interesting choices for <tt><span class="varid">r</span></tt>, <tt><span class="varid">s</span></tt> and <tt><span class="varid">t</span></tt> here. By picking <tt class='complex'><span class="varid">r</span> <span class="keyglyph">=</span> <span class="conid">IdentityT</span></tt>, we get an upstream 'pipe' with no input, i.e. a producer. By picking <tt class='complex'><span class="varid">t</span> <span class="keyglyph">=</span> <span class="conid">IdentityT</span></tt>, we get a downstream 'pipe' with no output, i.e. a consumer. </p><p>Finally, the transformer <tt><span class="varid">s</span></tt> determines what information is based between the two pipes. By using <tt class='complex'><span class="conid">ProducerT</span> <span class="varid">o</span></tt> you get a stream of <tt><span class="varid">o</span></tt>s followed by an <tt><span class="varid">a</span></tt> at the end. If you use <tt><span class="conid">ListT</span></tt>, there is a stream of <tt><span class="varid">a</span></tt>s with no value at the end. If you use <tt><span class="conid">IdentityT</span></tt>, just a single value is passed, so you get function composition. If you use <tt><span class="conid">InfiniteListT</span></tt> you get a producer that guarantees that it gives an infinite stream of values. And I believe it should also be possible to define more complex protocols, such as "first give 10 values of type <tt><span class="varid">a</span></tt>, then an unlimited number of <tt><span class="varid">b</span></tt>, and end with a <tt><span class="varid">c</span></tt>". However, you do need a different <tt><span class="varid">await</span></tt> function for all of these. </p><p>To close things off, here are the producers and consumers based on <tt><span class="conid">IdentityT</span></tt>. </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">MonadTransRebase</span> <span class="conid">IdentityT</span> <span class="keyword">where</span> <span class="varid">rebase</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="conid">IdentityT</span> <span class="varop">.</span> <span class="varid">runNestTrans</span> <span class="varid">f</span> (<span class="varid">const</span> <span class="varid">id</span>) <span class="varop">.</span> <span class="varid">runIdentityT</span> <div class='empty-line'></div> <span class="keyword">type</span> <span class="conid">ProducerPipe</span> <span class="varid">o</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">GPipe</span> <span class="conid">IdentityT</span> (<span class="conid">ProducerT</span> <span class="varid">o</span>) <span class="varid">m</span> <span class="keyword">type</span> <span class="conid">ConsumerPipe</span> <span class="varid">i</span> <span class="varid">a</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">GPipe</span> (<span class="conid">ConsumerT</span> <span class="varid">i</span> <span class="varid">a</span>) <span class="conid">IdentityT</span> <span class="varid">m</span> <span class="keyword">type</span> <span class="conid">Pipeline</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">GPipe</span> <span class="conid">IdentityT</span> <span class="conid">IdentityT</span> <span class="varid">m</span> <div class='empty-line'></div> <span class="varid">runPipeline</span> <span class="keyglyph">::</span> <span class="conid">Pipeline</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">runPipeline</span> <span class="keyglyph">=</span> <span class="varid">runIdentityT</span> <span class="varop">.</span> <span class="varid">runIdentityT</span> </pre> What to do with the results of upstream pipes http://twanvl.nl/blog/haskell/results-of-upstream-pipes 2012-04-04T19:35:00Z <p>In the pipes library, the type of the composition operator is </p><pre class="haskell">(<span class="varop">&gt;+&gt;</span>) <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">b</span> <span class="varid">c</span> <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">c</span> <span class="varid">r</span> </pre><p>If you look closely, then you will notice that all three pipes have result type <tt><span class="varid">r</span></tt>. How does this work? Simple: whichever pipe stops first provides the final result. </p><p>In my opinion this is wrong. The upstream pipe produces values, and the downstream pipe does something with them. The downstream pipe is the one that leads the computation, by pulling results from the upstream pipe. It is therefore always the downstream pipe that should provide the result. So, in the <a href="blog/haskell/conduits-vs-pipes">pipification of conduit</a>, the proposed type for composition is instead </p><pre class="haskell">(<span class="varop">&gt;+&gt;</span>) <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">b</span> () <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">b</span> <span class="varid">c</span> <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">c</span> <span class="varid">r</span> </pre><p>This makes it clear that the result of the first pipe is not used, the result of the composition always has to come from downstream. But now the result of the first pipe would be discarded completely. </p><p>Another, more general, solution is to communicate the result of the first pipe to the second one. That would give the <tt><span class="varid">await</span></tt> function in the downstream pipe the type </p><pre class="haskell"><span class="varid">await</span> <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">b</span> (<span class="conid">Either</span> <span class="varid">r<sub>1</sub></span> <span class="varid">a</span>) </pre><p>where <tt><span class="varid">r<sub>1</sub></span></tt> is the result of the upstream pipe. Of course that <tt><span class="varid">r<sub>1</sub></span></tt> type needs to come from somewhere. So <tt><span class="conid">Pipe</span></tt> would need another type argument </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">stream<sub>in</sub></span> <span class="varid">stream<sub>out</sub></span> <span class="varid">final<sub>in</sub></span> <span class="varid">final<sub>out</sub></span> </pre><p>giving await the type </p><pre class="haskell"><span class="varid">await</span> <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">x</span> (<span class="conid">Either</span> <span class="varid">x</span> <span class="varid">a</span>) </pre><p>Composition becomes </p><pre class="haskell">(<span class="varop">&gt;+&gt;</span>) <span class="keyglyph">::</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">b</span> <span class="varid">c</span> <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varid">c</span> <span class="varid">x</span> <span class="varid">z</span> </pre><p>I think this makes <tt><span class="conid">Pipe</span></tt> into a category over <em>pairs</em> of Haskell types. I was tempted to call this a bicategory, in analogy with <a href="http://hackage.haskell.org/packages/archive/bifunctors/0.1.2/doc/html/Data-Bifunctor.html">bifunctor</a>, but that term apparently means <a href="http://ncatlab.org/nlab/show/bicategory">something else</a>. </p><p>Note that this article is just about a quick idea I had. I am not saying that this is the best way to do things. In fact, I am not even sure if propagating result values in this way actually helps solve any real world problems. </p> My blog software http://twanvl.nl/blog/2012-03-28-blog-software 2012-03-28T21:13:00Z <p>In this post I will explain the software behind my blog, since several visitors have asked about it. But I will have to disappoint those of you hoping for fancy Haskell code: it is written in PHP. So no pandoc, no hakyll, no happstack and no Yesod. </p><p>Some reasons for picking php are: </p><ul><li> PHP works pretty much everywhere, and</li> <li> PHP hosting is very cheap.</li> <li> I already had much of the code laying around from other website projects.</li> <li> I honestly think that PHP is a better tool for a simple hacked together website like this.</li> </ul><h2><a name="from-files-to-blog-posts"></a>From files to blog posts </h2> <p>The code is inspired by <a href="http://www.blosxom.com/">blosxom</a>, which I used before. Blog posts, as well as most other pages on the website, are stored in text files. The script <tt class='complex'><span class="varid">blog</span><span class="varop">.</span><span class="varid">php</span></tt> calls a function <tt class='complex'><span class="conid">Resolver</span><span class="keyglyph">::</span><span class="varid">find_all_pages</span></tt>, which does a simple directory listing to find all the .txt and .lhs files in the <tt><span class="varid">blog</span></tt> subdirectory. </p><p>For me this makes it very easy to write a new blog post. I just fire up a text editor, and save the file under the right name. I can then view it on <tt><span class="varid">localhost</span></tt>. To publish to the rest of the internet I copy the file to the webserver. </p><p>The parser for the text files is also quite simple. First comes a header block, with lines like </p><pre>title: My blog software tags: blog, bananas date: 2012-03-28 23:13 CEST </pre><p>After that is the page body, using a markup syntax strongly inspired by MediaWiki. </p><pre>-- This is a header -- Body text with ''italic'', @embeded haskell@, &lt;a href=&quot;#&quot;&gt;embeded html&lt;/a&gt; <span class="input">&gt; </span><span class="varid">haskell_code</span> <span class="keyglyph">=</span> <span class="num">1</span> <span class="varop">+</span> <span class="num">1</span> <span class="input">&gt; </span> <span class="keyword">where</span> <span class="varid">more</span> <span class="varid">haskell</span> <span class="keyglyph">=</span> <span class="varid">undefined</span> <span class="listcon">]</span><span class="varop">&gt;</span> <span class="varid">also</span> <span class="conid">Haskell</span>, <span class="varid">but</span> <span class="varid">ignored</span> <span class="varid">by</span> <span class="varid">the</span> <span class="varid">literate</span> <span class="varid">haskell</span> <span class="varid">preprocessor</span> </pre><p>To parse the markup, I use a state machine. I loop over the lines, and determine the line's type. For example, lines starting with <tt>"> "</tt> indicate Haskell code, <tt>-- (.*) --</tt> indicates a header, etc. I then just output the appropriate html code for that line. The state machine comes in when merging multiple lines of code into one <tt>&lt;pre></tt> tag. I just keep a variable with the last used open tag. If the previous line uses the same open tag, then do nothing, otherwise insert the close tag for that state, and the open tag for the new state. The details are in <a href="https://github.com/twanvl/twanvl-nl/blob/master/lib/WikiFormat.php">WikiFormat.php</a>. </p><p>Then the source code itself. It needs to be turned into fancy syntax highlighted html. That is done with a <a href="https://github.com/twanvl/twanvl-nl/blob/master/lib/HaskellFormat.php">simple hand-written lexer</a>. Lexing is surprisingly easy if you have access to a build in regular expression library. Just repeatedly look for the first match after the current index for a set of possible token regexes. </p><p>There are some backdoors in the lexer, to allow arbirary html inside code blocks, so </p><pre>]&gt; !!!&lt;span style=&quot;background:red&quot;&gt;wrong&lt;/span&gt;!!! </pre><p>gets rendered as </p><pre class="ghci"><span style="background:red">wrong</span> </pre><p>This sometimes comes in handy when writing blog posts. Usually I add these backdoors as they are needed. </p><p>One issue is that all this on-the-fly parsing can be a bit slow. For that I use a cache. I just capture the entire rendered page, and save it in a file. Then before rendering, and in fact before even loading the file, I check if the cache is up to date. If it is, output the cache contents and exit. </p><p>Finally the comments, which again use a simple hand-written solution. I just store the comments for each post in a single text file. New comments are appended at the end. The comments use the same markup parser as the article bodies. The most annoying part of the comment system is actually the spam filter. I have a blacklist of words and urls that are not allowed, and a script for retroactively removing spam posts. But some spam does get through. </p><p>That's it. The code is on <a href="https://github.com/twanvl/twanvl-nl">github</a>, if anyone is interested. </p> Conduits vs. Pipes http://twanvl.nl/blog/haskell/conduits-vs-pipes 2012-03-24T14:31:00Z <p>Michael Snoyman released <a href="http://hackage.haskell.org/package/conduit-0.3.0">conduit-0.3</a> this week. The conduit package provides three datatypes that can be chained together: Source, Counduit and Sink. If you were to look at the source code, you will notice that there is a lot of overlap between these datatypes. In this post I'll show how these types can be combined into a single one, which is the idea used by the pipes package. </p><p>Compare: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Sink</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span> <span class="varop">=</span> <span class="conid">Processing</span> (<span class="varid">i</span> <span class="keyglyph">-&gt;</span> <span class="conid">Sink</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span>) (<span class="conid">SinkClose</span> <span class="varid">m</span> <span class="varid">o</span>) <span class="keyglyph">|</span> <span class="conid">Done</span> (<span class="conid">Maybe</span> <span class="varid">i</span>) <span class="varid">o</span> <span class="keyglyph">|</span> <span class="conid">SinkM</span> (<span class="varid">m</span> (<span class="conid">Sink</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span>)) <span class="keyword">type</span> <span class="conid">SinkClose</span> <span class="varid">m</span> <span class="varid">o</span> <span class="keyglyph">=</span> <span class="varid">m</span> <span class="varid">o</span> </pre><pre class="haskell"><span class="keyword">data</span> <span class="conid">Conduit</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span> <span class="varop">=</span> <span class="conid">NeedInput</span> (<span class="varid">i</span> <span class="keyglyph">-&gt;</span> <span class="conid">Conduit</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span>) (<span class="conid">ConduitClose</span> <span class="varid">m</span> <span class="varid">o</span>) <span class="keyglyph">|</span> <span class="conid">HaveOutput</span> (<span class="conid">Conduit</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span>) (<span class="varid">m</span> ()) <span class="varid">o</span> <span class="keyglyph">|</span> <span class="conid">Finished</span> (<span class="conid">Maybe</span> <span class="varid">i</span>) <span class="keyglyph">|</span> <span class="conid">ConduitM</span> (<span class="varid">m</span> (<span class="conid">Conduit</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span>)) (<span class="varid">m</span> ()) <span class="keyword">type</span> <span class="conid">ConduitClose</span> <span class="varid">m</span> <span class="varid">o</span> <span class="keyglyph">=</span> <span class="conid">Source</span> <span class="varid">m</span> <span class="varid">o</span> </pre><p>The differences between the two types are that: </p><ul><li> <tt><span class="conid">Done</span></tt> returns output <tt><span class="varid">o</span></tt>, whereas <tt><span class="conid">Finished</span></tt> does not.</li> <li> <tt><span class="conid">Conduit</span></tt> has a <tt><span class="conid">HaveOutput</span></tt> constructor, while a <tt><span class="conid">Sink</span></tt> does not.</li> <li> <tt><span class="conid">ConduitM</span></tt> has an 'early close' action of type <tt class='complex'><span class="varid">m</span> ()</tt>.</li> <li> <tt><span class="conid">SinkClose</span></tt> just gives a result, while <tt><span class="conid">ConduitClose</span></tt> can return an entire stream in the form of a <tt class='complex'><span class="conid">Source</span> <span class="varid">m</span> <span class="varid">o</span></tt></li> </ul><p>The term output is in fact used differently by the two types, it becomes clearer when we say that <tt><span class="conid">Sink</span></tt> has a <em>result</em> of type <tt><span class="varid">r</span></tt>. Then the result of <tt><span class="conid">Conduit</span></tt> is <tt class='complex'><span class="varid">r</span> <span class="keyglyph">=</span> ()</tt>. On the other hand, a sink doesn't produce output to downstream conduits, so its <em>output</em> type would be <tt><span class="conid">Void</span></tt>. </p><p>Now let's also bring in <tt><span class="conid">Source</span></tt>, </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Source</span> <span class="varid">m</span> <span class="varid">a</span> <span class="varop">=</span> <span class="conid">Open</span> (<span class="conid">Source</span> <span class="varid">m</span> <span class="varid">a</span>) (<span class="varid">m</span> ()) <span class="varid">a</span> <span class="keyglyph">|</span> <span class="conid">Closed</span> <span class="keyglyph">|</span> <span class="conid">SourceM</span> (<span class="varid">m</span> (<span class="conid">Source</span> <span class="varid">m</span> <span class="varid">a</span>)) (<span class="varid">m</span> ()) </pre><p>The <tt><span class="conid">SourceM</span></tt> constructor is exactly analogous to <tt><span class="conid">ConduitM</span></tt>, and <tt><span class="conid">Open</span></tt> is analogous to <tt><span class="conid">HaveOutput</span></tt>. A <tt><span class="conid">Source</span></tt> doesn't have input, so there is no analogue to <tt><span class="conid">NeedInput</span></tt> or <tt><span class="conid">Processing</span></tt>. The <tt><span class="conid">Closed</span></tt> constructor doesn't provide remaining input or result, since a source doesn't have either. However, we could say that its input is <tt class='complex'><span class="varid">i</span> <span class="keyglyph">=</span> ()</tt>, and its result is <tt class='complex'><span class="varid">r</span> <span class="keyglyph">=</span> ()</tt>. </p><p>It then becomes possible to unify the three datatypes into: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">r</span> <span class="varop">=</span> <span class="conid">NeedInput</span> (<span class="varid">i</span> <span class="keyglyph">-&gt;</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">r</span>) (<span class="conid">Pipe</span> <span class="varid">m</span> () <span class="varid">o</span> <span class="varid">r</span>) <span class="keyglyph">|</span> <span class="conid">HaveOutput</span> (<span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">r</span>) (<span class="varid">m</span> ()) <span class="varid">o</span> <span class="keyglyph">|</span> <span class="conid">Finished</span> (<span class="conid">Maybe</span> <span class="varid">i</span>) <span class="varid">r</span> <span class="keyglyph">|</span> <span class="conid">PipeM</span> (<span class="varid">m</span> (<span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="varid">o</span> <span class="varid">r</span>)) (<span class="varid">m</span> <span class="varid">r</span>) <div class='empty-line'></div> <span class="keyword">type</span> <span class="conid">Source</span> <span class="varid">m</span> <span class="varid">o</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> <span class="varid">m</span> () <span class="varid">o</span> () <span class="keyword">type</span> <span class="conid">Conduit</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">o</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="varid">o</span> () <span class="keyword">type</span> <span class="conid">Sink</span> <span class="varid">i</span> <span class="varid">m</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="conid">Pipe</span> <span class="varid">m</span> <span class="varid">i</span> <span class="conid">Void</span> <span class="varid">r</span> </pre><p>This is almost exactly the type provided by the various <a href="http://hackage.haskell.org/package/pipes-core">incarnations of</a> the <a href="http://hackage.haskell.org/package/pipes">pipes</a> package! </p><p>The three composition operators of conduits become a single operator on pipes. The top level "run" operation takes a <tt class='complex'><span class="conid">Pipe</span> <span class="varid">m</span> () <span class="conid">Void</span> <span class="varid">r</span></tt>, that is, a (composition of) pipes that takes no input and has no output. </p><p>What about the instances for <tt><span class="conid">Source</span></tt>, <tt><span class="conid">Conduit</span></tt> and <tt><span class="conid">Sink</span></tt>? In the conduit package <tt><span class="conid">Sink</span></tt> is an instance of <tt><span class="conid">Monad</span></tt> and its superclasses. That is also the case for <tt><span class="conid">Pipe</span></tt>. <tt><span class="conid">Source</span></tt> and <tt><span class="conid">Conduit</span></tt> are instances of <tt><span class="conid">Functor</span></tt>, which allows you to map a function over the output. The output is no longer the last type variable of <tt><span class="conid">Pipe</span></tt>. Instead we should provide an instance of <tt><span class="conid">Functor2</span></tt> or <tt><span class="conid">Bifunctor</span></tt>, which have a method <tt class='complex'><span class="varid">fmap2</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span> <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">b</span> <span class="varid">r</span></tt>. </p><p>Overall, reducing the number of datatypes from 3 to 1 sounds like a pretty good deal to me. I therefore think it would be great if conduit adopted the ideas from pipes. </p> Dependently typed DAGs http://twanvl.nl/blog/haskell/dependently-typed-dags 2012-03-19T21:16:00Z <p>A colleague of mine recently needed to represent <a href="http://en.wikipedia.org/wiki/Directed_acyclic_graph">DAGs</a> (directed acyclic graphs) in Coq, and asked around for ideas. Since Coq is not a nice language to program in, I decided to use Haskell instead. Something close to dependently typed programming is possible in Haskell thanks to GADTs. And other extensions will be helpful too, </p><pre class="haskell"><span class="pragma">{-# LANGUAGE GADTs, TypeOperators, Rank2Types #-}</span> </pre><p>My idea is to represent a DAG as a list of nodes. Nodes have a list of children, where each child is a reference to an element <em>later</em> in the list. </p><p>For example, the DAG<br> <img src="image/dag/tree1.png" style="margin-left:2em;"><br> would be represented as </p><pre class="ghci"><span class="listcon">[</span><span class="conid">Node</span> <span class="str">&quot;a&quot;</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">2</span>,<span class="num">2</span>,<span class="num">4</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;b&quot;</span> <span class="listcon">[</span><span class="num">3</span>,<span class="num">3</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> </pre><h2><a name="data-types"></a>Data types </h2> <p>To make the above representation safe, we need to ensure two things: </p><ul><li> Each child-reference is greater than the index of the parent.</li> <li> Each child-reference refers to an actual node, so it must be smaller than the size of the list.</li> </ul><p>The first condition is easily satisfied, by making the reference <em>relative to the current position</em> and using natural numbers. So the representation would be </p><pre class="ghci"><span class="listcon">[</span><span class="conid">Node</span> <span class="str">&quot;a&quot;</span> <span class="listcon">[</span><span class="num">0</span>,<span class="num">1</span>,<span class="num">1</span>,<span class="num">3</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;b&quot;</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">1</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="num">0</span>,<span class="num">1</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span>, <span class="conid">Node</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> </pre><p>For the second condition we need dependent types. In particular the type <tt class='complex'><span class="conid">Fin</span> <span class="varid">n</span></tt> of numbers smaller than <tt><span class="varid">n</span></tt>. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Zero</span> <span class="keyword">data</span> <span class="conid">Succ</span> <span class="varid">n</span> <div class='empty-line'></div> <span class="keyword">data</span> <span class="conid">Fin</span> <span class="varid">n</span> <span class="keyword">where</span> <span class="conid">Fin0</span> <span class="keyglyph">::</span> <span class="conid">Fin</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="conid">FinS</span> <span class="keyglyph">::</span> <span class="conid">Fin</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Fin</span> (<span class="conid">Succ</span> <span class="varid">n</span>) </pre><p>A node then holds a label of type <tt><span class="varid">a</span></tt> and a list of numbers less than <tt><span class="varid">n</span></tt>. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Node</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyword">where</span> <span class="conid">Node</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Fin</span> <span class="varid">n</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Node</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyword">deriving</span> (<span class="conid">Eq</span>,<span class="conid">Show</span>) </pre><p>For the list of nodes we will use a dependently typed vector, </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyword">where</span> <span class="conid">Empty</span> <span class="keyglyph">::</span> <span class="conid">Vec</span> <span class="varid">f</span> <span class="conid">Zero</span> (<span class="conop">:::</span>) <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Vec</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyword">infixr</span> <span class="num">5</span> <span class="conop">:::</span> </pre><p>A value of <tt class='complex'><span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span></tt> is a list of the form <tt class='complex'><span class="listcon">[</span><span class="listcon">]</span></tt> or <tt class='complex'><span class="listcon">[</span><span class="varid">x<sub>0</sub></span><span class="keyglyph">::</span><span class="varid">f</span> <span class="num">0</span><span class="listcon">]</span></tt> or [x__1::f 1, x__0::f 0]<tt class='complex'> <span class="varid">or</span> <span class="listcon">[</span><span class="varid">x<sub>2</sub></span><span class="keyglyph">::</span><span class="varid">f</span> <span class="num">2</span>, <span class="varid">x<sub>1</sub></span><span class="keyglyph">::</span><span class="varid">f</span> <span class="num">1</span>, <span class="varid">x<sub>0</sub></span><span class="keyglyph">::</span><span class="varid">f</span> <span class="num">0</span><span class="listcon">]</span></tt> etc., with a length equal to the parameter <tt><span class="varid">n</span></tt>. That is exactly what we need for DAGs: </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Vec</span> (<span class="conid">Node</span> <span class="varid">a</span>) </pre><h2><a name="instances"></a>Instances </h2> <p>I would like to define <tt><span class="conid">Eq</span></tt> and <tt><span class="conid">Show</span></tt> instances for these datatypes. But the instance for <tt><span class="conid">Vec</span></tt> would look something like </p><pre class="ghci"><span class="keyword">instance</span> (<span class="keyword">forall</span> <span class="varid">m</span><span class="varop">.</span> <span class="conid">Eq</span> (<span class="varid">f</span> <span class="varid">m</span>)) <span class="keyglyph">=&gt;</span> <span class="conid">Eq</span> (<span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span>) </pre><p>which is not valid Haskell, even with extensions. The solution is to use another class, <tt><span class="conid">Eq1</span></tt> </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Eq1</span> <span class="varid">f</span> <span class="keyword">where</span> <span class="varid">eq1</span> <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> </pre><p>Now we can define </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Eq1</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> <span class="conid">Eq</span> (<span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span>) <span class="keyword">where</span> <span class="conid">Empty</span> <span class="varop">==</span> <span class="conid">Empty</span> <span class="keyglyph">=</span> <span class="conid">True</span> (<span class="varid">x</span> <span class="conop">:::</span> <span class="varid">xs</span>) <span class="varop">==</span> (<span class="varid">y</span> <span class="conop">:::</span> <span class="varid">ys</span>) <span class="keyglyph">=</span> <span class="varid">eq1</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varop">&amp;&amp;</span> <span class="varid">xs</span> <span class="varop">==</span> <span class="varid">ys</span> </pre><p>The boring instances for <tt><span class="conid">Node</span></tt> and <tt><span class="conid">Fin</span></tt> are </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Eq1</span> (<span class="conid">Node</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">eq1</span> <span class="keyglyph">=</span> (<span class="varop">==</span>) <span class="keyword">instance</span> <span class="conid">Eq1</span> <span class="conid">Fin</span> <span class="keyword">where</span> <span class="varid">eq1</span> <span class="keyglyph">=</span> (<span class="varop">==</span>) <span class="keyword">instance</span> <span class="conid">Eq1</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> <span class="conid">Eq1</span> (<span class="conid">Vec</span> <span class="varid">f</span>) <span class="keyword">where</span> <span class="varid">eq1</span> <span class="keyglyph">=</span> (<span class="varop">==</span>) <div class='empty-line'></div> <span class="comment">-- ghc can't derive this</span> <span class="keyword">instance</span> <span class="conid">Eq</span> (<span class="conid">Fin</span> <span class="varid">n</span>) <span class="keyword">where</span> <span class="conid">Fin0</span> <span class="varop">==</span> <span class="conid">Fin0</span> <span class="keyglyph">=</span> <span class="conid">True</span> <span class="conid">FinS</span> <span class="varid">i</span> <span class="varop">==</span> <span class="conid">FinS</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="varid">i</span> <span class="varop">==</span> <span class="varid">j</span> <span class="varid">_</span> <span class="varop">==</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="conid">False</span> </pre><p>The same goes for <tt><span class="conid">Show</span></tt> </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Show1</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">showsPrec1</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">ShowS</span> <div class='empty-line'></div> <span class="comment">-- instances ommitted, see source code</span> </pre><h2><a name="convert-to-tree"></a>Convert to tree </h2> <p>To show that these DAGs work, we can convert from a DAG to a tree by duplicating all nodes. The tree type is a simple rose tree, as those in Data.Tree: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">TNode</span> <span class="varid">a</span> <span class="listcon">[</span><span class="conid">Tree</span> <span class="varid">a</span><span class="listcon">]</span> <span class="keyword">deriving</span> <span class="conid">Show</span> </pre><p>To be able to make a dag into a tree, we need to know the root node. So we give the <tt><span class="varid">toTree</span></tt> a <tt class='complex'><span class="conid">DAG</span> <span class="varid">n</span></tt> and an <tt class='complex'><span class="conid">Fin</span> <span class="varid">n</span></tt> to indicate the root. </p><pre class="haskell"><span class="comment">-- Convert a DAG to a tree, using the given node index as root</span> <span class="varid">toTree</span> <span class="keyglyph">::</span> <span class="conid">Fin</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="varid">toTree</span> <span class="conid">Fin0</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs</span> <span class="conop">:::</span> <span class="varid">ns</span>) <span class="keyglyph">=</span> <span class="conid">TNode</span> <span class="varid">x</span> <span class="listcon">[</span><span class="varid">toTree</span> <span class="varid">c</span> <span class="varid">ns</span> <span class="keyglyph">|</span> <span class="varid">c</span> <span class="keyglyph">&lt;-</span> <span class="varid">cs</span><span class="listcon">]</span> <span class="varid">toTree</span> (<span class="conid">FinS</span> <span class="varid">i</span>) (<span class="varid">_</span> <span class="conop">:::</span> <span class="varid">ns</span>) <span class="keyglyph">=</span> <span class="varid">toTree</span> <span class="varid">i</span> <span class="varid">ns</span> <span class="comment">-- drop the head until we reach the root</span> </pre><p>And for convenience, a function that assumes that the first node in the list is the root. </p><pre class="haskell"><span class="varid">toTree'</span> <span class="keyglyph">::</span> <span class="conid">DAG</span> <span class="varid">a</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="varid">toTree'</span> <span class="keyglyph">=</span> <span class="varid">toTree</span> <span class="conid">Fin0</span> </pre><p>Here is the example from above </p><pre class="haskell"><span class="varid">example</span> <span class="keyglyph">=</span> <span class="conid">Node</span> <span class="str">&quot;a&quot;</span> <span class="listcon">[</span><span class="conid">Fin0</span>,<span class="conid">FinS</span> <span class="conid">Fin0</span>,<span class="conid">FinS</span> <span class="conid">Fin0</span>,<span class="conid">FinS</span> (<span class="conid">FinS</span> (<span class="conid">FinS</span> (<span class="conid">Fin0</span>)))<span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;b&quot;</span> <span class="listcon">[</span><span class="conid">FinS</span> <span class="conid">Fin0</span>,<span class="conid">FinS</span> <span class="conid">Fin0</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="conid">Fin0</span>,<span class="conid">FinS</span> <span class="conid">Fin0</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Empty</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">toTree'</span> <span class="varid">example</span> <span class="conid">TNode</span> <span class="str">&quot;a&quot;</span> <span class="listcon">[</span><span class="conid">TNode</span> <span class="str">&quot;b&quot;</span> <span class="listcon">[</span><span class="conid">TNode</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span>,<span class="conid">TNode</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> ,<span class="conid">TNode</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="conid">TNode</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span>,<span class="conid">TNode</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> ,<span class="conid">TNode</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="conid">TNode</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span>,<span class="conid">TNode</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> ,<span class="conid">TNode</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span><span class="listcon">]</span> </pre><p>As an image:<br><img src="image/dag/tree-expanded.png" style="margin-left:2em;">. </p><h2><a name="convert-from-a-tree"></a>Convert from a tree </h2> <p>More interesting is the conversion <em>from</em> a tree <em>to</em> a DAG, in such a way that we share identical nodes. For that we first of all need to be able to search a DAG to see if it already contains a particular node. </p><p>Let's do this a bit more generic, and define a search over any <tt class='complex'><span class="conid">Vec</span> <span class="varid">f</span></tt>. </p><pre class="haskell"><span class="varid">findVec</span> <span class="keyglyph">::</span> (<span class="conid">Eq1</span> <span class="varid">f</span>, <span class="conid">Pred1</span> <span class="varid">f</span>) <span class="keyglyph">=&gt;</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Vec</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Maybe</span> (<span class="conid">Fin</span> <span class="varid">n</span>) </pre><p>What is that <tt><span class="conid">Pred1</span></tt> class? And why do we need it? When you have a value of type <tt class='complex'><span class="varid">f</span> <span class="varid">n</span></tt>, and you want to compare it to the elements of a vector, you will quickly discover that these elements have different types, <tt class='complex'><span class="varid">f</span> <span class="varid">m</span></tt> with <tt class='complex'><span class="varid">m</span> <span class="varop">&lt;</span> <span class="varid">n</span></tt>. So, we need to either convert the <tt class='complex'><span class="varid">f</span> <span class="varid">n</span></tt> to the <tt class='complex'><span class="varid">f</span> <span class="varid">m</span></tt> or vice-versa. </p><p>I'll go with the former, because that means the search can stop early. If a node refers to a child <tt><span class="conid">Fin0</span></tt>, that means it points to the first node in the DAG. So there is no point in looking if it is duplicated anywhere in vector, because other nodes can't possibly refer to earlier ones. </p><p>What the <tt><span class="conid">Pred1</span></tt> class does is tell you: "if this item occurred one place later in the vector, what would it look like?". And if it can not occur in later places return <tt><span class="conid">Nothing</span></tt>: </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Pred1</span> <span class="varid">f</span> <span class="keyword">where</span> <span class="varid">pred1</span> <span class="keyglyph">::</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Maybe</span> (<span class="varid">f</span> <span class="varid">n</span>) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Pred1</span> <span class="conid">Fin</span> <span class="keyword">where</span> <span class="varid">pred1</span> <span class="conid">Fin0</span> <span class="keyglyph">=</span> <span class="conid">Nothing</span> <span class="varid">pred1</span> (<span class="conid">FinS</span> <span class="varid">i</span>) <span class="keyglyph">=</span> <span class="conid">Just</span> <span class="varid">i</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Pred1</span> (<span class="conid">Node</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">pred1</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs</span>) <span class="keyglyph">=</span> <span class="conid">Node</span> <span class="varid">x</span> <span class="varop">`fmap`</span> <span class="varid">mapM</span> <span class="varid">pred1</span> <span class="varid">cs</span> </pre><p>Now the search becomes relatively straight forward: </p><pre class="haskell"><span class="varid">findVec</span> <span class="varid">x</span> (<span class="varid">y</span> <span class="conop">:::</span> <span class="varid">ys</span>) <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">pred1</span> <span class="varid">x</span> <span class="keyword">of</span> <span class="conid">Just</span> <span class="varid">x'</span> <span class="keyglyph">|</span> <span class="varid">eq1</span> <span class="varid">x'</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="conid">Just</span> <span class="conid">Fin0</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">-&gt;</span> <span class="conid">FinS</span> <span class="varop">`fmap`</span> <span class="varid">findVec</span> <span class="varid">x'</span> <span class="varid">ys</span> <span class="conid">Nothing</span> <span class="keyglyph">-&gt;</span> <span class="conid">Nothing</span> <span class="varid">findVec</span> <span class="varid">_</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="conid">Nothing</span> </pre><p>The nice thing about GADTs is that it becomes almost impossible to make mistakes, because the typechecker will complain if you do. </p><h2><a name="lifting-boxes"></a>Lifting boxes </h2> <p>When converting a <tt><span class="conid">Tree</span></tt> to a <tt><span class="conid">DAG</span></tt>, we do not know beforehand how many nodes that DAG is going to have. Therefore, we need to put the produced <tt><span class="conid">DAG</span></tt> into an existential box, that hides the parameter <tt><span class="varid">n</span></tt>. </p><p>That is fine for the end result, but it will not work when incrementally constructing a DAG. Suppose you wanted to add two nodes to a DAG. Adding the first node is fine, but then you need to ensure that the children of the second node are still there. In addition, the second node will need to be adjusted: all child references have to be incremented, to skip the first added node. </p><p>That adjusting is done with the the counterpart to <tt><span class="conid">Pred1</span></tt>, the <tt><span class="conid">Succ1</span></tt> class </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Succ1</span> <span class="varid">f</span> <span class="keyword">where</span> <span class="varid">succ1</span> <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Succ1</span> <span class="conid">Fin</span> <span class="keyword">where</span> <span class="varid">succ1</span> <span class="keyglyph">=</span> <span class="conid">FinS</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Succ1</span> (<span class="conid">Node</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">succ1</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs</span>) <span class="keyglyph">=</span> <span class="conid">Node</span> <span class="varid">x</span> (<span class="varid">map</span> <span class="conid">FinS</span> <span class="varid">cs</span>) </pre><p>Our box will come with the ability to 'lift' any succable value into it: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyword">where</span> <span class="conid">Box</span> <span class="keyglyph">::</span> (<span class="keyword">forall</span> <span class="varid">g</span><span class="varop">.</span> <span class="conid">Succ1</span> <span class="varid">g</span> <span class="keyglyph">=&gt;</span> <span class="varid">g</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">g</span> <span class="varid">m</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">m</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> </pre><p>You can think of <tt class='complex'><span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span></tt> as a value of <tt class='complex'><span class="varid">f</span> <span class="varid">m</span></tt> where <tt class='complex'><span class="varid">m</span> <span class="varop">&gt;=</span> <span class="varid">n</span></tt>. This allows turning any <tt class='complex'><span class="varid">g</span> <span class="varid">n</span></tt> into a <tt class='complex'><span class="varid">g</span> <span class="varid">m</span></tt>, which can be combined with the value in the box. Before we can see <tt><span class="conid">Box</span></tt> in action, we will first need some functors to store things: </p><pre class="haskell"><span class="comment">-- product functor</span> <span class="keyword">data</span> (<span class="conop">:*:</span>) <span class="varid">f</span> <span class="varid">g</span> <span class="varid">a</span> <span class="keyglyph">=</span> (<span class="conop">:*:</span>) { <span class="varid">fst1</span> <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">a</span>, <span class="varid">snd1</span> <span class="keyglyph">::</span> <span class="varid">g</span> <span class="varid">a</span> } <span class="comment">-- functor composition</span> <span class="keyword">newtype</span> (<span class="conop">:.:</span>) <span class="varid">f</span> <span class="varid">g</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Comp</span> { <span class="varid">getComp</span> <span class="keyglyph">::</span> <span class="varid">f</span> (<span class="varid">g</span> <span class="varid">a</span>) } </pre><p>Now when adding a node we check if it is already in the DAG, and if so, return the index. If the node is not yet in the DAG, then add it. By adding the node the DAG becomes 1 larger, from a <tt class='complex'><span class="conid">DAG</span> <span class="varid">n</span></tt> we get a <tt class='complex'><span class="conid">DAG</span> (<span class="conid">Succ</span> <span class="varid">n</span>)</tt>. Therefore, we need one level of <tt><span class="varid">succ</span></tt>. </p><pre class="haskell"><span class="varid">consNode</span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Node</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="conid">Fin</span> <span class="conop">:*:</span> <span class="conid">DAG</span> <span class="varid">a</span>) <span class="varid">n</span> <span class="varid">consNode</span> <span class="varid">n</span> <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">findVec</span> <span class="varid">n</span> <span class="varid">dag</span> <span class="keyword">of</span> <span class="conid">Just</span> <span class="varid">i</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> <span class="varid">id</span> (<span class="varid">i</span> <span class="conop">:*:</span> <span class="varid">dag</span>) <span class="conid">Nothing</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> <span class="varid">succ1</span> (<span class="conid">Fin0</span> <span class="conop">:*:</span> (<span class="varid">n</span> <span class="conop">:::</span> <span class="varid">dag</span>)) </pre><p>Now the ugly part: converting an entire node. </p><pre class="haskell"><span class="varid">fromTree</span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="conid">Fin</span> <span class="conop">:*:</span> <span class="conid">DAG</span> <span class="varid">a</span>) <span class="varid">n</span> <span class="varid">fromTree</span> (<span class="conid">TNode</span> <span class="varid">x</span> <span class="varid">cs</span>) <span class="varid">dag<sub>0</sub></span> <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">fromForest</span> <span class="varid">cs</span> <span class="varid">dag<sub>0</sub></span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">to<sub>1</sub></span> (<span class="conid">Comp</span> <span class="varid">cs<sub>1</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>1</sub></span>) <span class="varop">-&gt;</span> <span class="keyword">case</span> <span class="varid">consNode</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs<sub>1</sub></span>) <span class="varid">dag<sub>1</sub></span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">to<sub>2</sub></span> <span class="varid">ans</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="varid">to<sub>2</sub></span> <span class="varop">.</span> <span class="varid">to<sub>1</sub></span>) <span class="varid">ans</span> </pre><p>And a forest, aka. a list of trees: </p><pre class="haskell"><span class="varid">fromForest</span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="listcon">[</span><span class="conid">Tree</span> <span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> ((<span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:.:</span> <span class="conid">Fin</span>) <span class="conop">:*:</span> <span class="conid">DAG</span> <span class="varid">a</span>) <span class="varid">n</span> <span class="varid">fromForest</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="conid">Box</span> <span class="varid">id</span> <span class="varop">\$</span> <span class="conid">Comp</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:*:</span> <span class="varid">dag</span> <span class="varid">fromForest</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="varid">dag<sub>0</sub></span> <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">fromForest</span> <span class="varid">xs</span> <span class="varid">dag<sub>0</sub></span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">to<sub>1</sub></span> (<span class="conid">Comp</span> <span class="varid">xs<sub>1</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>1</sub></span>) <span class="varop">-&gt;</span> <span class="keyword">case</span> <span class="varid">fromTree</span> <span class="varid">x</span> <span class="varid">dag<sub>1</sub></span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">to<sub>2</sub></span> (<span class="varid">x<sub>2</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>2</sub></span>) <span class="varop">-&gt;</span> <span class="conid">Box</span> (<span class="varid">to<sub>2</sub></span> <span class="varop">.</span> <span class="varid">to<sub>1</sub></span>) (<span class="conid">Comp</span> (<span class="varid">x<sub>2</sub></span> <span class="listcon">:</span> <span class="varid">map</span> <span class="varid">to<sub>2</sub></span> <span class="varid">xs<sub>1</sub></span>) <span class="conop">:*:</span> <span class="varid">dag<sub>2</sub></span>) </pre><p>At the top level we start with an empty DAG, and ignore the index of the root (which will always be Fin0). </p><pre class="haskell"><span class="varid">fromTree'</span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="conid">DAG</span> <span class="varid">a</span>) <span class="conid">Zero</span> <span class="varid">fromTree'</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">fromTree</span> <span class="varid">x</span> <span class="conid">Empty</span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">to<sub>1</sub></span> (<span class="varid">_</span> <span class="conop">:*:</span> <span class="varid">dag<sub>1</sub></span>) <span class="varop">-&gt;</span> <span class="conid">Box</span> <span class="varid">to<sub>1</sub></span> <span class="varid">dag<sub>1</sub></span> </pre><p>To understand these functions, you should ignore the <tt><span class="conid">Box</span></tt> constructors, what you are left with is </p><pre class="ghci"><span class="varid">fromTree<sub>pseudo</sub></span> (<span class="conid">TNode</span> <span class="varid">x</span> <span class="varid">cs</span>) <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="keyword">let</span> (<span class="varid">cs'</span>,<span class="varid">dag'</span>) <span class="keyglyph">=</span> <span class="varid">fromForest<sub>pseudo</sub></span> <span class="varid">cs</span> <span class="varid">dag</span> <span class="keyword">in</span> <span class="varid">constNode</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs'</span>) <span class="varid">dag</span> <span class="varid">fromForest<sub>pseudo</sub></span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="varid">dag</span> <span class="varid">fromForest<sub>pseudo</sub></span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="keyword">let</span> (<span class="varid">ns</span>,<span class="varid">dag'</span>) <span class="keyglyph">=</span> <span class="varid">fromForest<sub>pseudo</sub></span> <span class="varid">xs</span> (<span class="varid">n</span>,<span class="varid">dag''</span>) <span class="keyglyph">=</span> <span class="varid">fromTree<sub>pseudo</sub></span> <span class="varid">x</span> <span class="varid">dag'</span> <span class="keyword">in</span> (<span class="varid">n</span><span class="listcon">:</span><span class="varid">ns</span>,<span class="varid">dag''</span>) </pre><p>Here is a test that shows that we are able to recover the sharing that was removed by <tt class='complex'><span class="varid">toTree'</span></tt>: </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">fromTree'</span> (<span class="varid">toTree'</span> <span class="varid">example</span>) <span class="conid">Node</span> <span class="str">&quot;a&quot;</span> <span class="listcon">[</span><span class="num">0</span>,<span class="num">1</span>,<span class="num">1</span>,<span class="num">3</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;b&quot;</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">1</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;c&quot;</span> <span class="listcon">[</span><span class="num">0</span>,<span class="num">1</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;d&quot;</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Node</span> <span class="str">&quot;e&quot;</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:::</span> <span class="conid">Empty</span> <span class="input">λ&gt;</span> <span class="varid">fromTree'</span> (<span class="varid">toTree'</span> <span class="varid">example</span>) <span class="varop">==</span> <span class="conid">Box</span> (<span class="varid">succ1</span> <span class="varop">.</span> <span class="varid">succ1</span> <span class="varop">.</span> <span class="varid">succ1</span> <span class="varop">.</span> <span class="varid">succ1</span> <span class="varop">.</span> <span class="varid">succ1</span>) <span class="varid">example</span> <span class="conid">True</span> </pre><h2><a name="box-is-a-monad"></a>Box is a monad </h2> <p>All this wrapping and unwrapping of <tt><span class="conid">Box</span></tt> is really ugly. It should also remind you of something. That something is a monad. And <tt><span class="conid">Box</span></tt> is indeed a monad, just not a normal Haskell one. Instead it is (surprise, surprise) a 'Monad1': </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Monad1</span> <span class="varid">m</span> <span class="keyword">where</span> <span class="varid">return1</span> <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">f</span> <span class="varid">a</span> (<span class="varop">&gt;&gt;&gt;=</span>) <span class="keyglyph">::</span> <span class="varid">m</span> <span class="varid">f</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> (<span class="keyword">forall</span> <span class="varid">b</span><span class="varop">.</span> <span class="varid">f</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">g</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">g</span> <span class="varid">a</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Monad1</span> <span class="conid">Box</span> <span class="keyword">where</span> <span class="varid">return1</span> <span class="keyglyph">=</span> <span class="conid">Box</span> <span class="varid">id</span> <span class="conid">Box</span> <span class="varid">l</span> <span class="varid">x</span> <span class="varop">&gt;&gt;&gt;=</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">f</span> <span class="varid">x</span> <span class="keyword">of</span> <span class="conid">Box</span> <span class="varid">l'</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="varid">l'</span> <span class="varop">.</span> <span class="varid">l</span>) <span class="varid">y</span> </pre><p>Combine this with two utility functions: </p><pre class="haskell"><span class="comment">-- Lift a value y into a Box</span> <span class="varid">boxLift</span> <span class="keyglyph">::</span> <span class="conid">Succ1</span> <span class="varid">g</span> <span class="keyglyph">=&gt;</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">g</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="varid">f</span> <span class="conop">:*:</span> <span class="varid">g</span>) <span class="varid">n</span> <span class="varid">boxLift</span> (<span class="conid">Box</span> <span class="varid">l</span> <span class="varid">x</span>) <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">Box</span> <span class="varid">l</span> (<span class="varid">x</span> <span class="conop">:*:</span> <span class="varid">l</span> <span class="varid">y</span>) </pre><pre class="haskell"><span class="comment">-- Apply one level of succ before putting things into a Box</span> <span class="varid">boxSucc</span> <span class="keyglyph">::</span> <span class="conid">Box</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> <span class="varid">boxSucc</span> (<span class="conid">Box</span> <span class="varid">l</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="conid">Box</span> (<span class="varid">l</span> <span class="varop">.</span> <span class="varid">succ1</span>) <span class="varid">x</span> </pre><p>And one more <tt><span class="conid">Succ1</span></tt> instance: </p><pre class="haskell"><span class="keyword">instance</span> (<span class="conid">Functor</span> <span class="varid">f</span>, <span class="conid">Succ1</span> <span class="varid">g</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Succ1</span> (<span class="varid">f</span> <span class="conop">:.:</span> <span class="varid">g</span>) <span class="keyword">where</span> <span class="varid">succ1</span> (<span class="conid">Comp</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="conid">Comp</span> (<span class="varid">fmap</span> <span class="varid">succ1</span> <span class="varid">x</span>) </pre><p>Now we can write this slightly less ugly code </p><pre class="haskell"><span class="varid">fromTree<sub>m</sub></span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Tree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> (<span class="conid">Fin</span> <span class="conop">:*:</span> <span class="conid">DAG</span> <span class="varid">a</span>) <span class="varid">n</span> <span class="varid">fromTree<sub>m</sub></span> (<span class="conid">TNode</span> <span class="varid">x</span> <span class="varid">cs</span>) <span class="varid">dag<sub>0</sub></span> <span class="keyglyph">=</span> <span class="varid">fromForest<sub>m</sub></span> <span class="varid">cs</span> <span class="varid">dag<sub>0</sub></span> <span class="varop">&gt;&gt;&gt;=</span> <span class="keyglyph">\</span>(<span class="conid">Comp</span> <span class="varid">cs<sub>1</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>1</sub></span>) <span class="varop">-&gt;</span> <span class="varid">consNode</span> (<span class="conid">Node</span> <span class="varid">x</span> <span class="varid">cs<sub>1</sub></span>) <span class="varid">dag<sub>1</sub></span> <div class='empty-line'></div> <span class="varid">fromForest<sub>m</sub></span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="listcon">[</span><span class="conid">Tree</span> <span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">DAG</span> <span class="varid">a</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> ((<span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:.:</span> <span class="conid">Fin</span>) <span class="conop">:*:</span> <span class="conid">DAG</span> <span class="varid">a</span>) <span class="varid">n</span> <span class="varid">fromForest<sub>m</sub></span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">dag</span> <span class="keyglyph">=</span> <span class="varid">return1</span> <span class="varop">\$</span> <span class="conid">Comp</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conop">:*:</span> <span class="varid">dag</span> <span class="varid">fromForest<sub>m</sub></span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="varid">dag<sub>0</sub></span> <span class="keyglyph">=</span> <span class="varid">fromForest<sub>m</sub></span> <span class="varid">xs</span> <span class="varid">dag<sub>0</sub></span> <span class="varop">&gt;&gt;&gt;=</span> <span class="keyglyph">\</span>(<span class="varid">xs<sub>1</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>1</sub></span>) <span class="varop">-&gt;</span> <span class="varid">fromTree<sub>m</sub></span> <span class="varid">x</span> <span class="varid">dag<sub>1</sub></span> <span class="varop">`boxLift`</span> <span class="varid">xs<sub>1</sub></span> <span class="varop">&gt;&gt;&gt;=</span> <span class="keyglyph">\</span>(<span class="varid">x<sub>2</sub></span> <span class="conop">:*:</span> <span class="varid">dag<sub>2</sub></span> <span class="conop">:*:</span> <span class="conid">Comp</span> <span class="varid">xs<sub>2</sub></span>) <span class="varop">-&gt;</span> <span class="varid">return1</span> <span class="varop">\$</span> <span class="conid">Comp</span> (<span class="varid">x<sub>2</sub></span> <span class="listcon">:</span> <span class="varid">xs<sub>2</sub></span>) <span class="conop">:*:</span> <span class="varid">dag<sub>2</sub></span> </pre><p>This might be even nicer when we add in a state monad for the <tt><span class="conid">DAG</span></tt>, but I'll leave that for (maybe) another time. </p><h2><a name="bonus-alternative-definition-of-box"></a>Bonus: alternative definition of Box </h2> <p>If you don't like existential boxes, then here is another way to define the <tt><span class="conid">Box</span></tt> monad. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyword">where</span> <span class="conid">Box0</span> <span class="keyglyph">::</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="conid">BoxS</span> <span class="keyglyph">::</span> <span class="conid">Box'</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Monad1</span> <span class="conid">Box'</span> <span class="keyword">where</span> <span class="varid">return1</span> <span class="keyglyph">=</span> <span class="conid">Box0</span> <span class="conid">Box0</span> <span class="varid">x</span> <span class="varop">&gt;&gt;&gt;=</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">y</span> <span class="varid">x</span> <span class="conid">BoxS</span> <span class="varid">x</span> <span class="varop">&gt;&gt;&gt;=</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">BoxS</span> (<span class="varid">x</span> <span class="varop">&gt;&gt;&gt;=</span> <span class="varid">y</span>) <div class='empty-line'></div> <span class="varid">boxSucc'</span> <span class="keyglyph">::</span> <span class="conid">Box'</span> <span class="varid">f</span> (<span class="conid">Succ</span> <span class="varid">n</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="varid">boxSucc'</span> <span class="keyglyph">=</span> <span class="conid">BoxS</span> <div class='empty-line'></div> <span class="varid">boxLift'</span> <span class="keyglyph">::</span> <span class="conid">Succ1</span> <span class="varid">g</span> <span class="keyglyph">=&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="varid">g</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> (<span class="varid">f</span> <span class="conop">:*:</span> <span class="varid">g</span>) <span class="varid">n</span> <span class="varid">boxLift'</span> (<span class="conid">Box0</span> <span class="varid">x</span>) <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">Box0</span> (<span class="varid">x</span> <span class="conop">:*:</span> <span class="varid">y</span>) <span class="varid">boxLift'</span> (<span class="conid">BoxS</span> <span class="varid">x</span>) <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">BoxS</span> (<span class="varid">boxLift'</span> <span class="varid">x</span> (<span class="varid">succ1</span> <span class="varid">y</span>)) </pre><p>The two types are equivalent, as shown by </p><pre class="haskell"><span class="varid">equiv<sub>1</sub></span> <span class="keyglyph">::</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> <span class="varid">equiv<sub>1</sub></span> (<span class="conid">Box0</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="varid">return1</span> <span class="varid">x</span> <span class="varid">equiv<sub>1</sub></span> (<span class="conid">BoxS</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="varid">boxSucc</span> (<span class="varid">equiv<sub>1</sub></span> <span class="varid">x</span>) <div class='empty-line'></div> <span class="varid">equiv<sub>2</sub></span> <span class="keyglyph">::</span> <span class="conid">Box</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="varid">equiv<sub>2</sub></span> (<span class="conid">Box</span> <span class="varid">l</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="varid">runUnBox'</span> (<span class="varid">l</span> (<span class="conid">UnBox'</span> <span class="varid">id</span>)) (<span class="conid">Box0</span> <span class="varid">x</span>) <div class='empty-line'></div> <span class="keyword">newtype</span> <span class="conid">UnBox'</span> <span class="varid">f</span> <span class="varid">m</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="conid">UnBox'</span> {<span class="varid">runUnBox'</span> <span class="keyglyph">::</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="conid">Box'</span> <span class="varid">f</span> <span class="varid">m</span>} <span class="keyword">instance</span> <span class="conid">Succ1</span> (<span class="conid">UnBox'</span> <span class="varid">r</span> <span class="varid">f</span>) <span class="keyword">where</span> <span class="varid">succ1</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="conid">UnBox'</span> (<span class="varid">runUnBox'</span> <span class="varid">f</span> <span class="varop">.</span> <span class="conid">BoxS</span>) </pre> Finding rectangles, part 3: divide and conquer http://twanvl.nl/blog/haskell/finding-rectangles-part3 2012-02-11T22:13:00Z <p>In <a href="blog/haskell/finding-rectangles-part2">part 2 of this series</a>, I looked at finding axis aligned rectangles in binary images. I left you hanging with a hint of a more efficient algorithm than the <span class="math">O(n<sup>3</sup>)</span> one from that post. Formally, the problem we were trying to solve was: </p><blockquote style="font-style:italic;"> <p>Given a binary image, find the largest axis aligned rectangle with a 1 pixel wide border that consists entirely of foreground pixels. </p></blockquote> <p>Here is the same example as last time, <br><img src="image/find-rect/rects2-best.png" style="margin-left:2em;">,<br> where white pixels are the background and blue is the foreground. The rectangle with the largest area is indicated in red. </p><h2><a name="a-rectangle-is-two-brackets"></a>A rectangle is two brackets </h2> <p>The idea behind the more efficient algorithm is simple. Draw a vertical line <span class="math">x=x<sub>mid</sub></span> through the middle of the image, <br><img src="image/find-rect/rects2-mid.png" style="margin-left:2em;">.<br> If the largest rectangle in an image is large enough, then it will intersect this line. The one in the example above certainly does. So, the idea is to only look at rectangles that intersect <span class="math">x=x<sub>mid</sub></span>. We will worry about other cases later. </p><p>Each rectangle that intersects the vertical line consists of of a <em>left bracket</em> and a <em>right bracket</em>, just look at this ASCII art: <tt>[]</tt>, or at these images: <br> <img src="image/find-rect/rects2-lbracket.png" style="margin-left:2em;vertical-align:middle;"> and <img src="image/find-rect/rects2-rbracket.png" style="vertical-align:middle;">. </p><p>To find all rectangles intersecting <span class="math">x=x<sub>mid</sub></span>, we need to find these left and right brackets, and combine them. Note that the middle column is included in both the left and right bracket, because that makes it easier to handle rectangles and bracked of width=1. </p><p>Let's focus on finding the right brackets first. For each pair of <span class="math">y</span>-coordinates and height, there is at most one largest right bracket. We don't need to consider the smaller ones. So, let's define a function that finds the width of the largest right bracket for all <span class="math">y</span>-coordinates and heights. The function takes as input just the right part of the image, and it will return the result in list of lists: </p><pre class="haskell"><span class="varid">rightBracketWidths</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Maybe</span> <span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> </pre><p>Here is a slow 'specification-style' implementation </p><pre class="haskell"><span class="varid">rightBracketWidths<sub>slow</sub></span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="listcon">[</span> <span class="listcon">[</span> <span class="varid">findLast</span> (<span class="varid">containsBracket</span> <span class="varid">im</span> <span class="varid">y</span> <span class="varid">h</span>) <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">imWidth</span> <span class="varid">im</span><span class="listcon">]</span> <span class="keyglyph">|</span> <span class="varid">h</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">imHeight</span> <span class="varid">im</span><span class="varop">-</span><span class="varid">y</span><span class="listcon">]</span> <span class="listcon">]</span> <span class="keyglyph">|</span> <span class="varid">y</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="varid">imHeight</span> <span class="varid">im</span><span class="num">-1</span><span class="listcon">]</span> <span class="listcon">]</span> <span class="keyword">where</span> <span class="varid">findLast</span> <span class="varid">pred</span> <span class="keyglyph">=</span> <span class="varid">find</span> <span class="varid">pred</span> <span class="varop">.</span> <span class="varid">reverse</span> </pre><p>How do we even check that a right bracket is in an image? For that we can look at <a href="blog/haskell/finding-rectangles#h2-finding-lines">right and bottom endpoints</a>: </p><pre class="haskell"><span class="comment">-- pseudo code</span> <span class="varid">containsBracket</span> <span class="varid">im</span> <span class="varid">y</span> <span class="varid">h</span> <span class="varid">w</span> <span class="keyglyph">=</span> <span class="varid">r</span> <span class="varop">!!</span> <span class="varid">y</span> <span class="varop">!!</span> <span class="num">0</span> <span class="varop">&gt;=</span> <span class="varid">w</span> <span class="comment">-- top border</span> <span class="varop">&amp;&amp;</span> <span class="varid">r</span> <span class="varop">!!</span> (<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>) <span class="varop">!!</span> <span class="num">0</span> <span class="varop">&gt;=</span> <span class="varid">w</span> <span class="comment">-- bottom border</span> <span class="varop">&amp;&amp;</span> <span class="varid">b</span> <span class="varop">!!</span> <span class="varid">y</span> <span class="varop">!!</span> (<span class="varid">w</span><span class="num">-1</span>) <span class="varop">&gt;=</span> <span class="varid">y</span><span class="varop">+</span><span class="varid">h</span> <span class="comment">-- right border</span> </pre><p>Here I used two dimensional indexing. So <tt class='complex'><span class="varid">r</span><span class="varop">!!</span><span class="varid">y</span><span class="varop">!!</span><span class="num">0</span></tt> stands for the right endpoint for column <tt><span class="num">0</span></tt> of row <tt><span class="varid">y</span></tt>; or in other words, the number of foreground pixels at the start of that row. </p><p>This image illustrates the right endpoints of the top and bottom border in green, and the bottom endpoint of the right border in red. The bracket (in glorious pink) has to fit between these indicated endpoints. <br> <img src="image/find-rect/rects2-rbracket-conditions.png" style="margin-left:2em;">. </p><p>The <tt><span class="varid">rightBracketWidths<sub>slow</sub></span></tt> function is, as the name suggests, slow. It does a linear search over the possible widths. With that it would take <span class="math">O(m<sup>2</sup>*n)</span> to find all widths for an <span class="math">m</span> by <span class="math">n</span> image. That is no better than the complexity of the algorithm from last time. </p><h2><a name="faster-searching"></a>Faster searching </h2> <p>In <a href="blog/haskell/SemilatticeSearchTree">my previous blog post</a>, I introduced a <tt><span class="conid">SearchTree</span></tt> type that answers just the type <tt><span class="varid">findLast</span></tt> query that we need. In fact, this rectangle problem was why I made that <tt><span class="conid">SearchTree</span></tt> data structure in the first place. </p><p>There are three conditions in <tt><span class="varid">containsBracket</span></tt>. We will handle the one for the top border, <tt class='complex'><span class="varid">r</span><span class="varop">!!</span><span class="varid">y</span><span class="varop">!!</span><span class="num">0</span> <span class="varop">&gt;=</span> <span class="varid">w</span></tt> by building a separate search tree for each <tt><span class="varid">y</span></tt>. This search tree then only the widths <tt class='complex'><span class="varid">w</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">r</span><span class="varop">!!</span><span class="varid">y</span><span class="varop">!!</span><span class="num">0</span><span class="listcon">]</span></tt>. </p><p>That leaves the conditions on the bottom and right borders. Since we fixed <tt><span class="varid">y</span></tt>, we can directly write these conditions in terms of a <tt><span class="conid">SearchTree</span></tt> query: For the bottom border we need <tt class='complex'><span class="varid">satisfy</span> (<span class="conid">Ge</span> (<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span>)) (<span class="varid">b</span><span class="varop">!!</span><span class="varid">y</span><span class="varop">!!</span>(<span class="varid">w</span><span class="num">-1</span>))</tt>, and for the right border <tt class='complex'><span class="varid">satisfy</span> (<span class="conid">Le</span> (<span class="varid">r</span><span class="varop">!!</span>(<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>)<span class="varop">!!</span><span class="num">0</span>)) <span class="varid">w</span></tt>. As you can hopefully see, these are exactly the same as the conditions in the <tt><span class="varid">containsBracket</span></tt> function above. </p><p>We can combine the two conditions into a pair, to give <tt class='complex'>(<span class="conid">Ge</span> (<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span>), <span class="conid">Le</span> (<span class="varid">r</span><span class="varop">!!</span>(<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>)<span class="varop">!!</span><span class="num">0</span>))</tt>. While, to build the search tree, we need to pair <tt class='complex'><span class="varid">b</span><span class="varop">!!</span><span class="varid">y</span><span class="varop">!!</span>(<span class="varid">w</span><span class="num">-1</span>)</tt> with <tt><span class="varid">w</span></tt>. That is just a matter of zipping two lists together: </p><pre class="haskell"><span class="varid">bracketsAtY</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Maybe</span> <span class="conid">Int</span><span class="listcon">]</span> <span class="varid">bracketsAtY</span> <span class="varid">y</span> <span class="varid">bs<sub>y</sub></span> <span class="varid">rs</span><span class="varop">@</span>(<span class="varid">r<sub>y</sub></span><span class="listcon">:</span><span class="varid">_</span>) <span class="keyglyph">=</span> <span class="listcon">[</span> <span class="varid">fmap</span> (<span class="keyglyph">\</span>(<span class="conid">Max</span> <span class="varid">b<sub>yw1</sub></span>, <span class="conid">Min</span> <span class="varid">w</span>) <span class="keyglyph">-&gt;</span> <span class="varid">w</span>) (<span class="varid">findLast</span> (<span class="conid">Ge</span> (<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span>),<span class="conid">Le</span> <span class="varid">r<sub>yh1</sub></span>) <span class="varid">searchTree</span>) <span class="keyglyph">|</span> (<span class="varid">h</span>,<span class="varid">r<sub>yh1</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">zip</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="listcon">]</span> <span class="varid">rs</span> <span class="listcon">]</span> <span class="keyword">where</span> <span class="varid">searchTree</span> <span class="keyglyph">=</span> <span class="varid">fromList</span> <span class="listcon">[</span> (<span class="conid">Max</span> <span class="varid">b<sub>yw1</sub></span>, <span class="conid">Min</span> <span class="varid">w</span>) <span class="keyglyph">|</span> (<span class="varid">b<sub>yw1</sub></span>,<span class="varid">w</span>) <span class="keyglyph">&lt;-</span> <span class="varid">zip</span> <span class="varid">bs<sub>y</sub></span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">r<sub>y</sub></span><span class="listcon">]</span> <span class="listcon">]</span> <span class="comment">-- notation:</span> <span class="comment">-- bs<sub>y</sub> = [b!!y!!0, b!!y!!1, ..]</span> <span class="comment">-- rs = [r!!y!!0, r!!(y+1)!!0, ..]</span> <span class="comment">-- b<sub>yw1</sub> = b!!y!!(w-1)</span> <span class="comment">-- r<sub>y</sub> = r!!y!!0</span> <span class="comment">-- r<sub>yh1</sub> = r!!(y+h-1)!!0</span> </pre><p>We need to call <tt><span class="varid">bracketsAtY</span></tt> for each <tt><span class="varid">y</span></tt>, together with the right row of bottom endpoints, and right endpoints: </p><pre class="haskell"><span class="varid">rightBracketWidths</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">zipWith3</span> <span class="varid">bracketsAtY</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="listcon">]</span> <span class="varid">b</span> (<span class="varid">tails</span> (<span class="varid">map</span> <span class="varid">head</span> <span class="varid">r</span>)) <span class="keyword">where</span> <span class="comment">-- as in <a href="blog/haskell/finding-rectangles">the previous posts</a></span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="varid">y</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">scanLeftward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">x</span>) <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">r</span> <span class="keyword">else</span> <span class="varid">x</span>) (<span class="varid">imWidth</span> <span class="varid">a</span>) (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">x</span>) <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">scanUpward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">y</span>) <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">b</span> <span class="keyword">else</span> <span class="varid">y</span>) (<span class="varid">imHeight</span> <span class="varid">a</span>) (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">y</span>) </pre><p>QuickCheck will confirm that this function is the same as the slow version above: </p><pre class="haskell"><span class="varid">prop_rightBracketWidths</span> <span class="keyglyph">=</span> <span class="varid">forAll</span> <span class="varid">genImage</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">im</span> <span class="varop">-&gt;</span> <span class="varid">rightBracketWidths</span> <span class="varid">im</span> <span class="varop">==</span> <span class="varid">rightBracketWidths<sub>slow</sub></span> <span class="varid">im</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">quickCheck</span> <span class="varid">prop_rightBracketWidths</span> <span class="varop">+++</span> <span class="conid">OK</span>, <span class="varid">passed</span> <span class="num">100</span> <span class="varid">tests</span><span class="varop">.</span> </pre><p>With the efficient search trees, <tt><span class="varid">bracketsAtY</span></tt> takes <span class="math">O((m+n)*log n)</span> time, and <tt><span class="varid">rightBracketWidths</span></tt> takes <span class="math">O(m*(m+n)*log n)</span> time for an <span class="math">m</span> by <span class="math">n</span> image. For large images this is much faster than the <span class="math">O(m<sup>2</sup>*n)</span> linear search. </p><h2><a name="from-brackets-to-rectangles"></a>From brackets to rectangles </h2> <p>If we have a way of finding right brackets, we can easily reuse that function for left brackets, by just flipping the image. </p><pre class="haskell"><span class="varid">leftBracketWidths</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Maybe</span> <span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">leftBracketWidths</span> <span class="keyglyph">=</span> <span class="varid">rightBracketWidths</span> <span class="varop">.</span> <span class="varid">flipHorziontal</span> <span class="keyword">where</span> <span class="varid">flipHorziontal</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="varid">reverse</span> </pre><p>Once we have the left and right brackets, we can combine them into rectangles. Suppose that a left bracket has width <tt><span class="varid">lw</span></tt>, and the right bracket <tt><span class="varid">rw</span></tt>. Then the width of the rectangle they form is <tt class='complex'><span class="varid">lw</span><span class="varop">+</span><span class="varid">rw</span><span class="num">-1</span></tt>, since both include the middle line. </p><pre class="haskell"><span class="varid">combineBrackets</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Maybe</span> <span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Maybe</span> <span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">combineBrackets</span> <span class="varid">x<sub>mid</sub></span> <span class="varid">lbrackets</span> <span class="varid">rbrackets</span> <span class="keyglyph">=</span> <span class="listcon">[</span> <span class="conid">Rect</span> (<span class="varid">x<sub>mid</sub></span><span class="varop">-</span><span class="varid">lw</span><span class="varop">+</span><span class="num">1</span>) <span class="varid">y</span> (<span class="varid">lw</span><span class="varop">+</span><span class="varid">rw</span><span class="num">-1</span>) <span class="varid">h</span> <span class="keyglyph">|</span> (<span class="varid">y</span>,<span class="varid">lws</span>,<span class="varid">rws</span>) <span class="keyglyph">&lt;-</span> <span class="varid">zip3</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="listcon">]</span> <span class="varid">lbrackets</span> <span class="varid">rbrackets</span> , (<span class="varid">h</span>,<span class="conid">Just</span> <span class="varid">lw</span>,<span class="conid">Just</span> <span class="varid">rw</span>) <span class="keyglyph">&lt;-</span> <span class="varid">zip3</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="listcon">]</span> <span class="varid">lws</span> <span class="varid">rws</span> <span class="listcon">]</span> </pre><p>And finding (a superset of) all the maximal rectangles intersecting the vertical line <span class="math">x=x<sub>mid</sub></span> can be done by cutting the image on that line, finding brackets, and combining them. </p><pre class="haskell"><span class="varid">rectsIntersecting</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">rectsIntersecting</span> <span class="varid">x<sub>mid</sub></span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">combineBrackets</span> <span class="varid">x<sub>mid</sub></span> <span class="varid">brackets<sub>left</sub></span> <span class="varid">brackets<sub>right</sub></span> <span class="keyword">where</span> <span class="varid">im<sub>left</sub></span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">take</span> (<span class="varid">x<sub>mid</sub></span><span class="varop">+</span><span class="num">1</span>)) <span class="varid">im</span> <span class="varid">im<sub>right</sub></span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">drop</span> <span class="varid">x<sub>mid</sub></span>) <span class="varid">im</span> <span class="varid">brackets<sub>left</sub></span> <span class="keyglyph">=</span> <span class="varid">leftBracketWidths</span> <span class="varid">im<sub>left</sub></span> <span class="varid">brackets<sub>right</sub></span> <span class="keyglyph">=</span> <span class="varid">rightBracketWidths</span> <span class="varid">im<sub>right</sub></span> </pre><h2><a name="divide-and-conquer"></a>Divide and conquer </h2> <p>We left out one important case: what if the largest rectangle does not intersect the mid-line? For that purpose man has invented recursion: First look for rectangles intersecting the middle, and then look for rectangles not intersecting the middle. For that we need to look in the left and right halves. </p><p>To make this asymptotically fast, we have to ensure that both the width and height decrease. Since the time complexity of <tt><span class="varid">rectsIntersecting</span></tt> includes a <span class="math">log n</span> term, it is faster for wide images. So, if the image is tall, we just transpose it to make it wide instead. </p><p>The recursion pattern of vertical and horizontal and middle lines will in the end look something like this: <br> <img src="image/find-rect/rects2-recurse.png" style="margin-left:2em;">, <br> with the first level in yellow, the second in green, then magenta and red. So in the first level we find all rectangles intersecting the yellow line. Then in the second level all rectangles intersecting a green line, and so on. </p><p>Here is the code: </p><pre class="haskell"><span class="varid">allRectsRecurse</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">allRectsRecurse</span> <span class="varid">im</span> <span class="comment">-- empty image ==&gt; no rectangles</span> <span class="keyglyph">|</span> <span class="varid">imWidth</span> <span class="varid">im</span> <span class="varop">==</span> <span class="num">0</span> <span class="varop">||</span> <span class="varid">imHeight</span> <span class="varid">im</span> <span class="varop">==</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="comment">-- height &gt; width? ==&gt; transpose</span> <span class="keyglyph">|</span> <span class="varid">imHeight</span> <span class="varid">im</span> <span class="varop">&gt;</span> <span class="varid">imWidth</span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="varid">transposeRect</span> <span class="varop">.</span> <span class="varid">allRectsRecurse</span> <span class="varop">.</span> <span class="varid">transpose</span> <span class="varop">\$</span> <span class="varid">im</span> <span class="comment">-- find and recruse</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">rectsIntersecting</span> <span class="varid">x<sub>mid</sub></span> <span class="varid">im</span> <span class="comment">-- find</span> <span class="varop">++</span> <span class="varid">findRectsRecurse</span> <span class="varid">im<sub>left</sub></span> <span class="comment">-- recurse left</span> <span class="varop">++</span> <span class="varid">map</span> (<span class="varid">moveRect</span> (<span class="varid">x<sub>mid</sub></span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span>) (<span class="varid">allRectsRecurse</span> <span class="varid">im<sub>right</sub></span>) <span class="comment">-- recurse right</span> <span class="keyword">where</span> <span class="varid">x<sub>mid</sub></span> <span class="keyglyph">=</span> <span class="varid">imWidth</span> <span class="varid">im</span> <span class="varop">`div`</span> <span class="num">2</span> <span class="varid">im<sub>left</sub></span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">take</span> <span class="varid">x<sub>mid</sub></span>) <span class="varid">im</span> <span class="comment">-- *excluding* the middle line</span> <span class="varid">im<sub>right</sub></span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">drop</span> (<span class="varid">x<sub>mid</sub></span><span class="varop">+</span><span class="num">1</span>)) <span class="varid">im</span> </pre><p>where </p><pre class="haskell"><span class="varid">transposeRect</span> <span class="keyglyph">::</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">transposeRect</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) <span class="keyglyph">=</span> <span class="conid">Rect</span> <span class="varid">y</span> <span class="varid">x</span> <span class="varid">h</span> <span class="varid">w</span> <div class='empty-line'></div> <span class="varid">moveRect</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">moveRect</span> <span class="varid">dx</span> <span class="varid">dy</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) <span class="keyglyph">=</span> <span class="conid">Rect</span> (<span class="varid">x</span><span class="varop">+</span><span class="varid">dx</span>) (<span class="varid">y</span><span class="varop">+</span><span class="varid">dy</span>) <span class="varid">w</span> <span class="varid">h</span> </pre><p>Since the image is roughly halved in each recursion step, the recursio will have depth <span class="math">O(log n)</span> for an <span class="math">n</span> by <span class="math">n</span> image. At each level, the <tt><span class="varid">rectsIntersecting</span></tt> calls will take <span class="math">O(n<sup>2</sup>*log n)</span> time, for a total of <span class="math">O(n<sup>2</sup>*(log n)<sup>2</sup>)</span>. This is significantly faster than the <span class="math">O(n<sup>3</sup>)</span> from the previous post. </p><p>For the complexity theorists: it is possible to do slightly better by using a <a href="http://en.wikipedia.org/wiki/Disjoint-set_data_structure">disjoint-set (union-find) data structure</a> instead of a search tree for finding brackets. I believe that would bring the runtime down to <span class="math">O(n<sup>2</sup>*log n*α(n))</span> where α is the inverse Ackermann function. Unfortunately such a data structure requires mutation, the correctness proofs are much harder, and the gain is quite small. </p><p>Let me end by checking that the set of maximal rectangles we find are the same as those found by the specification from the previous post. Then by extension the largest rectangle found will also be the same. </p><pre class="haskell"><span class="varid">prop_maximalRects</span> <span class="keyglyph">=</span> <span class="varid">forAll</span> <span class="varid">genImage</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">im</span> <span class="varop">-&gt;</span> (<span class="varid">sort</span> <span class="varop">.</span> <span class="varid">onlyTrulyMaximalRects</span> <span class="varop">.</span> <span class="varid">allRects</span>) <span class="varid">im</span> <span class="varop">==</span> (<span class="varid">sort</span> <span class="varop">.</span> <span class="varid">onlyTrulyMaximalRects</span> <span class="varop">.</span> <span class="varid">allRectsRecurse</span>) <span class="varid">im</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">quickCheck</span> <span class="varid">prop_maximalRects</span> <span class="varop">+++</span> <span class="conid">OK</span>, <span class="varid">passed</span> <span class="num">100</span> <span class="varid">tests</span><span class="varop">.</span> </pre> Search trees without sorting http://twanvl.nl/blog/haskell/SemilatticeSearchTree 2012-02-07T22:56:00Z <p>Binary search trees are used quite often for storing or finding values. Like a binary search, they essentially work by sorting the items. </p><p>In this post I will describe a search tree that does not require that the items be sorted. Hence, the tree can support some interesting queries. The queries will always be correct, but they will only be fast in some cases. </p><h2><a name="bounds"></a>Bounds </h2> <p>Usually, to make searching fast, each branch in a search tree stores information that helps to decide whether to go left or right. But if we want to be able to construct a tree for any possible type of query, then that is not always possible. Instead, we can still aim to eliminate large parts of the search space, by storing bounds. </p><p>Suppose we have a tree that stores integers, and we want to find the first item in the tree that is greater or equal to some query integer. In each branch of the tree, we could store the maximum of all values in that subtree. Call it the upper bound of the subtree. If this upper bound is less than the query, then we can eliminate the entire subtree from consideration. </p><p>Now let's generalize that. The maximum value is an example of a <a href="http://en.wikipedia.org/wiki/Semilattice">semilattice</a>. That is just a fancy way of saying that for a pair of values we can get some kind of bound. As a typeclass it looks like </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Semilattice</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">meet</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="comment">-- Laws: meet is associative, commutative and idempotent:</span> <span class="comment">-- meet a (meet b c) = meet (meet a b) c</span> <span class="comment">-- meet a b = meet b a</span> <span class="comment">-- meet a a = a</span> </pre><p>The queries we perform on the tree should of course work together with the bounds. That means that if a bound for a branch in the tree doesn't satisfy the query, then none of the values in the subtree do. In haskell terms: </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Semilattice</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">|</span> <span class="varid">q</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">satisfy</span> <span class="keyglyph">::</span> <span class="varid">q</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="comment">-- Law: satisfy q a || satisfy q b ==&gt; satisfy q (meet a b)</span> </pre><p>Note that a semilattice always gives a partial order, and hence a satisfy function by </p><pre class="ghci"><span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">meet</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">a</span> </pre><p>because </p><pre class="ghci"> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">||</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">b</span> <span class="varop">&lt;=&gt;</span> <span class="varid">meet</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">a</span> <span class="varop">||</span> <span class="varid">meet</span> <span class="varid">q</span> <span class="varid">b</span> <span class="varop">==</span> <span class="varid">b</span> <span class="varop">==&gt;</span> <span class="varid">meet</span> (<span class="varid">meet</span> <span class="varid">q</span> <span class="varid">a</span>) <span class="varid">b</span> <span class="varop">==</span> <span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">||</span> <span class="varid">meet</span> <span class="varid">a</span> (<span class="varid">meet</span> <span class="varid">q</span> <span class="varid">b</span>) <span class="varop">==</span> <span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">&lt;=&gt;</span> <span class="varid">meet</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) <span class="varop">==</span> <span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">||</span> <span class="varid">meet</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) <span class="varop">==</span> <span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">&lt;=&gt;</span> <span class="varid">meet</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) <span class="varop">==</span> <span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">&lt;=&gt;</span> <span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) </pre><p>However, I keep the distinction between the query and value type for more flexibility and for more descriptive types. </p><h2><a name="implementation"></a>Implementation </h2> <p>Given the <tt><span class="conid">Satisfy</span></tt> and <tt><span class="conid">Semilattice</span></tt> typeclasses, the search tree datastructure is straight forward. A search tree can be empty, a single value, or a branch. In each branch we store the bound of that subtree. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Empty</span> <span class="keyglyph">|</span> <span class="conid">Leaf</span> <span class="varop">!</span><span class="varid">a</span> <span class="keyglyph">|</span> <span class="conid">Branch</span> <span class="varop">!</span><span class="varid">a</span> (<span class="conid">SearchTree</span> <span class="varid">a</span>) (<span class="conid">SearchTree</span> <span class="varid">a</span>) <span class="keyword">deriving</span> (<span class="conid">Show</span>) <div class='empty-line'></div> <span class="varid">bound</span> <span class="keyglyph">::</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">bound</span> (<span class="conid">Leaf</span> <span class="varid">a</span>) <span class="keyglyph">=</span> <span class="varid">a</span> <span class="varid">bound</span> (<span class="conid">Branch</span> <span class="varid">a</span> <span class="varid">_</span> <span class="varid">_</span>) <span class="keyglyph">=</span> <span class="varid">a</span> <span class="varid">bound</span> <span class="conid">Empty</span> <span class="keyglyph">=</span> <span class="varid">error</span> <span class="str">&quot;bound Empty&quot;</span> </pre><p>If we have a <tt><span class="conid">SearchTree</span></tt>, then we can find the first element that satisfies a query, simply by searching both sides of each branch. The trick to making the search faster is to only continue as long as the bound satisfies the query: </p><pre class="haskell"><span class="comment">-- Find the first element in the tree that satisfies the query</span> <span class="varid">findFirst</span> <span class="keyglyph">::</span> <span class="conid">Satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="varid">q</span> <span class="keyglyph">-&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Maybe</span> <span class="varid">a</span> <span class="varid">findFirst</span> <span class="varid">q</span> (<span class="conid">Leaf</span> <span class="varid">a</span>) <span class="keyglyph">|</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Just</span> <span class="varid">a</span> <span class="varid">findFirst</span> <span class="varid">q</span> (<span class="conid">Branch</span> <span class="varid">a</span> <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">|</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">findFirst</span> <span class="varid">q</span> <span class="varid">x</span> <span class="varop">`mplus`</span> <span class="varid">findFirst</span> <span class="varid">q</span> <span class="varid">y</span> <span class="varid">findFirst</span> <span class="varid">_</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="conid">Nothing</span> </pre><p>Completely analogously, we can find the last satisfied item instead: </p><pre class="haskell"><span class="comment">-- Find the last element in the tree that satisfies the query</span> <span class="varid">findLast</span> <span class="keyglyph">::</span> <span class="conid">Satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="varid">q</span> <span class="keyglyph">-&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Maybe</span> <span class="varid">a</span> <span class="varid">findLast</span> <span class="varid">q</span> (<span class="conid">Leaf</span> <span class="varid">a</span>) <span class="keyglyph">|</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Just</span> <span class="varid">a</span> <span class="varid">findLast</span> <span class="varid">q</span> (<span class="conid">Branch</span> <span class="varid">a</span> <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">|</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">findLast</span> <span class="varid">q</span> <span class="varid">y</span> <span class="varop">`mplus`</span> <span class="varid">findLast</span> <span class="varid">q</span> <span class="varid">x</span> <span class="varid">findLast</span> <span class="varid">_</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="conid">Nothing</span> </pre><p>Or we can even generalize this search to any <tt><span class="conid">Monoid</span></tt>, where the above are for the <a href="http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Monoid.html#t:First"><tt><span class="conid">First</span></tt></a> and <a href="http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Monoid.html#t:Last"><tt><span class="conid">Last</span></tt></a> monoids respectively. I will this leave as an exercise for the reader. </p><h2><a name="constructing"></a>Constructing </h2> <p>The basis of each tree are branches. We will always construct branches with a smart constructor that calculates the bound as the meet of the bounds of its two arguments. That way, the stored bound is always correct. </p><pre class="haskell"><span class="varid">mkBranch</span> <span class="keyglyph">::</span> <span class="conid">Semilattice</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="varid">mkBranch</span> <span class="conid">Empty</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">y</span> <span class="varid">mkBranch</span> <span class="varid">x</span> <span class="conid">Empty</span> <span class="keyglyph">=</span> <span class="varid">x</span> <span class="varid">mkBranch</span> <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="conid">Branch</span> (<span class="varid">bound</span> <span class="varid">x</span> <span class="varop">`meet`</span> <span class="varid">bound</span> <span class="varid">y</span>) <span class="varid">x</span> <span class="varid">y</span> </pre><p>A search will always take time at least linear in the <em>depth</em> of the tree. So, for fast searches we need a balanced tree, where each subtree has roughly the same size. Here is arguably the most tricky part of the code, which converts a list to a balanced search tree. </p><pre class="haskell"><span class="comment">-- /O(n*log n)/</span> <span class="comment">-- Convert a list to a balanced search tree</span> <span class="varid">fromList</span> <span class="keyglyph">::</span> <span class="conid">Semilattice</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">SearchTree</span> <span class="varid">a</span> <span class="varid">fromList</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="conid">Empty</span> <span class="varid">fromList</span> <span class="listcon">[</span><span class="varid">x</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="conid">Leaf</span> <span class="varid">x</span> <span class="varid">fromList</span> <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="varid">mkBranch</span> (<span class="varid">fromList</span> <span class="varid">ys</span>) (<span class="varid">fromList</span> <span class="varid">zs</span>) <span class="keyword">where</span> (<span class="varid">ys</span>,<span class="varid">zs</span>) <span class="keyglyph">=</span> <span class="varid">splitAt</span> (<span class="varid">length</span> <span class="varid">xs</span> <span class="varop">`div`</span> <span class="num">2</span>) <span class="varid">xs</span> </pre><p>And that's it. I use this data structure for finding rectangles (more about that in a future post), and there I only needed to build the search structure once, and use it multiple times. So, in this post I am not going to talk about updates at all. If you wanted to do updates efficiently, then you would need to worry about updating bounds, rebalancing etc. </p><h2><a name="example-uses"></a>Example uses </h2> <p>Here is an example of the search tree in action. The query will be to find a value <tt class='complex'>(<span class="varop">&gt;=</span> <span class="varid">q</span>)</tt> for a given <tt><span class="varid">q</span></tt>. The bounds will be maximum values. </p><pre class="haskell"><span class="keyword">newtype</span> <span class="conid">Max</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Max</span> { <span class="varid">getMax</span> <span class="keyglyph">::</span> <span class="varid">a</span> } <span class="keyword">deriving</span> (<span class="conid">Show</span>) <span class="keyword">instance</span> <span class="conid">Ord</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Semilattice</span> (<span class="conid">Max</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">meet</span> (<span class="conid">Max</span> <span class="varid">a</span>) (<span class="conid">Max</span> <span class="varid">b</span>) <span class="keyglyph">=</span> <span class="conid">Max</span> (<span class="varid">max</span> <span class="varid">a</span> <span class="varid">b</span>) <div class='empty-line'></div> <span class="keyword">newtype</span> <span class="conid">Ge</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Ge</span> <span class="varid">a</span> <span class="keyword">deriving</span> (<span class="conid">Show</span>) <span class="keyword">instance</span> <span class="conid">Ord</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">Satisfy</span> (<span class="conid">Ge</span> <span class="varid">a</span>) (<span class="conid">Max</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">satisfy</span> (<span class="conid">Ge</span> <span class="varid">q</span>) <span class="keyglyph">=</span> (<span class="varop">&gt;=</span> <span class="varid">q</span>) <span class="varop">.</span> <span class="varid">getMax</span> </pre><p>First, check the <tt><span class="varid">satisfy</span></tt> law: </p><pre class="ghci"> <span class="varid">satisfy</span> (<span class="conid">Ge</span> <span class="varid">q</span>) (<span class="conid">Max</span> <span class="varid">a</span>) <span class="varop">||</span> <span class="varid">satisfy</span> (<span class="conid">Ge</span> <span class="varid">q</span>) (<span class="conid">Max</span> <span class="varid">b</span>) <span class="varop">&lt;=&gt;</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="varop">||</span> <span class="varid">b</span> <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="varop">&lt;=&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="varid">b</span> <span class="keyword">then</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="keyword">else</span> <span class="varid">b</span> <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="varop">&lt;=&gt;</span> (<span class="keyword">if</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="varid">b</span> <span class="keyword">then</span> <span class="varid">a</span> <span class="keyword">else</span> <span class="varid">b</span>) <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="varop">&lt;=&gt;</span> <span class="varid">max</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">&gt;=</span> <span class="varid">q</span> <span class="varop">&lt;=&gt;</span> <span class="varid">satisfy</span> (<span class="conid">Ge</span> <span class="varid">q</span>) (<span class="conid">Max</span> (<span class="varid">max</span> <span class="varid">a</span> <span class="varid">b</span>)) <span class="varop">&lt;=&gt;</span> <span class="varid">satisfy</span> (<span class="conid">Ge</span> <span class="varid">q</span>) (<span class="varid">meet</span> (<span class="conid">Max</span> <span class="varid">a</span>) (<span class="conid">Max</span> <span class="varid">b</span>)) </pre><div style="width:240px;" class="float-right"><img src="image/searchtree/tree1.png" alt=""><br>The search tree corresponding to <tt class='complex'><span class="varid">fromList</span> (<span class="varid">map</span> <span class="conid">Max</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="num">5</span><span class="listcon">]</span>)</tt>. Circles are <tt><span class="conid">Leaf</span></tt>s and squares are <tt><span class="conid">Branch</span></tt>es.</div> <p>So indeed, <tt class='complex'><span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">||</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">b</span> <span class="varop">==&gt;</span> <span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>)</tt>. And this bound is in fact tight, so also the other way around <tt class='complex'><span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) <span class="varop">==&gt;</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">||</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">b</span></tt>. This will become important later. </p><p>Now here are some example queries: </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">3</span>) (<span class="varid">fromList</span> <span class="varop">\$</span> <span class="varid">map</span> <span class="conid">Max</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span>) <span class="conid">Just</span> (<span class="conid">Max</span> <span class="num">3</span>) <span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">3</span>) (<span class="varid">fromList</span> <span class="varop">\$</span> <span class="varid">map</span> <span class="conid">Max</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">4</span>,<span class="num">6</span><span class="listcon">]</span>) <span class="conid">Just</span> (<span class="conid">Max</span> <span class="num">4</span>) <span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">3</span>) (<span class="varid">fromList</span> <span class="varop">\$</span> <span class="varid">map</span> <span class="conid">Max</span> <span class="listcon">[</span><span class="num">6</span>,<span class="num">4</span>,<span class="num">2</span><span class="listcon">]</span>) <span class="conid">Just</span> (<span class="conid">Max</span> <span class="num">6</span>) <span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">7</span>) (<span class="varid">fromList</span> <span class="varop">\$</span> <span class="varid">map</span> <span class="conid">Max</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">4</span>,<span class="num">6</span><span class="listcon">]</span>) <span class="conid">Nothing</span> </pre><p>Semilattices and queries can easily be combined into tuples. For a tree of pairs, and queries of pairs, you could use. </p><pre class="haskell"><span class="keyword">instance</span> (<span class="conid">Semilattice</span> <span class="varid">a</span>, <span class="conid">Semilattice</span> <span class="varid">b</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Semilattice</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyword">where</span> <span class="varid">meet</span> (<span class="varid">a</span>,<span class="varid">b</span>) (<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">c</span>, <span class="varid">meet</span> <span class="varid">b</span> <span class="varid">d</span>) <span class="keyword">instance</span> (<span class="conid">Satisfy</span> <span class="varid">a</span> <span class="varid">b</span>, <span class="conid">Satisfy</span> <span class="varid">c</span> <span class="varid">d</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Satisfy</span> (<span class="varid">a</span>,<span class="varid">c</span>) (<span class="varid">b</span>,<span class="varid">d</span>) <span class="keyword">where</span> <span class="varid">satisfy</span> (<span class="varid">a</span>,<span class="varid">c</span>) (<span class="varid">b</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> <span class="varid">satisfy</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varop">&amp;&amp;</span> <span class="varid">satisfy</span> <span class="varid">c</span> <span class="varid">d</span> </pre><p>Now we can not only questions like "What is the first/last/smallest element that is greater than some given query?". But also "What is the first/last/smallest element greater than a given query that also satisfies some other property?". </p><h2><a name="when-is-it-efficient-"></a>When is it efficient? </h2> <p>It's nice that we now have a search tree that always gives correct answers. But is it also efficient? </p><p>As hinted in the introduction, that is not always the case. First of all, <tt><span class="varid">meet</span></tt> could give a really bad bound. For example, if <tt class='complex'><span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">Bottom</span></tt> for all <tt class='complex'><span class="varid">a</span> <span class="varop">/=</span> <span class="varid">b</span></tt>, and Bottom satisfies everything, then we really can do no better than a brute force search. </p><p>On the other hand, suppose that <tt><span class="varid">meet</span></tt> gives 'perfect' information, like the <tt><span class="conid">Ge</span></tt> example above, </p><pre class="ghci"><span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>) <span class="varop">==&gt;</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">||</span> <span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">b</span> </pre><p>That is equivalent to saying that </p><pre class="ghci"><span class="varid">not</span> (<span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span>) <span class="varop">&amp;&amp;</span> <span class="varid">not</span> (<span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">b</span>) <span class="varop">==&gt;</span> <span class="varid">not</span> (<span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">a</span> <span class="varid">b</span>)) </pre><p>Then for any Branch, we only have to search either the left or the right subtree. Because, if a subtree doesn't contain the value, we know can see so from the bound. For a balanced tree, that means the search takes <span class="math">O(log n)</span> time. </p><p>Another efficient case is when the items are sorted. By that I mean that, if an item satisfies the query, then all items after it also satisfy that query. We actually need something slightly more restrictive: namely that if a query is satisfied for the meet of some items, then all items after them also satisfy the query. In terms of code: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">st</span> <span class="keyglyph">=</span> <span class="varid">fromList</span> (<span class="varid">xs<sub>1</sub></span> <span class="varop">++</span> <span class="varid">xs<sub>2</sub></span> <span class="varop">++</span> <span class="varid">xs<sub>3</sub></span>) <span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">meet</span> <span class="varid">xs<sub>2</sub></span>) <span class="varop">==&gt;</span> <span class="varid">all</span> (<span class="varid">satisfy</span> <span class="varid">q</span>) <span class="varid">xs<sub>3</sub></span> </pre><p>Now suppose that we are searching a tree of the form <tt class='complex'><span class="varid">st</span> <span class="keyglyph">=</span> <span class="varid">mkBranch</span> <span class="varid">a</span> <span class="varid">b</span></tt> with <tt class='complex'><span class="varid">findFirst</span> <span class="varid">q</span></tt>. Then there are three cases: </p><ol><li><tt class='complex'><span class="varid">not</span> (<span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">bound</span> <span class="varid">st</span>))</tt>. <li><tt class='complex'><span class="varid">not</span> (<span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">bound</span> <span class="varid">a</span>))</tt>. <li><tt class='complex'><span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">bound</span> <span class="varid">a</span>)</tt>.</ol> <p>In the first case the search fails, and we are done. In the second case, we only have to search <tt><span class="varid">b</span></tt>, which by induction can be done efficiently. The third case is not so clear. In fact, there are two sub cases: </p><ul style="list-style:none;padding:0 1em;"><li>3a. findFirst q a = Just someResult <li>3b. findFirst q b = Nothing</ul> <p>In case 3a we found something in the left branch. Since we are only interested in the first result, that means we are done. In case 3b, we get to use the fact that the items are sorted. Since we have <tt class='complex'><span class="varid">satisfy</span> <span class="varid">q</span> (<span class="varid">bound</span> <span class="varid">a</span>)</tt>, that means that all items in <tt><span class="varid">b</span></tt> will satisfy the query. So when searching <tt><span class="varid">b</span></tt>, in all cases we take the left branch. </p><p>Overall, the search time will be at most twice the depth of the tree, which is <span class="math">O(log n)</span>. </p><p>The really cool thing is that we can combine the two conditions. If satisfy can be written as </p><pre class="ghci"><span class="varid">satisfy</span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">satisfy<sub>1</sub></span> <span class="varid">q</span> <span class="varid">a</span> <span class="varop">&amp;&amp;</span> <span class="varid">satisfy<sub>2</sub></span> <span class="varid">q</span> <span class="varid">a</span> </pre><p>where <tt><span class="varid">satisfy<sub>1</sub></span></tt> has exact bounds, and the tree is sorted for <tt><span class="varid">satisfy<sub>2</sub></span></tt>, then queries still take <span class="math">O(log n)</span> time. </p><h2><a name="closing-example"></a>Closing example </h2> <p>Finally, here is an example that makes use of efficient searching with the two conditions. I make use of the <tt><span class="conid">Semilattice</span></tt> and <tt><span class="conid">Satisfy</span></tt> instances for pairs which I defined above. </p><pre class="haskell"><span class="varid">treeOfPresidents</span> <span class="keyglyph">::</span> <span class="conid">SearchTree</span> (<span class="conid">Max</span> <span class="conid">Int</span>, <span class="conid">Max</span> <span class="conid">String</span>) <span class="varid">treeOfPresidents</span> <span class="keyglyph">=</span> <span class="varid">fromList</span> <span class="listcon">[</span> (<span class="conid">Max</span> <span class="varid">year</span>, <span class="conid">Max</span> <span class="varid">name</span>) <span class="keyglyph">|</span> (<span class="varid">year</span>,<span class="varid">name</span>) <span class="keyglyph">&lt;-</span> <span class="varid">usPresidents</span> <span class="listcon">]</span> <span class="keyword">where</span> <span class="varid">usPresidents</span> <span class="varop">=</span> <span class="listcon">[</span>(<span class="num">1789</span>,<span class="str">&quot;George Washington&quot;</span>) ,(<span class="num">1797</span>,<span class="str">&quot;John Adams&quot;</span>) ,(<span class="num">1801</span>,<span class="str">&quot;Thomas Jefferson&quot;</span>) <span class="comment">-- etc</span> </pre><p>The tree is ordered by year of election, and the <tt><span class="conid">Max</span></tt> semilattice gives tight bounds for names. So we can efficiently search for the first US presidents elected after 1850 who's name comes starts with a letter after "P": </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">1850</span>,<span class="conid">Ge</span> <span class="str">&quot;P&quot;</span>) <span class="varid">treeOfPresidents</span> <span class="conid">Just</span> (<span class="conid">Max</span> <span class="num">1869</span>,<span class="conid">Max</span> <span class="str">&quot;Ulysses S. Grant&quot;</span>) </pre><p>And with the following query type we can search on just one of the elements of the tuple. Note that we need the type parameter in <tt><span class="conid">Any</span></tt> because of the functional dependency in the <tt><span class="conid">Satisfy</span></tt> class. </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Any</span> <span class="varid">s</span> <span class="keyglyph">=</span> <span class="conid">Any</span> <span class="keyword">instance</span> <span class="conid">Semilattice</span> <span class="varid">s</span> <span class="keyglyph">=&gt;</span> <span class="conid">Satisfy</span> (<span class="conid">Any</span> <span class="varid">s</span>) <span class="varid">s</span> <span class="keyword">where</span> <span class="varid">satisfy</span> <span class="varid">_</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="conid">True</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">findFirst</span> (<span class="conid">Ge</span> <span class="num">1911</span>,<span class="conid">Any</span>) <span class="varid">treeOfPresidents</span> <span class="conid">Just</span> (<span class="conid">Max</span> <span class="num">1913</span>,<span class="conid">Max</span> <span class="str">&quot;Woodrow Wilson&quot;</span>) </pre> Finding rectangles, part 2: borders http://twanvl.nl/blog/haskell/finding-rectangles-part2 2011-10-12T07:57:00Z <p>In <a href="blog/haskell/finding-rectangles">the previous post</a>, we looked at finding axis aligned rectangles in a binary image. Today I am going to solve a variation of that problem: </p><blockquote style="font-style:italic;"> <p>Given a binary image, find the largest axis aligned rectangle with a 1 pixel wide border that consists entirely of foreground pixels. </p></blockquote> <p>Here is an example: <br><img src="image/find-rect/rects2-best.png" style="margin-left:2em;">,<br> where white pixels are the background and blue is the foreground. The rectangle with the largest area is indicated in red. </p><p>Like the previous rectangle finding problem, this one also came up in my masters thesis. The application was to, given a scan of a book, find the part that is a page, cutting away clutter: <br><img src="image/find-rect/rects2-page069-border-rect-small.png" style="margin-left:2em;">. </p><h2><a name="specification"></a>Specification </h2> <p>The types we are going to need are exactly the same as in <a href="blog/haskell/finding-rectangles">my previous post</a>: </p><pre class="haskell"><span class="comment">-- An image is a 2D list of booleans, True is the foreground</span> <span class="keyword">type</span> <span class="conid">Image</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Bool</span><span class="listcon">]</span><span class="listcon">]</span> <div class='empty-line'></div> <span class="comment">-- An axis-aligned rectangle</span> <span class="keyword">data</span> <span class="conid">Rect</span> <span class="keyglyph">=</span> <span class="conid">Rect</span> { <span class="varid">left</span>, <span class="varid">top</span>, <span class="varid">width</span>, <span class="varid">height</span> <span class="keyglyph">::</span> <span class="conid">Int</span> } <span class="keyword">deriving</span> (<span class="conid">Eq</span>,<span class="conid">Ord</span>,<span class="conid">Show</span>) </pre><p>The difference compared to last time is the <tt><span class="varid">contains</span></tt> function, which tells whether an image contains a given rectangle. We are now looking only at the borders of rectangles, or 'border rectangles' for short. </p><pre class="haskell"><span class="comment">-- does an image contain a given border rectangle?</span> <span class="varid">contains</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">contains</span> <span class="varid">im</span> <span class="varid">rect</span> <span class="keyglyph">=</span> <span class="varid">isBorder</span> (<span class="varid">cropRect</span> <span class="varid">im</span> <span class="varid">rect</span>) <div class='empty-line'></div> <span class="comment">-- crop an image to the pixels inside a given rectangle</span> <span class="varid">cropRect</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Image</span> <span class="varid">cropRect</span> <span class="varid">im</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) <span class="keyglyph">=</span> <span class="varid">map</span> <span class="varid">cols</span> (<span class="varid">rows</span> <span class="varid">im</span>) <span class="keyword">where</span> <span class="varid">rows</span> <span class="keyglyph">=</span> <span class="varid">take</span> <span class="varid">h</span> <span class="varop">.</span> <span class="varid">drop</span> <span class="varid">y</span> <span class="varop">.</span> (<span class="varop">++</span><span class="varid">repeat</span> <span class="listcon">[</span><span class="listcon">]</span>) <span class="varid">cols</span> <span class="keyglyph">=</span> <span class="varid">take</span> <span class="varid">w</span> <span class="varop">.</span> <span class="varid">drop</span> <span class="varid">x</span> <span class="varop">.</span> (<span class="varop">++</span><span class="varid">repeat</span> <span class="conid">False</span>) <div class='empty-line'></div> <span class="comment">-- is the border of an image foreground?</span> <span class="varid">isBorder</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">isBorder</span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">and</span> (<span class="varid">head</span> <span class="varid">im</span>) <span class="comment">-- top border</span> <span class="varop">&amp;&amp;</span> <span class="varid">and</span> (<span class="varid">last</span> <span class="varid">im</span>) <span class="comment">-- bottom border</span> <span class="varop">&amp;&amp;</span> <span class="varid">and</span> (<span class="varid">map</span> <span class="varid">head</span> <span class="varid">im</span>) <span class="comment">-- left border</span> <span class="varop">&amp;&amp;</span> <span class="varid">and</span> (<span class="varid">map</span> <span class="varid">last</span> <span class="varid">im</span>) <span class="comment">-- right border</span> </pre><p>Finding the largest border rectangle can again be done by enumerating all rectangles contained in the image, and picking the largest one: </p><pre class="haskell"><span class="varid">largestRect<sub>spec</sub></span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">largestRect<sub>spec</sub></span> <span class="keyglyph">=</span> <span class="varid">maximalRectBy</span> <span class="varid">area</span> <span class="varop">.</span> <span class="varid">allRects</span> <div class='empty-line'></div> <span class="varid">allRects</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">allRects</span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">filter</span> (<span class="varid">im</span> <span class="varop">`contains`</span>) <span class="varid">rects</span> <span class="keyword">where</span> <span class="comment">-- boring details omitted, see previous post</span> </pre><p>Just as before, this specification has runtime <span class="math">O(n<sup>6</sup>)</span> for an <span class="math">n</span> by <span class="math">n</span> image, which is completely impractical. </p><h2><a name="an-o-n-4-algorithm"></a>An <span class="math">O(n<sup>4</sup>)</span> algorithm </h2> <p>Unfortunately, the nice properties of maximal rectangles will not help us out this time. In particular, whenever a filled rectangle is contained in an image, then so are all smaller subrectangles So we could 'grow' filled rectangles one row or column at a time. This is no longer true for border rectangles. </p><p>We can, however, easily improve the above <span class="math">O(n<sup>6</sup>)</span> algorithm to an <span class="math">O(n<sup>4</sup>)</span> one by using the line endpoints. With those we can check if an image contains a rectangle in constant time. We just need to check all four of the sides: </p><pre class="ghci"><span class="comment">-- pseudo code, not actually O(n^4) without O(1) array lookup</span> <span class="varid">contains<sub>fast</sub></span> <span class="varid">im</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) <span class="keyglyph">=</span> <span class="varid">r</span><span class="varop">!!</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="varop">&gt;=</span> <span class="varid">x</span><span class="varop">+</span><span class="varid">w</span> <span class="comment">-- top border</span> <span class="varop">&amp;&amp;</span> <span class="varid">r</span><span class="varop">!!</span>(<span class="varid">x</span>,<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>) <span class="varop">&gt;=</span> <span class="varid">x</span><span class="varop">+</span><span class="varid">w</span> <span class="comment">-- bottom border</span> <span class="varop">&amp;&amp;</span> <span class="varid">b</span><span class="varop">!!</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="varop">&gt;=</span> <span class="varid">y</span><span class="varop">+</span><span class="varid">h</span> <span class="comment">-- left border</span> <span class="varop">&amp;&amp;</span> <span class="varid">b</span><span class="varop">!!</span>(<span class="varid">x</span><span class="varop">+</span><span class="varid">w</span><span class="num">-1</span>,<span class="varid">y</span>) <span class="varop">&gt;=</span> <span class="varid">y</span><span class="varop">+</span><span class="varid">h</span> <span class="comment">-- right border</span> </pre><p>Where <tt><span class="varid">r</span></tt> and <tt><span class="varid">b</span></tt> give the right and bottom endpoints of the horizontal and vertical lines through each pixel. <br><tt class='complex'><span class="varid">r</span> <span class="keyglyph">=</span> </tt><img src="image/find-rect/rects2-r.png" style="vertical-align:middle;">, <tt class='complex'><span class="varid">b</span> <span class="keyglyph">=</span> </tt><img src="image/find-rect/rects2-b.png" style="vertical-align:middle;">. </p><h2><a name="an-o-n-3-algorithm"></a>An <span class="math">O(n<sup>3</sup>)</span> algorithm </h2> <p>As the title of this section hints, a still more efficient algorithm is possible. The trick is to only look for rectangles with a specific height <tt><span class="varid">h</span></tt>. For any given height <tt><span class="varid">h</span></tt>, we <em>will</em> be able to find only maximal rectangles of that height. </p><p>For example, for <tt class='complex'><span class="varid">h</span><span class="varop">=</span><span class="num">6</span></tt> we would expect to find these rectangles: <br><img src="image/find-rect/rects2-all6.png" style="margin-left:2em;">.<br> Notice how each of these rectangles consist of three parts: a left side, a middle and a right side: <br><img src="image/find-rect/rects2-lmr6.png" style="margin-left:2em;">. </p><p>The left and right parts both consist of a vertical line at least <tt><span class="varid">h</span></tt> pixels high. We can find those vertical lines by looking at the top (or bottom) line endpoints. The top endpoint for pixel <tt class='complex'>(<span class="varid">x</span>,<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>)</tt> should be at most <tt><span class="varid">y</span></tt>, </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">h</span> <span class="keyglyph">=</span> <span class="num">6</span> <span class="comment">-- for example</span> <span class="keyword">let</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d</span> (<span class="varop">&lt;=</span>) (<span class="varid">drop</span> (<span class="varid">h</span><span class="num">-1</span>) <span class="varid">t</span>) <span class="varid">y</span> <span class="comment">-- in images:</span> <span class="varid">av</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-av6-snd.png" style="vertical-align:middle;"> <span class="varop">&lt;=</span> <img src="image/find-rect/rects2-av6-fst.png" style="vertical-align:middle;"> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-av6.png" style="vertical-align:middle;margin-top:1em;"> </pre><p>Each <tt><span class="conid">True</span></tt> pixel in <tt><span class="varid">av</span></tt> corresponds to a point where there is a <tt><span class="varid">h</span></tt> pixel high vertical line. So, a potential left or right side of a rectangle. </p><p>The middle part of each rectangle has both pixel <tt class='complex'>(<span class="varid">x</span>,<span class="varid">y</span>)</tt> and <tt class='complex'>(<span class="varid">x</span>,<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>)</tt> set, </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">ah</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d</span> (<span class="varop">&amp;&amp;</span>) <span class="varid">a</span> (<span class="varid">drop</span> (<span class="varid">h</span><span class="num">-1</span>) <span class="varid">a</span>) <span class="comment">-- in images:</span> <span class="varid">ah</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-ah6-snd.png" style="vertical-align:middle;"> <span class="varop">&amp;&amp;</span> <img src="image/find-rect/rects2-ah6-fst.png" style="vertical-align:middle;"> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-ah6.png" style="vertical-align:middle;margin-top:1em;"> </pre><p>To find the rectangles of height <tt><span class="varid">h</span></tt>, we just need to find runs that start and end with a pixel in <tt><span class="varid">av</span></tt>, and where all pixels in between are in <tt><span class="varid">ah</span></tt>. First we find the left coordinates of the rectangles, </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">leStep</span> (<span class="varid">av</span>,<span class="varid">ah</span>,<span class="varid">x</span>) <span class="varid">le</span> <span class="keyglyph">|</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="varid">min</span> <span class="varid">le</span> <span class="varid">x</span> <span class="comment">-- pixel in av ==&gt; left part</span> <span class="keyglyph">|</span> <span class="varid">ah</span> <span class="keyglyph">=</span> <span class="varid">le</span> <span class="comment">-- pixel in ah, but not av ==&gt; continue middle part</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">maxBound</span> <span class="keyword">let</span> <span class="varid">le</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> <span class="varid">leStep</span> <span class="varid">maxBound</span> (<span class="varid">zip2d3</span> <span class="varid">av</span> <span class="varid">ah</span> <span class="varid">x</span>) <span class="varid">le</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-lh6.png" style="vertical-align:middle;"> </pre><p>Finally we need to look for right sides. These are again given by <tt><span class="varid">av</span></tt>. For each right side, <tt><span class="varid">le</span></tt> gives the leftmost left side, and <tt><span class="varid">h</span></tt> gives the height of the rectangles: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">mkRect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">av</span> <span class="varid">le</span> <span class="keyglyph">|</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="conid">Rect</span> <span class="varid">le</span> <span class="varid">y</span> (<span class="varid">x</span><span class="varop">-</span><span class="varid">le</span><span class="varop">+</span><span class="num">1</span>) <span class="varid">h</span><span class="listcon">]</span> <span class="comment">-- pixel in av ==&gt; right part</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyword">let</span> <span class="varid">rects</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d4</span> <span class="varid">mkRect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">av</span> <span class="varid">le</span> <span class="varid">rects</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects2-lh-rects6.png" style="vertical-align:middle;"> </pre><p>Compare the resulting image to the one at the start of this section. We found the same rectangles. </p><p>Just like last time, all we need to do now is put the steps together in a function: </p><pre class="haskell"><span class="varid">rectsWithHeight</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">rectsWithHeight</span> <span class="varid">h</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">concat</span> <span class="varop">.</span> <span class="varid">concat</span> <span class="varop">\$</span> <span class="varid">rects</span> <span class="keyword">where</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="varid">y</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">t</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">y</span>) <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">t</span> <span class="keyword">else</span> <span class="varid">y</span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">y</span>) <span class="varid">ah</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d</span> (<span class="varop">&amp;&amp;</span>) (<span class="varid">drop</span> (<span class="varid">h</span><span class="num">-1</span>) <span class="varid">a</span>) <span class="varid">a</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d</span> (<span class="varop">&lt;=</span>) (<span class="varid">drop</span> (<span class="varid">h</span><span class="num">-1</span>) <span class="varid">t</span>) <span class="varid">y</span> <span class="varid">leStep</span> (<span class="varid">av</span>,<span class="varid">ah</span>,<span class="varid">x</span>) <span class="varid">le</span> <span class="keyglyph">|</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="varid">min</span> <span class="varid">le</span> <span class="varid">x</span> <span class="keyglyph">|</span> <span class="varid">ah</span> <span class="keyglyph">=</span> <span class="varid">le</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">maxBound</span> <span class="varid">le</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> <span class="varid">leStep</span> <span class="varid">maxBound</span> (<span class="varid">zip2d3</span> <span class="varid">av</span> <span class="varid">ah</span> <span class="varid">x</span>) <span class="varid">mkRect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">av</span> <span class="varid">le</span> <span class="keyglyph">|</span> <span class="varid">av</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="conid">Rect</span> <span class="varid">le</span> <span class="varid">y</span> (<span class="varid">x</span><span class="varop">-</span><span class="varid">le</span><span class="varop">+</span><span class="num">1</span>) <span class="varid">h</span><span class="listcon">]</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">rects</span> <span class="keyglyph">=</span> <span class="varid">zipWith2d4</span> <span class="varid">mkRect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">av</span> <span class="varid">le</span> </pre><p>Of course, finding (a superset of) all maximal rectangles in an image is just a matter of calling <tt><span class="varid">rectsWithHeight</span></tt> for all possible heights. </p><pre class="haskell"><span class="varid">findRects<sub>fast</sub></span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">findRects<sub>fast</sub></span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">concat</span> <span class="listcon">[</span> <span class="varid">rectsWithHeight</span> <span class="varid">h</span> <span class="varid">im</span> <span class="keyglyph">|</span> <span class="varid">h</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">imHeight</span> <span class="varid">im</span><span class="listcon">]</span> <span class="listcon">]</span> <div class='empty-line'></div> <span class="varid">largestRect<sub>fast</sub></span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">largestRect<sub>fast</sub></span> <span class="keyglyph">=</span> <span class="varid">maximalRectBy</span> <span class="varid">area</span> <span class="varop">.</span> <span class="varid">findRects<sub>fast</sub></span> </pre><p>Let's quickly check that this function does the same as the specification, </p><pre class="haskell"><span class="varid">prop<sub>fast_spec</sub></span> <span class="keyglyph">=</span> <span class="varid">forAll</span> <span class="varid">genImage</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">largestRect<sub>spec</sub></span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">largestRect<sub>fast</sub></span> <span class="varid">a</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">quickCheck</span> <span class="varid">prop<sub>fast_spec</sub></span> <span class="varop">+++</span> <span class="conid">OK</span>, <span class="varid">passed</span> <span class="num">100</span> <span class="varid">tests</span><span class="varop">.</span> </pre><p>Great. </p><h2><a name="conclusions"></a>Conclusions </h2> <p>The runtime of <tt><span class="varid">rectsWithHeight</span></tt> is linear in the number of pixels; and it is called <span class="math">n</span> times for an <span class="math">n</span> by <span class="math">n</span> image. Therefore the total runtime of <tt><span class="varid">largestRect<sub>fast</sub></span></tt> is <span class="math">O(n<sup>3</sup>)</span>. While this is much better than what we started with, it can still be quite slow. For example, the book page that motivated this problem is around 2000 pixels squared. Finding the largest rectangle takes on the order of <span class="math">2000<sup>3</sup> = 8*10<sup>9</sup></span>, or 8 giga-operations, which is still a pretty large number. </p><p>To make this algorithm faster in practice, I used a couple of tricks. Most importantly, if we know what function we are maximizing, say <tt><span class="varid">area</span></tt>, then we can stop as soon as we know that we can't possibly find a better rectangle. The idea is to start with <tt class='complex'><span class="varid">h</span><span class="keyglyph">=</span><span class="varid">imHeight</span> <span class="varid">im</span></tt>, and work downwards. Keep track of the area <tt><span class="varid">a</span></tt> of the largest rectangle. Then as soon as <tt class='complex'><span class="varid">h</span> <span class="varop">*</span> <span class="varid">imWidth</span> <span class="varid">im</span> <span class="varop">&lt;</span> <span class="varid">a</span></tt>, we can stop, because any rectangle we can find from then on will be smaller. </p><p>Is this the best we can do? No. I know an algorithm for finding all maximal border rectangles in <span class="math">O(n<sup>2</sup>*(log n)<sup>2</sup>)</span> time. But it is rather complicated, and this post is long enough already. So I will save it for another time. If anyone thinks they can come up with such an algorithm themselves, I would love to read about it in the comments. </p> Finding rectangles http://twanvl.nl/blog/haskell/finding-rectangles 2011-09-28T19:49:00Z <p>This post is based on a part of my <a href="http://twanvl.nl/files/master-thesis/thesis-ocr-Twan-van-Laarhoven-2010-09-11.pdf">masters thesis</a>. The topic of my thesis was <abbr title="Optical Character Recognition">OCR</abbr> of historical documents. A problem that came up there was the following: </p><blockquote style="font-style:italic;">Given a binary image, find the largest axis aligned rectangle that consists only of foreground pixels.</blockquote> <p>These largest rectangles can be used, for instance, to find columns in a page of text. Although in that case one would use large rectangles of <em>background</em> pixels. </p><p>Here is an example image, <br><img src="image/find-rect/rects1-best.png" style="margin-left:2em;">.<br> White pixels are background and blue is the foreground. The rectangle with the largest area is indicated in red. The images you encounter in practical application will be much larger than this example, so efficiency is going to be important. </p><h2><a name="specification"></a>Specification </h2> <p>Let's start with the types of images and rectangles </p><pre class="haskell"><span class="comment">-- An image is a 2D list of booleans, True is the foreground</span> <span class="keyword">type</span> <span class="conid">Image</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Bool</span><span class="listcon">]</span><span class="listcon">]</span> <div class='empty-line'></div> <span class="comment">-- An axis-aligned rectangle</span> <span class="keyword">data</span> <span class="conid">Rect</span> <span class="keyglyph">=</span> <span class="conid">Rect</span> { <span class="varid">left</span>, <span class="varid">top</span>, <span class="varid">width</span>, <span class="varid">height</span> <span class="keyglyph">::</span> <span class="conid">Int</span> } <span class="keyword">deriving</span> (<span class="conid">Eq</span>,<span class="conid">Ord</span>,<span class="conid">Show</span>) </pre><p>And some properties of them, </p><pre class="haskell"><span class="comment">-- The size of an image</span> <span class="varid">imWidth</span>, <span class="varid">imHeight</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="varid">imHeight</span> <span class="keyglyph">=</span> <span class="varid">length</span> <span class="varid">imWidth</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">_</span>) <span class="keyglyph">=</span> <span class="varid">length</span> <span class="varid">x</span> <span class="varid">imWidth</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="num">0</span> <div class='empty-line'></div> <span class="comment">-- The area and perimeter of a rectangle</span> <span class="varid">area</span>, <span class="varid">perimeter</span> <span class="keyglyph">::</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="varid">area</span> <span class="varid">rect</span> <span class="keyglyph">=</span> <span class="varid">width</span> <span class="varid">rect</span> <span class="varop">*</span> <span class="varid">height</span> <span class="varid">rect</span> <span class="varid">perimeter</span> <span class="varid">rect</span> <span class="keyglyph">=</span> <span class="num">2</span> <span class="varop">*</span> <span class="varid">width</span> <span class="varid">rect</span> <span class="varop">+</span> <span class="num">2</span> <span class="varop">*</span> <span class="varid">height</span> <span class="varid">rect</span> </pre><p>I will say that an image 'contains' a rectangle if all pixels inside the rectangle are foreground pixels. </p><pre class="haskell"><span class="varid">contains</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">contains</span> <span class="varid">im</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) <span class="keyglyph">=</span> <span class="varid">and</span> <span class="varid">pixelsInRect</span> <span class="keyword">where</span> <span class="varid">pixelsInRect</span> <span class="keyglyph">=</span> <span class="varid">concatMap</span> <span class="varid">cols</span> (<span class="varid">rows</span> <span class="varid">im</span>) <span class="varid">rows</span> <span class="keyglyph">=</span> <span class="varid">take</span> <span class="varid">h</span> <span class="varop">.</span> <span class="varid">drop</span> <span class="varid">y</span> <span class="varop">.</span> (<span class="varop">++</span><span class="varid">repeat</span> <span class="listcon">[</span><span class="listcon">]</span>) <span class="varid">cols</span> <span class="keyglyph">=</span> <span class="varid">take</span> <span class="varid">w</span> <span class="varop">.</span> <span class="varid">drop</span> <span class="varid">x</span> <span class="varop">.</span> (<span class="varop">++</span><span class="varid">repeat</span> <span class="conid">False</span>) </pre><p>Now the obvious, stupid, way of finding the largest rectangle is to enumerate <em>all</em> rectangles in the image, and pick the largest from that list: </p><pre class="haskell"><span class="comment">-- List all rectangles contained in an image</span> <span class="varid">allRects</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">allRects</span> <span class="varid">im</span> <span class="keyglyph">=</span> <span class="varid">filter</span> (<span class="varid">im</span> <span class="varop">`contains`</span>) <span class="varid">rects</span> <span class="keyword">where</span> <span class="varid">rects</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span> <span class="keyglyph">|</span> <span class="varid">x</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="varid">iw</span><span class="listcon">]</span>, <span class="varid">y</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="varid">ih</span><span class="listcon">]</span> , <span class="varid">w</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">iw</span><span class="varop">-</span><span class="varid">x</span><span class="listcon">]</span>, <span class="varid">h</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="varid">ih</span><span class="varop">-</span><span class="varid">y</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">iw</span> <span class="keyglyph">=</span> <span class="varid">imWidth</span> <span class="varid">im</span> <span class="varid">ih</span> <span class="keyglyph">=</span> <span class="varid">imHeight</span> <span class="varid">im</span> </pre><p>For now, I will take 'largest rectangle' to mean one with the maximal area. I will come back to this choice soon. </p><pre class="haskell"><span class="varid">largestRect<sub>spec</sub></span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">largestRect<sub>spec</sub></span> <span class="keyglyph">=</span> <span class="varid">maximalRectBy</span> <span class="varid">area</span> <span class="varop">.</span> <span class="varid">allRects</span> <div class='empty-line'></div> <span class="comment">-- Return the rectangle with maximum f,</span> <span class="comment">-- using lexicographical ordering to break ties</span> <span class="comment">-- return noRect if there are no rectangles in the input list.</span> <span class="varid">maximalRectBy</span> <span class="keyglyph">::</span> <span class="conid">Ord</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">maximalRectBy</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">maximumBy</span> (<span class="varid">comparing</span> <span class="varid">f</span> <span class="varop">`mappend`</span> <span class="varid">compare</span>) <span class="varop">.</span> (<span class="varid">noRect</span><span class="listcon">:</span>) <span class="keyword">where</span> <span class="varid">noRect</span> <span class="keyglyph">=</span> <span class="conid">Rect</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> </pre><p>The above code should hopefully be easy to understand. It will find the correct answer for the above example: </p><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">largestRect<sub>spec</sub></span> <span class="varid">example</span> <span class="conid">Rect</span> {<span class="varid">left</span> <span class="keyglyph">=</span> <span class="num">3</span>, <span class="varid">top</span> <span class="keyglyph">=</span> <span class="num">2</span>, <span class="varid">width</span> <span class="keyglyph">=</span> <span class="num">4</span>, <span class="varid">height</span> <span class="keyglyph">=</span> <span class="num">5</span>} </pre><p>Of course <tt><span class="varid">largestRect<sub>spec</sub></span></tt> is horribly slow. In an <span class="math">n</span> by <span class="math">n</span> image there are <span class="math">O(n<sup>4</sup>)</span> rectangles to consider, and checking if one is contained in the image takes <span class="math">O(n<sup>2</sup>)</span> work, for a total of <span class="math">O(n<sup>6</sup>)</span>. </p><h2><a name="what-is-largest-"></a>What is 'largest'? </h2> <p>Before continuing, let's determine what it means for a rectangle to be the <em>largest</em>. We could compare the area of rectangles, as we did before. But it is equally valid to look for the rectangle with the largest perimeter. </p><p>Can we pick the maximum according to any arbitrary function <tt class='complex'><span class="varid">f</span> <span class="keyglyph">::</span> (<span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>)</tt>? Not all of these functions will correspond to the intuitive notion of 'largest'. For example <tt class='complex'><span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">negate</span> <span class="varop">.</span> <span class="varid">area</span></tt> will actually lead to the smallest rectangle. In general there is going to be no efficient way of finding the rectangle that maximizes <tt><span class="varid">f</span></tt>. All we could do is optimize <tt><span class="varid">contains</span></tt>, to get an <span class="math">O(n<sup>4</sup>)</span> algorithm. </p><p>We should therefore restrict <tt><span class="varid">f</span></tt> to be <em>monotonic</em>. What I mean by monotonic is that <tt class='complex'><span class="varid">f</span> <span class="varid">x</span> <span class="varop">&gt;=</span> <span class="varid">f</span> <span class="varid">y</span></tt> whenever rectangle <tt><span class="varid">x</span></tt> contains rectangle <tt><span class="varid">y</span></tt>. In QuickCheck code: </p><pre class="haskell"><span class="varid">prop_isMonotonic</span> <span class="keyglyph">::</span> <span class="conid">Ord</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Property</span> <span class="varid">prop_isMonotonic</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">property</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">`rectContains`</span> <span class="varid">y</span> <span class="varop">==&gt;</span> <span class="varid">f</span> <span class="varid">x</span> <span class="varop">&gt;=</span> <span class="varid">f</span> <span class="varid">y</span> <div class='empty-line'></div> <span class="varid">rectContains</span> <span class="keyglyph">::</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">rectContains</span> (<span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span>) (<span class="conid">Rect</span> <span class="varid">x'</span> <span class="varid">y'</span> <span class="varid">w'</span> <span class="varid">h'</span>) <span class="keyglyph">=</span> <span class="varid">x</span> <span class="varop">&lt;=</span> <span class="varid">x'</span> <span class="varop">&amp;&amp;</span> <span class="varid">y</span> <span class="varop">&lt;=</span> <span class="varid">y'</span> <span class="varop">&amp;&amp;</span> <span class="varid">x</span><span class="varop">+</span><span class="varid">w</span> <span class="varop">&gt;=</span> <span class="varid">x'</span><span class="varop">+</span><span class="varid">w'</span> <span class="varop">&amp;&amp;</span> <span class="varid">y</span><span class="varop">+</span><span class="varid">h</span> <span class="varop">&gt;=</span> <span class="varid">y'</span><span class="varop">+</span><span class="varid">h'</span> </pre><p>Area is a monotonic function, and so is perimeter. But you could also add weird constraints. For example, only consider rectangles that are at least 10 pixels tall, or only rectangles that contain the point (123,456). </p><p>Maximizing a monotonic function, as opposed to just any function, means that we can skip a lot of rectangles. In particular, whenever rectangle <tt><span class="varid">x</span></tt> contains rectangle <tt><span class="varid">y</span></tt>, rectangle <tt><span class="varid">y</span></tt> doesn't need to be considered. I will call rectangles in the image that are not contained in other (larger) rectangles <em>maximal</em>. The strategy for finding the largest rectangle is then simply to enumerate only the maximal rectangles, and pick the best of those: </p><pre class="haskell"><span class="varid">largestRect<sub>fast</sub></span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="conid">Rect</span> <span class="varid">largestRect<sub>fast</sub></span> <span class="keyglyph">=</span> <span class="varid">maximalRectBy</span> <span class="varid">area</span> <span class="varop">.</span> <span class="varid">allMaximalRects</span> </pre><p>For each maximal rectangle there is (trivially) a monotonic function that is maximal for that rectangle. So we can't do any better without taking the specific function <tt><span class="varid">f</span></tt> into account. </p><h2><a name="machinery"></a>Machinery </h2> <p>To find maximal rectangles, we are first of all going to need some machinery for working with images. In particular, zipping images together, </p><pre class="haskell"><span class="varid">zip2d</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">b</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span>(<span class="varid">a</span>,<span class="varid">b</span>)<span class="listcon">]</span><span class="listcon">]</span> <span class="varid">zip2d</span> <span class="keyglyph">=</span> <span class="varid">zipWith</span> <span class="varid">zip</span> <div class='empty-line'></div> <span class="varid">zipWith2d</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>) <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">b</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">c</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">zipWith2d</span> <span class="keyglyph">=</span> <span class="varid">zipWith</span> <span class="varop">.</span> <span class="varid">zipWith</span> <div class='empty-line'></div> <span class="varid">zipWith2d4</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">d</span> <span class="keyglyph">-&gt;</span> <span class="varid">e</span>) <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">b</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">c</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">d</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">e</span><span class="listcon">]</span><span class="listcon">]</span> <span class="varid">zipWith2d4</span> <span class="keyglyph">=</span> <span class="varid">zipWith4</span> <span class="varop">.</span> <span class="varid">zipWith4</span> </pre><p>And accumulating/scanning over images. This scanning can be done in four directions. Each <tt><span class="varid">scanX</span></tt> function takes a function to apply, and the initial value to use just outside the image. The scans that I use here are slightly different from <tt><span class="varid">scanl</span></tt> and <tt><span class="varid">scanr</span></tt>, because the output will have the same size as the input, instead of being one element larger. </p><pre class="haskell"><span class="varid">scanLeftward</span>, <span class="varid">scanRightward</span>, <span class="varid">scanUpward</span>, <span class="varid">scanDownward</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">b</span><span class="listcon">]</span><span class="listcon">]</span> <div class='empty-line'></div> <span class="varid">scanLeftward</span> <span class="varid">f</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">init</span> <span class="varop">.</span> <span class="varid">scanr</span> <span class="varid">f</span> <span class="varid">z</span>) <span class="varid">scanRightward</span> <span class="varid">f</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">tail</span> <span class="varop">.</span> <span class="varid">scanl</span> (<span class="varid">flip</span> <span class="varid">f</span>) <span class="varid">z</span>) <span class="varid">scanUpward</span> <span class="varid">f</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">init</span> <span class="varop">.</span> <span class="varid">scanr</span> (<span class="keyglyph">\</span><span class="varid">as</span> <span class="varid">bs</span> <span class="keyglyph">-&gt;</span> <span class="varid">zipWith</span> <span class="varid">f</span> <span class="varid">as</span> <span class="varid">bs</span>) (<span class="varid">repeat</span> <span class="varid">z</span>) <span class="varid">scanDownward</span> <span class="varid">f</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">tail</span> <span class="varop">.</span> <span class="varid">scanl</span> (<span class="keyglyph">\</span><span class="varid">as</span> <span class="varid">bs</span> <span class="keyglyph">-&gt;</span> <span class="varid">zipWith</span> <span class="varid">f</span> <span class="varid">bs</span> <span class="varid">as</span>) (<span class="varid">repeat</span> <span class="varid">z</span>) </pre><p>Here is an example of a scan that calculates the x-coordinate of each pixel, </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span><span class="varid">a</span> <span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">x</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-x.png" style="vertical-align:middle;"><span class="varop">.</span> </pre><p>And the y-coordinates are of course </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span><span class="varid">a</span> <span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">y</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-y.png" style="vertical-align:middle;"><span class="varop">.</span> </pre><h2><a name="finding-lines"></a>Finding lines </h2> <p>If we were looking for one-dimensional images, then a 'rectangle' would just be a single line of pixels. Now each pixel is contained in at most one maximal line of foreground pixels. To find the coordinates of this line, we just need to know the left and right endpoints. </p><p>For a foreground pixel, the left endpoint of the line it is in is the same as the left endpoint of its left neighbor. On the other hand, a background pixel is not in any foreground line. So the left endpoint of all lines to the right of it will be at least <tt class='complex'><span class="varid">x</span><span class="varop">+</span><span class="num">1</span></tt>, where <tt><span class="varid">x</span></tt> is the x-coordinate of the background pixel. In both these cases information flows from left to right; and so the left endpoint for all pixels can be determined with a rightward scan. </p><p>Unsurprisingly, we can find the right endpoints of all foreground lines with a leftward scan. Now let's do this for all lines in the image. Notice that we need the <tt><span class="varid">x</span></tt> coordinates defined previously: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">l</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">x</span>) <span class="varid">l</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">l</span> <span class="keyword">else</span> <span class="varid">x</span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">x</span>) <span class="varid">l</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-lm.png" style="vertical-align:middle;margin-bottom:1em;"> <span class="keyword">let</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">scanLeftward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">x</span>) <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">r</span> <span class="keyword">else</span> <span class="varid">x</span>) (<span class="varid">imWidth</span> <span class="varid">a</span>) (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">x</span>) <span class="varid">r</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-rm.png" style="vertical-align:middle;"> </pre><p>In the images I have marked the left and right endpoints of the foreground lines in red. Note also, the values in the background pixels are not important, and you should just ignore them. </p><p>Vertically we can of course do the same thing, giving top and bottom endpoints: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">t</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">y</span>) <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">t</span> <span class="keyword">else</span> <span class="varid">y</span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">y</span>) <span class="varid">t</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-tm.png" style="vertical-align:middle;margin-bottom:1em;"> <span class="keyword">let</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">scanUpward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">y</span>) <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">b</span> <span class="keyword">else</span> <span class="varid">y</span>) (<span class="varid">imHeight</span> <span class="varid">a</span>) (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">y</span>) <span class="varid">b</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-bm.png" style="vertical-align:middle;"> </pre><p>However, combining these left/right/top/bottom line endpoints does not yet give rectangles containing only foreground pixels. Rather, it gives something like a cross. For example using the endpoints for (6,4) leads to the following incorrect rectangle, <br><img src="image/find-rect/rects1-cross.png" style="margin-left:2em;">. </p><p>In fact, there are many rectangles around this point (6,4): <br><img src="image/find-rect/rects1-all.png" style="margin-left:2em;">, <br>and before looking at the area (or whatever function we are maximizing) there is way no telling which is the best one. </p><p>If there was some way to find just a single maximal rectangle for each pixel, then we would have an <span class="math">O(n<sup>2</sup>)</span> algorithm. Assuming of course that we do find all maximal rectangles. </p><h2><a name="finding-maximal-rectangles"></a>Finding maximal rectangles </h2> <p>Suppose that <tt class='complex'><span class="conid">Rect</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">w</span> <span class="varid">h</span></tt> is a maximal rectangle. What does that mean? First of all, one of the points above the rectangle, <tt class='complex'>(<span class="varid">x</span>,<span class="varid">y</span><span class="num">-1</span>),(<span class="varid">x</span><span class="varop">+</span><span class="num">1</span>,<span class="varid">y</span><span class="num">-1</span>),<span class="listcon">..</span>,(<span class="varid">x</span><span class="varop">+</span><span class="varid">w</span><span class="num">-1</span>,<span class="varid">y</span><span class="num">-1</span>)</tt>, must not be the a foreground pixel. Because if all these points are foreground, then the rectangle could be extended upwards, and it would not be maximal. So, suppose that <tt class='complex'>(<span class="varid">u</span>,<span class="varid">y</span><span class="num">-1</span>)</tt> is a background pixel (or outside the image). Then <tt class='complex'>(<span class="varid">u</span>,<span class="varid">y</span>)</tt> is the top endpoint of the vertical line that contains <tt class='complex'>(<span class="varid">u</span>,<span class="varid">y</span><span class="varop">+</span><span class="varid">h</span><span class="num">-1</span>)</tt>. </p><p>If we start from <tt class='complex'>(<span class="varid">u</span>,<span class="varid">v</span>)</tt>, we can recover the height of a maximal rectangle using the top endpoint image <tt><span class="varid">t</span></tt>. Just take <tt class='complex'><span class="varid">t</span><span class="varop">!!</span>(<span class="varid">u</span>,<span class="varid">v</span>)</tt> as the top coordinate, and <tt class='complex'><span class="varid">u</span><span class="varop">+</span><span class="num">1</span></tt> as the bottom. This image illustrates the idea: <br><img src="image/find-rect/rects1-extend-up.png" style="margin-left:2em;">. <br>Here the green point <tt class='complex'>(<span class="varid">u</span>,<span class="varid">v</span>)</tt> has the red top endpoint, and it gives the height and vertical position of the yellow maximal rectangle. </p><p>Then to make this vertical line into a maximal rectangle, we just extend it horizontally as far as possible: <br><img src="image/find-rect/rects1-extend-lr.png" style="margin-left:2em;">. </p><p>For this last step, we need to know the first background pixel that will be encountered when extending the rectangle to the left. That is the <em>maximum value</em> of all left endpoints in the rows <tt class='complex'><span class="varid">t</span>,<span class="varid">t</span><span class="varop">+</span><span class="num">1</span>,<span class="listcon">..</span>,<span class="varid">b</span><span class="num">-1</span></tt>. This maximum can again be determined with a scan over the image: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">lt</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">l</span>) <span class="varid">lt</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">max</span> <span class="varid">l</span> <span class="varid">lt</span> <span class="keyword">else</span> <span class="varid">minBound</span>) <span class="varid">minBound</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">l</span>) <span class="varid">lt</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-lt.png" style="vertical-align:middle;"> </pre><p>For extending to the right the story is exactly the same, only taking the minimum right endpoint instead: </p><pre class="ghci"><span class="keyword">let</span> <span class="varid">rt</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">r</span>) <span class="varid">rt</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">min</span> <span class="varid">r</span> <span class="varid">rt</span> <span class="keyword">else</span> <span class="varid">maxBound</span>) <span class="varid">maxBound</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">r</span>) <span class="varid">rt</span> <span class="keyglyph">=</span> <img src="image/find-rect/rects1-rt.png" style="vertical-align:middle;"> </pre><p>Now we have all the ingredients for finding maximal rectangles: </p><ul><li> For a foreground pixel <tt class='complex'>(<span class="varid">u</span>,<span class="varid">v</span>)</tt>:</li> <li> Take as top <tt class='complex'><span class="varid">t</span><span class="varop">!!</span>(<span class="varid">u</span>,<span class="varid">v</span>)</tt></li> <li> Take as left <tt class='complex'><span class="varid">lt</span><span class="varop">!!</span>(<span class="varid">u</span>,<span class="varid">v</span>)</tt></li> <li> Take as right <tt class='complex'><span class="varid">rt</span><span class="varop">!!</span>(<span class="varid">u</span>,<span class="varid">v</span>)</tt></li> <li> Take as bottom <tt class='complex'><span class="varid">v</span><span class="varop">+</span><span class="num">1</span></tt>.</li> </ul><p>Every maximal rectangle can be found in this way. However, not all rectangles we get in this way are maximal. In particular, they could potentially still be extended downward. However, for finding the largest rectangle, it doesn't matter if we also see some non-maximal ones. There might also be duplicates, which again does not matter. </p><p>So now finishing up is just a matter of putting all the steps together in a function: </p><pre class="haskell"><span class="varid">allMaximalRects</span> <span class="keyglyph">::</span> <span class="conid">Image</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Rect</span><span class="listcon">]</span> <span class="varid">allMaximalRects</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">catMaybes</span> <span class="varop">.</span> <span class="varid">concat</span> <span class="varop">\$</span> <span class="varid">zipWith2d4</span> <span class="varid">mkRect</span> <span class="varid">lt</span> <span class="varid">rt</span> <span class="varid">t</span> <span class="varid">y</span> <span class="keyword">where</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="varid">x</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span><span class="varid">_</span> <span class="varid">y</span> <span class="keyglyph">-&gt;</span> <span class="varid">y</span> <span class="varop">+</span> <span class="num">1</span>) (<span class="num">-1</span>) <span class="varid">a</span> <span class="varid">l</span> <span class="keyglyph">=</span> <span class="varid">scanRightward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">x</span>) <span class="varid">l</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">l</span> <span class="keyword">else</span> <span class="varid">x</span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">x</span>) <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">scanLeftward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">x</span>) <span class="varid">r</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">r</span> <span class="keyword">else</span> <span class="varid">x</span>) (<span class="varid">imWidth</span> <span class="varid">a</span>) (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">x</span>) <span class="varid">t</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">y</span>) <span class="varid">t</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">t</span> <span class="keyword">else</span> <span class="varid">y</span><span class="varop">+</span><span class="num">1</span>) <span class="num">0</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">y</span>) <span class="varid">lt</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">l</span>) <span class="varid">lt</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">max</span> <span class="varid">l</span> <span class="varid">lt</span> <span class="keyword">else</span> <span class="varid">minBound</span>) <span class="varid">minBound</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">l</span>) <span class="varid">rt</span> <span class="keyglyph">=</span> <span class="varid">scanDownward</span> (<span class="keyglyph">\</span>(<span class="varid">a</span>,<span class="varid">r</span>) <span class="varid">rt</span> <span class="keyglyph">-&gt;</span> <span class="keyword">if</span> <span class="varid">a</span> <span class="keyword">then</span> <span class="varid">min</span> <span class="varid">r</span> <span class="varid">rt</span> <span class="keyword">else</span> <span class="varid">maxBound</span>) <span class="varid">maxBound</span> (<span class="varid">zip2d</span> <span class="varid">a</span> <span class="varid">r</span>) <span class="varid">mkRect</span> <span class="varid">l</span> <span class="varid">r</span> <span class="varid">t</span> <span class="varid">y</span> <span class="keyglyph">|</span> <span class="varid">l</span> <span class="varop">/=</span> <span class="varid">minBound</span> <span class="keyglyph">=</span> <span class="conid">Just</span> <span class="varop">\$</span> <span class="conid">Rect</span> <span class="varid">l</span> <span class="varid">t</span> (<span class="varid">r</span><span class="varop">-</span><span class="varid">l</span>) (<span class="varid">y</span><span class="varop">-</span><span class="varid">t</span><span class="varop">+</span><span class="num">1</span>) <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="conid">Nothing</span> </pre><p>A quick QuickCheck shows that <tt><span class="varid">largestRect<sub>fast</sub></span></tt> finds the same answer as the slow specification: </p><pre class="haskell"><span class="varid">prop<sub>fast_spec</sub></span> <span class="keyglyph">=</span> <span class="varid">forAll</span> <span class="varid">genImage</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">largestRect<sub>spec</sub></span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">largestRect<sub>fast</sub></span> <span class="varid">a</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">quickCheck</span> <span class="varid">prop<sub>fast_spec</sub></span> <span class="varop">+++</span> <span class="conid">OK</span>, <span class="varid">passed</span> <span class="num">100</span> <span class="varid">tests</span><span class="varop">.</span> </pre><h2><a name="conclusion"></a>Conclusion </h2> <p>It is possible to find all maximal rectangles that consist entirely of foreground pixels in an <span class="math">n*n</span> image in <span class="math">O(n<sup>2</sup>)</span> time. That is linear in the number of pixels. Obviously it is not possible to do any better in general. </p><p>You may wonder whether this method also works in higher dimensions. And the answer to that question is <em>no</em>. The reason is that there can be more than <span class="math">O(n<sup>3</sup>)</span> maximal cubes in a three dimensional image. In fact, there can be at least <span class="math">O(n<sup>(d-1)<sup>2</sup></sup>)</span> maximal hypercubes in <span class="math">d</span> dimensions. Just generalize this image to 3D: <br><img src="image/find-rect/worst-case.png" style="margin-left:2em;">. <a href="http://kyucon.com/qblock/#29920">Or click here for a 3D version</a>. </p> A small rant on writing academic papers http://twanvl.nl/blog/news/2011-07-22-publication-rant 2011-07-22T14:10:13Z <p>Warning: rant ahead. </p><p>This week I submitted for review the second revision of what will hopefully become my first scientific publication. Together with my supervisor I spent countless hours on this article. But does that mean that it is now the best text that I have ever written? I don't think so. </p><p>While a lot of effort did go into improving the clarity, structure, etc.; there are several competing interests which make things harder: </p><ul><li> The article should be short, which means that a lot of material had to be cut. Some things could be better explained, if only there was more space.</li> <li> On the other hand, the article should be complete and self contained. If I were to write a blog post on the same topic, I would split it up into a series of posts. But each part by itself would be unpublishable, so it has to be a whole.</li> <li> There are many asides, either to remark on something interesting, or sometimes just to appease the reviewers.</li> </ul><p>Pleasing the reviewers is something which I especially disliked. To be fair, a lot of comments raised by reviewers were valid, and pointed to actual shortcomings or errors in the manuscript. But some of the comments were of the form <em>"Could you also compare with X"</em>, <em>"Did you consider Y"</em> and <em>"This is related to prior work Z"</em>. As a result of trying to cover these comments, the paper becomes a Frankenstein's monster of irrelevant remarks. Where before we had: </p><ol><li> General Point 1</li> <li> Detailed Point 2</li> <li> Therefore Point 3</li> </ol><p>It now becomes </p><ol><li> Point 1</li> <li> Remark saying that point 1 was previously considered by SomePaper2010.</li> <li> Detailed Point 2</li> <li> Contrasting approach 2 against approach 2b from OtherPaper2009.</li> <li> Therefore Point 3</li> <li> Aside saying that also 3b, which is irrelevant for the rest of the article.</li> </ol><p>Okay, I am exaggerating a bit here. But still, I feel that the article would be better if it didn't try to do so many things at once. </p><p>Suggestions, criticism and comments on my sanity are welcome. </p> Isomorphism lenses http://twanvl.nl/blog/haskell/isomorphism-lenses 2011-05-22T16:23:12Z <p>In the past I have <a href="/tag/lens">blogged about functional references</a>. From now on I will conform to most of the rest of the world, and call these things lenses. </p><p>Giving a presentation on these objects has forced me to think about them some more. As a result of this thinking I have a new favorite representation, at least from a theory point of view: </p><blockquote style='font-style:italic'>A lens from type <tt><span class="varid">a</span></tt> to <tt><span class="varid">b</span></tt> is a bijection between <tt><span class="varid">a</span></tt> and a pair of <tt><span class="varid">b</span></tt> and some residual <tt><span class="varid">r</span></tt>.</blockquote> <p>In pseudo-code we would write that as </p><pre class="ghci"><span class="keyword">type</span> <span class="conid">Lens</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="keyword">exists</span> <span class="varid">r</span><span class="varop">.</span> <span class="varid">a</span> <span class="varop">&lt;-&gt;</span> (<span class="varid">b</span>,<span class="varid">r</span>) </pre><p>Except that Haskell has no <tt><span class="keyword">exists</span></tt> keyword, so you have to use a newtype wrapper: </p><p> </p><pre class="haskell"><span class="comment">-- Isomorphisms/bijections between type @a@ and @b@</span> <span class="keyword">data</span> <span class="conid">Iso</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">Iso</span> { <span class="varid">fw</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>, <span class="varid">bw</span> <span class="keyglyph">::</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> } <div class='empty-line'></div> <span class="comment">-- Lenses with a data wrapper, in practice you might want to unpack the Iso type</span> <span class="keyword">data</span> <span class="conid">Lens</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="keyword">forall</span> <span class="varid">r</span><span class="varop">.</span> <span class="conid">Lens</span> (<span class="conid">Iso</span> <span class="varid">a</span> (<span class="varid">b</span>,<span class="varid">r</span>)) </pre><p>So, why do I like this representation so much? </p><h2><a name="intuition"></a>Intuition</h2> <p>I believe this representation captures the intuition of what a lens does extremely well: You have some record type <tt><span class="varid">a</span></tt>, and you want to take out and a field of (a smaller) type <tt><span class="varid">b</span></tt>. When you do that you are left with some residual, which you can think of as <tt class='complex'><span class="varid">a</span><span class="varop">-</span><span class="varid">b</span></tt> (or should that be <tt class='complex'><span class="varid">a</span><span class="varop">/</span><span class="varid">b</span></tt>?). </p><p>I imagine this graphically as<br> <img src="image/lens/isolens1.png" style="margin-left:2em;margin-top:.5em;">,<br> where we have a square record <tt><span class="varid">a</span></tt>, containing a smaller circular field of type <tt><span class="varid">b</span></tt>. </p><p>Implementing the usual <tt><span class="varid">get</span></tt>, <tt><span class="varid">modify</span></tt> and <tt><span class="varid">set</span></tt> functions is now very easy, by going back and forth through the lens. </p><pre class="haskell"><span class="varid">get</span> <span class="keyglyph">::</span> <span class="conid">Lens</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">get</span> (<span class="conid">Lens</span> <span class="varid">l</span>) <span class="keyglyph">=</span> <span class="varid">fst</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <div class='empty-line'></div> <span class="varid">modify</span> <span class="keyglyph">::</span> <span class="conid">Lens</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="varid">modify</span> (<span class="conid">Lens</span> <span class="varid">l</span>) <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> <span class="varid">f</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <div class='empty-line'></div> <span class="varid">set</span> <span class="keyglyph">::</span> <span class="conid">Lens</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">set</span> <span class="varid">l</span> <span class="varid">b</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">modify</span> <span class="varid">l</span> (<span class="varid">const</span> <span class="varid">b</span>) <span class="varid">a</span> </pre><p>The nice thing about the existential quantification is that the residual type <tt><span class="varid">r</span></tt> can be anything you like. In some cases it is obvious what it could be, such as the case of tuples: </p><pre class="haskell"><span class="varid">myFst</span> <span class="keyglyph">::</span> <span class="conid">Lens</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varid">a</span> <span class="varid">myFst</span> <span class="keyglyph">=</span> <span class="conid">Lens</span> (<span class="conid">Iso</span> <span class="varid">id</span> <span class="varid">id</span>) <span class="comment">-- r = b</span> </pre><p>but we could also pick any other representation, </p><pre class="haskell"><span class="varid">myCrazyFst</span> <span class="keyglyph">::</span> <span class="conid">Lens</span> (<span class="varid">a</span>,<span class="conid">String</span>) <span class="varid">a</span> <span class="varid">myCrazyFst</span> <span class="keyglyph">=</span> <span class="conid">Lens</span> (<span class="conid">Iso</span> <span class="varid">fw</span> <span class="varid">bw</span>) <span class="comment">-- r = strings starting with &quot;Banana&quot;</span> <span class="keyword">where</span> <span class="varid">fw</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> (<span class="varid">a</span>, <span class="str">&quot;Banana&quot;</span> <span class="varop">++</span> <span class="varid">b</span>) <span class="varid">bw</span> (<span class="varid">a</span>,<span class="chr">'B'</span><span class="listcon">:</span><span class="chr">'a'</span><span class="listcon">:</span><span class="chr">'n'</span><span class="listcon">:</span><span class="chr">'a'</span><span class="listcon">:</span><span class="chr">'n'</span><span class="listcon">:</span><span class="chr">'a'</span><span class="listcon">:</span><span class="varid">b</span>) <span class="keyglyph">=</span> (<span class="varid">a</span>,<span class="varid">b</span>) </pre><p>For this to be an actual isomorphism we have to restrict the residual to only strings that start with <tt class='complex'><span class="str">&quot;Banana&quot;</span></tt>. That is not something we can actually enforce in Haskell, but then again, we don't check that a lens is an isomorphism at all. </p><p>Besides the simple intuition and the freedom in declaring them, there is another reason for liking these lenses. </p><h2><a name="laws"></a>Laws</h2> <p>There are two (or one, depending on how you count) obvious laws you want isomorphisms to satisfy: </p><pre class="ghci"><span class="varid">fw</span> <span class="varid">i</span> <span class="varop">.</span> <span class="varid">bw</span> <span class="varid">i</span> <span class="keyglyph">=</span> <span class="varid">bw</span> <span class="varid">i</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">i</span> <span class="keyglyph">=</span> <span class="varid">id</span> </pre><p>On the other hand, there are several less obvious laws for lenses: </p><pre class="ghci"><span class="varid">set</span> <span class="varid">l</span> (<span class="varid">get</span> <span class="varid">l</span> <span class="varid">a</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">a</span> <span class="varid">get</span> <span class="varid">l</span> (<span class="varid">set</span> <span class="varid">l</span> <span class="varid">b</span> <span class="varid">a</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">b</span> <span class="varid">set</span> <span class="varid">l</span> <span class="varid">c</span> (<span class="varid">set</span> <span class="varid">l</span> <span class="varid">b</span> <span class="varid">a</span>) <span class="keyglyph">=</span> <span class="varid">set</span> <span class="varid">l</span> <span class="varid">c</span> <span class="varid">a</span> </pre><p>And now comes the magic: with isomorphism lenses all of these laws follow from the simple laws of isomorphisms. Here are the quick and dirty proofs. One: </p><pre class="ghci"> <span class="varid">set</span> <span class="varid">l</span> (<span class="varid">get</span> <span class="varid">l</span> <span class="varid">a</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- expanding definitions of get and set -}</span> (<span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> ((<span class="varid">fst</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span>) <span class="varid">a</span>)) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- let x = fw l a, rewrite -}</span> <span class="varid">bw</span> <span class="varid">l</span> (<span class="varid">first</span> (<span class="varid">const</span> (<span class="varid">fst</span> <span class="varid">x</span>)) <span class="varid">x</span>) <span class="keyword">where</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- (first (const (fst x)) x) = x -}</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varid">x</span> <span class="keyword">where</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- fill in x and rewrite -}</span> (<span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- isomorphism law -}</span> <span class="varid">a</span> </pre><p>Two: </p><pre class="ghci"> <span class="varid">get</span> <span class="varid">l</span> (<span class="varid">set</span> <span class="varid">l</span> <span class="varid">b</span> <span class="varid">a</span>) <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- expanding definitions of get and set, rewrite to use composition -}</span> <span class="varid">fst</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">b</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- isomorphism law -}</span> <span class="varid">fst</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">b</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- expanding fst, first and const -}</span> (<span class="keyglyph">\</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="keyglyph">-&gt;</span> <span class="varid">x</span>) <span class="varop">.</span> (<span class="keyglyph">\</span>(<span class="varid">x</span>,<span class="varid">y</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">b</span>,<span class="varid">y</span>)) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- composing the two lambda terms -}</span> <span class="varid">const</span> <span class="varid">b</span> <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- definition of const -}</span> <span class="varid">b</span> </pre><p>Three: </p><pre class="ghci"> <span class="varid">set</span> <span class="varid">l</span> <span class="varid">c</span> (<span class="varid">set</span> <span class="varid">l</span> <span class="varid">b</span> <span class="varid">a</span>) <span class="keyglyph">=</span> <span class="comment">{- expanding definition of set, rewrite to use composition -}</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">c</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">b</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- isomorphism law -}</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">c</span>) <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">b</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- first f . first g = first (f . g) -}</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">c</span> <span class="varop">.</span> <span class="varid">const</span> <span class="varid">b</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- const c . const b = const c -}</span> <span class="varid">bw</span> <span class="varid">l</span> <span class="varop">.</span> <span class="varid">first</span> (<span class="varid">const</span> <span class="varid">c</span>) <span class="varop">.</span> <span class="varid">fw</span> <span class="varid">l</span> <span class="varop">\$</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="comment">{- definition of set -}</span> <span class="varid">set</span> <span class="varid">l</span> <span class="varid">c</span> <span class="varid">a</span> </pre><p>So there you have it. A simple representation of lenses that gives a nice intuition of what these things actually do. And as an added bonus, the laws for lenses follow directly from the definition. Finally I should say that this representation is not my idea, it has been around in the literature for quite some time. </p> Talk on Lenses http://twanvl.nl/blog/news/2011-05-19-lenses-talk 2011-05-19T18:15:00Z <p>Two days ago I gave a talk on lenses at the Radboud Unviersity (where I work on my PhD on machine learning). I put the slides online for your enjoyment, although it might be hard to follow, since it is light on explanatory text. </p><p>This talk includes information from at least <a href="/blog/haskell/overloading-functional-references">three different</a> <a href="/blog/haskell/References-Arrows-and-Categories">earlier</a> <a href="/blog/haskell/cps-functional-references">blog posts</a>, as well as <a href="http://arxiv.org/abs/1103.2841">Russel O'Connor's recent paper on multiplate</a>. There is no new information in the talk, but I do have a new favorite representation for lenses. </p><ul class="link-list"><li><a href="/files/lenses-talk-2011-05-17.pdf"><span class="thumbnail icon-pdf"></span><span class="details"></span><span class="title">Lenses Talk 2011 (slides)</span><span class="desc"></span></a></li> <li><a href="/files/lenses-talk-2011-05-17-tex.zip"><span class="thumbnail icon-zip"></span><span class="details"></span><span class="title">The tex source file for these slides</span><span class="desc"></span></a></li> </ul> Moving to a new website http://twanvl.nl/blog/moving-to-a-new-blog 2011-03-19T18:31:00Z <p>I am moving my website from <a href="http://twan.home.fmf.nl/"><a href="http://twan.home.fmf.nl/</a>">http://twan.home.fmf.nl/</a></a> to <a href="http://twanvl.nl/"><a href="http://twanvl.nl/</a>">http://twanvl.nl/</a></a>. The moves comes with a fancy new design, as well as rewritten backend code. </p> More composition operators http://twanvl.nl/blog/haskell/more-function-composition 2010-07-12T22:00:00Z <p>Here is an idea for some more function composition operators, beyond just <tt class='complex'>(<span class="varop">.</span>)</tt>: </p><pre class="haskell">(<span class="varid">f</span> <span class="varop">.\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="keyglyph">=</span> (<span class="varid">f</span>) <span class="varop">.</span> (<span class="varid">g</span> <span class="varop">\$</span> <span class="varid">x</span>) (<span class="varid">f</span> <span class="varop">\$.</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varop">\$</span> <span class="varid">x</span>) <span class="varop">.</span> (<span class="varid">g</span>) (<span class="varid">f</span> <span class="varop">.\$\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span>) <span class="varop">.</span> (<span class="varid">g</span> <span class="varop">\$</span> <span class="varid">x</span> <span class="varop">\$</span> <span class="varid">y</span>) (<span class="varid">f</span> <span class="varop">\$.\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varop">\$</span> <span class="varid">x</span>) <span class="varop">.</span> (<span class="varid">g</span> <span class="varop">\$</span> <span class="varid">y</span>) (<span class="varid">f</span> <span class="varop">\$\$.</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varop">\$</span> <span class="varid">x</span> <span class="varop">\$</span> <span class="varid">y</span>) <span class="varop">.</span> (<span class="varid">g</span>) <span class="comment">-- etc.</span> <span class="keyword">infixl</span> <span class="num">8</span> <span class="varop">.\$</span>, <span class="varop">\$.</span>, <span class="varop">.\$\$</span>, <span class="varop">\$.\$</span>, <span class="varop">\$\$.</span> <span class="comment">-- slightly less tight than (.)</span> </pre><p>The <tt class='complex'><span class="varop">.\$</span></tt> name is supposed suggests that an extra argument is applied on the right before the functions are composed. Notice also that the dollars and dot on the left hand site match those on the right hand side. These combinators make writing point free code easier: </p><pre class="ghci"><span class="varid">concatMap</span> <span class="keyglyph">=</span> <span class="varid">concat</span> <span class="varop">.\$</span> <span class="varid">map</span> <span class="varid">sum23</span> <span class="keyglyph">=</span> (<span class="varop">+</span>) <span class="varop">.</span> (<span class="num">2</span><span class="varop">*</span>) <span class="varop">\$.</span> (<span class="num">3</span><span class="varop">*</span>) <span class="comment">-- \x y -&gt; 2*x + 3*y</span> </pre><p><br> Here is another family of composition operators: </p><pre class="haskell">(<span class="varid">f</span> <span class="varop">\$.</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="keyglyph">=</span> (<span class="varid">f</span>) (<span class="varid">g</span> <span class="varid">x</span>) <span class="comment">-- a.k.a. (.)</span> (<span class="varid">f</span> <span class="varop">.\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span>) <span class="comment">-- a.k.a. flip</span> (<span class="varid">f</span> <span class="varop">\$..</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span>) (<span class="varid">g</span> <span class="varid">x</span> <span class="varid">y</span>) (<span class="varid">f</span> <span class="varop">.\$.</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">y</span>) (<span class="varid">f</span> <span class="varop">..\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span> <span class="varid">y</span>) (<span class="varid">g</span>) (<span class="varid">f</span> <span class="varop">\$...</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">=</span> (<span class="varid">f</span>) (<span class="varid">g</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span>) (<span class="varid">f</span> <span class="varop">.\$..</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span>) (<span class="varid">g</span> <span class="varid">y</span> <span class="varid">z</span>) (<span class="varid">f</span> <span class="varop">..\$.</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span> <span class="varid">y</span>) (<span class="varid">g</span> <span class="varid">z</span>) (<span class="varid">f</span> <span class="varop">...\$</span> <span class="varid">g</span>) <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span>) (<span class="varid">g</span>) <span class="comment">-- etc.</span> <span class="keyword">infixl</span> <span class="num">8</span> <span class="varop">\$.</span>, <span class="varop">.\$</span>, <span class="varop">\$..</span>,<span class="varop">.\$.</span>,<span class="varop">..\$</span>, <span class="varop">\$...</span>,<span class="varop">.\$..</span>,<span class="varop">..\$.</span>,<span class="varop">...\$</span> </pre><p>Think of the <tt class='complex'><span class="varop">.</span></tt> as the placeholder for an argument. It would be better if I could use <tt><span class="varid">_</span></tt>, but Haskell doesn't allow that. You can also think of the dots as the points from point-free style, so these operators allow for the preservation of the number of points :). With these operators the previous example becomes: </p><pre class="ghci"><span class="varid">concatMap</span> <span class="keyglyph">=</span> <span class="varid">concat</span> <span class="varop">\$..</span> <span class="varid">map</span> <span class="varid">sum23</span> <span class="keyglyph">=</span> (<span class="varop">+</span>) <span class="varop">\$.</span> (<span class="num">2</span><span class="varop">*</span>) <span class="varop">.\$.</span> (<span class="num">3</span><span class="varop">*</span>) <span class="comment">-- \x y -&gt; 2*x + 3*y</span> </pre><p>I like the second family better, because they do not use <tt class='complex'>(<span class="varop">.</span>)</tt>, which makes the first family more confusing. What do you think? Would these operators be useful in practice? </p> Four ways to fold an array http://twanvl.nl/blog/haskell/four-ways-to-fold 2009-11-08T23:00:00Z <p>As most Haskell programmers know, there are two ways to fold a list: from the right with <tt><span class="varid">foldr</span></tt> and from the left with <tt><span class="varid">foldl</span></tt>. <tt><span class="varid">foldr</span></tt> is corecursive (productive), which is great when the output can be produced lazily. <tt><span class="varid">foldl</span></tt> (or better, its strict cousin <tt class='complex'><span class="varid">foldl'</span></tt>) is tail recursive, preventing stack overflows. </p><p>We can define analogous operations for other data structures like 1-dimensional arrays. Libraries like 'Data.ByteString' and 'Data.Vector' provide these. But as I will show in this post there are more fold operations than the common two. </p><p>The data type I will use in this post is simply </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Array</span> <span class="conid">Int</span> <span class="varid">a</span> <span class="comment">-- and two utility functions for getting the lower and upper bounds</span> <span class="varid">lo</span>,<span class="varid">hi</span> <span class="keyglyph">::</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="varid">lo</span> <span class="keyglyph">=</span> <span class="varid">fst</span> <span class="varop">.</span> <span class="varid">bounds</span> <span class="varid">hi</span> <span class="keyglyph">=</span> <span class="varid">snd</span> <span class="varop">.</span> <span class="varid">bounds</span> </pre><p>The right fold applies a function <tt><span class="varid">f</span></tt> to the current value and the folded result of the rest of the array: </p><pre class="haskell"><span class="varid">foldr<sub>a</sub></span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">foldr<sub>a</sub></span> <span class="varid">f</span> <span class="varid">z0</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">go</span> (<span class="varid">lo</span> <span class="varid">ar</span>) <span class="keyword">where</span> <span class="varid">go</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&gt;</span> <span class="varid">hi</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">z0</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">f</span> (<span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span>) (<span class="varid">go</span> (<span class="varid">i</span> <span class="varop">+</span> <span class="num">1</span>)) </pre><p>The (strict) left fold uses an accumulator parameter: </p><pre class="haskell"><span class="comment">-- IGNORE, this function is the same as foldl' which is more interesting anyway</span> <span class="varid">foldl<sub>a</sub></span> <span class="keyglyph">::</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">foldl<sub>a</sub></span> <span class="varid">f</span> <span class="varid">z0</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">go</span> <span class="varid">z0</span> (<span class="varid">lo</span> <span class="varid">ar</span>) <span class="keyword">where</span> <span class="varid">go</span> <span class="varid">z</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&gt;</span> <span class="varid">hi</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">go</span> (<span class="varid">f</span> <span class="varid">z</span> (<span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span>)) (<span class="varid">i</span> <span class="varop">+</span> <span class="num">1</span>) </pre><pre class="haskell"><span class="varid">foldl'<sub>a</sub></span> <span class="keyglyph">::</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">foldl'<sub>a</sub></span> <span class="varid">f</span> <span class="varid">z0</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">go</span> <span class="varid">z0</span> (<span class="varid">lo</span> <span class="varid">ar</span>) <span class="keyword">where</span> <span class="varid">go</span> <span class="varop">!</span><span class="varid">z</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&gt;</span> <span class="varid">hi</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">go</span> (<span class="varid">f</span> <span class="varid">z</span> (<span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span>)) (<span class="varid">i</span> <span class="varop">+</span> <span class="num">1</span>) </pre><p>In each case, the recursive <tt><span class="varid">go</span></tt> function is very similar in structure to the list version; only instead of recursing for the tail of the list we recurse for index <tt class='complex'><span class="varid">i</span><span class="varop">+</span><span class="num">1</span></tt>. The time and space behavior is also similar. For example, if you have a large array </p><pre class="haskell"><span class="varid">testArray</span> <span class="keyglyph">::</span> <span class="conid">Array1D</span> <span class="conid">Integer</span> <span class="varid">testArray</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">1</span>,<span class="num">10</span><span class="varop">^</span><span class="num">6</span>) <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="listcon">]</span> </pre><p>Then for computing something like the sum of all elements, you should use a strict left fold: </p><pre class="ghci"><span class="input">*Main&gt;</span> <span class="varid">foldl'<sub>a</sub></span> (<span class="varop">+</span>) <span class="num">0</span> <span class="varid">testArray</span> 50000005000000 <span class="input">*Main&gt;</span> <span class="varid">foldr<sub>a</sub></span> (<span class="varop">+</span>) <span class="num">0</span> <span class="varid">testArray</span> *** Exception: stack overflow </pre><p>On the other hand, a right fold is the way to go when you are only interested in a part of a lazily produced result. For example when converting an array to a list: </p><pre class="ghci"><span class="input">*Main&gt;</span> <span class="varid">take</span> <span class="num">10</span> <span class="varop">.</span> <span class="varid">foldr<sub>a</sub></span> <span class="listcon">(:)</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varop">\$</span> <span class="varid">testArray</span> [1,2,3,4,5,6,7,8,9,10] (0.02 secs, 520824 bytes) <span class="input">*Main&gt;</span> <span class="varid">take</span> <span class="num">10</span> <span class="varop">.</span> <span class="varid">foldl'<sub>a</sub></span> (<span class="varid">flip</span> <span class="listcon">(:)</span>) <span class="listcon">[</span><span class="listcon">]</span> <span class="varop">\$</span> <span class="varid">testArray</span> [1000000,999999,999998,999997,999996,999995,999994,999993,999992,999991] (5.89 secs, 263122464 bytes) </pre><p>All of this is exactly the same as with lists. </p><p><br> But, if you look at <tt><span class="varid">foldr<sub>a</sub></span></tt> and <tt class='complex'><span class="varid">foldl'<sub>a</sub></span></tt>, you will see that they both contain a loop doing <tt class='complex'>(<span class="varid">i</span> <span class="varop">+</span> <span class="num">1</span>)</tt>. So in a sense, both of these functions work from left to right! </p><p>Because arrays allow for random access, it is possible to make true right to left folds, just start at the end and do <tt class='complex'>(<span class="varid">i</span> <span class="varop">-</span> <span class="num">1</span>)</tt> in each iteration. </p><pre class="haskell"><span class="varid">foldl<sub>b</sub></span> <span class="keyglyph">::</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">foldl<sub>b</sub></span> <span class="varid">f</span> <span class="varid">z</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">go</span> (<span class="varid">hi</span> <span class="varid">ar</span>) <span class="keyword">where</span> <span class="varid">go</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&lt;</span> <span class="varid">lo</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">f</span> (<span class="varid">go</span> (<span class="varid">i</span> <span class="varop">-</span> <span class="num">1</span>)) (<span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span>) </pre><pre class="haskell"><span class="varid">foldr'<sub>b</sub></span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array1D</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">foldr'<sub>b</sub></span> <span class="varid">f</span> <span class="varid">z0</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">go</span> <span class="varid">z0</span> (<span class="varid">hi</span> <span class="varid">ar</span>) <span class="keyword">where</span> <span class="varid">go</span> <span class="varop">!</span><span class="varid">z</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&lt;</span> <span class="varid">lo</span> <span class="varid">ar</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">go</span> (<span class="varid">f</span> (<span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span>) <span class="varid">z</span>) (<span class="varid">i</span> <span class="varop">-</span> <span class="num">1</span>) </pre><p>Just look at the pretty duality there! We now have a <em>lazy</em> left fold and a <em>strict</em> right fold. </p><p>The behavior is exactly the opposite of that of the <tt><span class="varid">fold<sub>a</sub></span></tt> functions above: </p><pre class="ghci"><span class="input">*Main&gt;</span> <span class="varid">foldl<sub>b</sub></span> (<span class="varop">+</span>) <span class="num">0</span> <span class="varid">testArray</span> *** Exception: stack overflow <span class="input">*Main&gt;</span> <span class="varid">foldr'<sub>b</sub></span> (<span class="varop">+</span>) <span class="num">0</span> <span class="varid">testArray</span> 50000005000000 </pre><pre class="ghci"><span class="input">*Main&gt;</span> <span class="varid">take</span> <span class="num">10</span> <span class="varop">.</span> <span class="varid">foldr'<sub>b</sub></span> <span class="listcon">(:)</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varop">\$</span> <span class="varid">testArray</span> [1,2,3,4,5,6,7,8,9,10] (6.19 secs, 263055372 bytes) <span class="input">*Main&gt;</span> <span class="varid">take</span> <span class="num">10</span> <span class="varop">.</span> <span class="varid">foldl<sub>b</sub></span> (<span class="varid">flip</span> <span class="listcon">(:)</span>) <span class="listcon">[</span><span class="listcon">]</span> <span class="varop">\$</span> <span class="varid">testArray</span> [1000000,999999,999998,999997,999996,999995,999994,999993,999992,999991] (0.00 secs, 524836 bytes) </pre><p>To summarize, four ways to fold an array are: <table> <tr><td></td><td><tt><span class="varid">lo</span></tt> to <tt><span class="varid">hi</span></tt>, <tt class='complex'><span class="varid">i</span><span class="varop">+</span><span class="num">1</span></tt></td><td><tt><span class="varid">hi</span></tt> to <tt><span class="varid">lo</span></tt>, <tt class='complex'><span class="varid">i</span><span class="num">-1</span></tt></td></tr> <tr><td>corecursion, productive, lazy</td><td><tt><span class="varid">foldr<sub>a</sub></span></tt></td><td><tt><span class="varid">foldl<sub>b</sub></span></tt></td><tr> <tr><td>accumulator, tail recursive, strict</td><td><tt class='complex'><span class="varid">foldl'<sub>a</sub></span></tt></td><td><tt class='complex'><span class="varid">foldr'<sub>b</sub></span></tt></td><tr> </table> </p><p>Exercise: can you think of other ways to fold an array? </p> CPS based functional references http://twanvl.nl/blog/haskell/cps-functional-references 2009-07-19T22:00:00Z <p>I have recently come up with a new way of representing functional references. </p><p>As you might recall, functional references (also called lenses) are like a pointer into a field of some data structure. The value of this field can be extracted and modified. For example: </p><pre class="ghci"><span class="input">GHCi&gt;</span> <span class="varid">get</span> <span class="varid">fstF</span> (<span class="num">123</span>,<span class="str">&quot;hey&quot;</span>) <span class="num">123</span> <span class="input">GHCi&gt;</span> <span class="varid">set</span> <span class="varid">fstF</span> <span class="num">456</span> (<span class="num">123</span>,<span class="str">&quot;hey&quot;</span>) (<span class="num">456</span>,<span class="str">&quot;hey&quot;</span>) <span class="input">GHCi&gt;</span> <span class="varid">modify</span> <span class="varid">fstF</span> (<span class="varop">*</span><span class="num">2</span>) (<span class="num">123</span>,<span class="str">&quot;hey&quot;</span>) (<span class="num">246</span>,<span class="str">&quot;hey&quot;</span>) </pre><p>where <tt><span class="varid">fstF</span></tt> is a functional reference to the first element of a pair. It has the type <tt class='complex'><span class="conid">RefF</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varid">a</span></tt>, i.e. in a 'record' of type <tt class='complex'>(<span class="varid">a</span>,<span class="varid">b</span>)</tt> it points to an <tt><span class="varid">a</span></tt>. </p><p>Previous representations relied on a record that contained the <tt><span class="varid">get</span></tt> and <tt><span class="varid">set</span></tt> or the <tt><span class="varid">get</span></tt> an <tt><span class="varid">modify</span></tt> functions. But there is a much nicer looking representation possible using Functors. </p><p><br>First of all we will need a language extension and some modules: </p><pre class="haskell"><span class="pragma">{-# LANGUAGE Rank2Types #-}</span> <span class="keyword">import</span> <span class="conid">Control.Applicative</span> <span class="keyword">import</span> <span class="conid">Control.Monad.Identity</span> </pre><p>Now the representation for functional references I came up with is: </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="keyword">forall</span> <span class="varid">f</span><span class="varop">.</span> <span class="conid">Functor</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span>) </pre><p>This type looks a lot like a continuation passing style function, which would be simply <tt class='complex'>(<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">r</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">r</span>)</tt>, but where the result is <tt class='complex'><span class="varid">f</span> <span class="varid">a</span></tt> instead of any <tt><span class="varid">r</span></tt>. With different functors you get different behaviors. With the constant functor we can <tt><span class="varid">get</span></tt> the field pointed to: </p><pre class="haskell"><span class="varid">get</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">get</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">getConst</span> <span class="varop">.</span> <span class="varid">r</span> <span class="conid">Const</span> </pre><p>While the identity functor allows a function us to <tt><span class="varid">modify</span></tt> the field: </p><pre class="haskell"><span class="varid">modify</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">modify</span> <span class="varid">r</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="varid">runIdentity</span> <span class="varop">.</span> <span class="varid">r</span> (<span class="conid">Identity</span> <span class="varop">.</span> <span class="varid">m</span>) <div class='empty-line'></div> <span class="varid">set</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">set</span> <span class="varid">r</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">modify</span> <span class="varid">r</span> (<span class="varid">const</span> <span class="varid">b</span>) </pre><p>As an example of an 'instance', here is the <tt><span class="varid">fstF</span></tt> function I used in the introduction: </p><pre class="haskell"><span class="varid">fstF</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varid">a</span> <span class="varid">fstF</span> <span class="varid">a_to_fa</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> (<span class="keyglyph">\</span><span class="varid">a'</span> <span class="keyglyph">-&gt;</span> (<span class="varid">a'</span>,<span class="varid">b</span>)) <span class="varop">&lt;\$&gt;</span> <span class="varid">a_to_fa</span> <span class="varid">a</span> </pre><p>If we had <a href="http://hackage.haskell.org/trac/ghc/ticket/3377">tuple sections</a> it could be written as simply </p><pre class="ghci"><span class="varid">fstF</span> <span class="varid">x</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> (,<span class="varid">b</span>) <span class="varop">&lt;\$&gt;</span> <span class="varid">x</span> <span class="varid">a</span> </pre><p><br>To get access to inner fields, functional references can be composed. So <tt class='complex'><span class="varid">compose</span> <span class="varid">fstF</span> <span class="varid">fstF</span></tt> points to the first element inner inside the first outer element of a nested pair. One of the things that I like about the cps/functor based representation is that composition is quite beautiful and symmetric: </p><pre class="haskell"><span class="varid">compose</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">c</span> <span class="varid">compose</span> <span class="varid">r</span> <span class="varid">s</span> <span class="keyglyph">=</span> <span class="varid">s</span> <span class="varop">.</span> <span class="varid">r</span> <div class='empty-line'></div> <span class="varid">idF</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">a</span> <span class="varid">idF</span> <span class="keyglyph">=</span> <span class="varid">id</span> </pre><p>Let me conclude with the pair operator, called <tt class='complex'>(<span class="varop">***</span>)</tt> in Control.Arrow. Unfortunately this operator is not as easy to define. </p><pre class="haskell"><span class="varid">pair</span> <span class="keyglyph">::</span> <span class="conid">RefF</span> <span class="varid">a</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="conid">RefF</span> <span class="varid">b</span> <span class="varid">d</span> <span class="keyglyph">-&gt;</span> <span class="conid">RefF</span> (<span class="varid">a</span>,<span class="varid">b</span>) (<span class="varid">c</span>,<span class="varid">d</span>) <span class="varid">pair</span> <span class="varid">r</span> <span class="varid">s</span> <span class="varid">cd_to_fcd</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> <span class="varid">some_ugly_code</span> </pre><p>In fact, the only way I know of implementing pair is by moving back and forth to a get/set representation </p><pre class="haskell"> <span class="keyword">where</span> <span class="varid">some_ugly_code</span> <span class="varop">=</span> <span class="keyword">let</span> <span class="varid">fcd</span> <span class="keyglyph">=</span> <span class="varid">cd_to_fcd</span> (<span class="varid">get</span> <span class="varid">r</span> <span class="varid">a</span>, <span class="varid">get</span> <span class="varid">s</span> <span class="varid">b</span>) <span class="comment">-- :: f (c,d)</span> <span class="varid">cd_to_ab</span> (<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> (<span class="varid">set</span> <span class="varid">r</span> <span class="varid">c</span> <span class="varid">a</span>, <span class="varid">set</span> <span class="varid">s</span> <span class="varid">d</span> <span class="varid">b</span>) <span class="comment">-- :: (c,d) -&gt; (a,b)</span> <span class="keyword">in</span> <span class="varid">fmap</span> <span class="varid">cd_to_ab</span> <span class="varid">fcd</span> <span class="comment">-- :: f (a,b)</span> </pre><p>The problem is that we need to split one function of type <tt class='complex'>(<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> (<span class="varid">c</span>,<span class="varid">d</span>)</tt> into two, <tt class='complex'><span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">c</span></tt> and <tt class='complex'><span class="varid">d</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">d</span></tt>, because that is what the left and right arguments expect. Then later, we would need to do the reverse and combine two of these functions again. </p><p>Does anyone have a better suggestion for implementing <tt><span class="varid">pair</span></tt>? </p> Where do I get my non-regular types? http://twanvl.nl/blog/haskell/non-regular2 2009-04-24T22:00:00Z <p><a href="http://twanvl.nl/blog/haskell/non-regular1">Friday I wrote</a> about the type </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">b</span> <span class="keyglyph">|</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="conid">FunList</span> <span class="varid">a</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>)) </pre><p>Where did this type come from? What can you use it for? </p><p>The story starts with another way of constructing <tt><span class="conid">FunList</span></tt>s, besides <tt><span class="varid">pure</span></tt>. For contrast I will call it 'impure'. </p><pre class="haskell"><span class="varid">impure</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">a</span> <span class="varid">impure</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="conid">Done</span> <span class="varid">id</span>) </pre><p>I claim that <em>any</em> FunList can be written in the form </p><pre class="ghci"><span class="varid">pure</span> <span class="varid">b</span> <span class="varop">&lt;*&gt;</span> <span class="varid">impure</span> <span class="varid">a<sub>1</sub></span> <span class="varop">&lt;*&gt;</span> <span class="varid">impure</span> <span class="varid">a<sub>2</sub></span> <span class="varop">&lt;*&gt;</span> <span class="varop">...</span> </pre><p>for some <tt><span class="varid">b</span></tt> and <tt><span class="varid">a<sub>1</sub></span></tt>, <tt><span class="varid">a<sub>2</sub></span></tt>, etc. In other words, <tt><span class="varid">impure</span></tt> and <tt><span class="conid">Applicative</span></tt> are all that you need. The following function converts a FunList to the above form, where <tt><span class="varid">impure</span></tt> and the <tt><span class="conid">Applicative</span></tt> instance are left as parameters: </p><pre class="haskell"><span class="varid">withImpure</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">b</span> <span class="varid">withImpure</span> <span class="varid">imp</span> (<span class="conid">Done</span> <span class="varid">b</span>) <span class="keyglyph">=</span> <span class="varid">pure</span> <span class="varid">b</span> <span class="varid">withImpure</span> <span class="varid">imp</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">f</span>) <span class="keyglyph">=</span> <span class="varid">withImpure</span> <span class="varid">imp</span> <span class="varid">f</span> <span class="varop">&lt;*&gt;</span> <span class="varid">imp</span> <span class="varid">a</span> </pre><p>If you use this with the Applicative instance from last time you will find that <tt class='complex'><span class="varid">getAs</span> <span class="varop">.</span> <span class="varid">withImpure</span> <span class="varid">impure</span> <span class="keyglyph">=</span> <span class="varid">reverse</span> <span class="varop">.</span> <span class="varid">getAs</span></tt>!, I have written a reverse function without realizing it. Since this time we <em>don't</em> want to reverse the list, I am going to turn the Applicative instance around for this post: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Applicative</span> (<span class="conid">FunList</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">pure</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">c</span> <span class="varop">&lt;*&gt;</span> <span class="conid">Done</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> (<span class="varop">\$</span><span class="varid">b</span>) <span class="varid">c</span> <span class="varid">c</span> <span class="varop">&lt;*&gt;</span> <span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> ((<span class="varop">.</span>) <span class="varop">&lt;\$&gt;</span> <span class="varid">c</span> <span class="varop">&lt;*&gt;</span> <span class="varid">z</span>) </pre><p>To support my claim above I need to prove that <tt class='complex'><span class="varid">withImpure</span> <span class="varid">impure</span> <span class="keyglyph">=</span> <span class="varid">id</span></tt>. This is a simple exercise in proof by induction. First of, we have that </p><pre class="ghci"><span class="varid">withImpure</span> <span class="varid">impure</span> (<span class="conid">Done</span> <span class="varid">b</span>) <span class="keyglyph">=</span> <span class="varid">pure</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">b</span> </pre><p>Now assume that the theorem holds for <tt><span class="varid">z</span></tt>, i.e. <tt class='complex'><span class="varid">withImpure</span> <span class="varid">impure</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">z</span></tt>. Then </p><pre class="ghci"> <span class="varid">withImpure</span> <span class="varid">impure</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span>) <span class="keyglyph">=</span> <span class="varid">withImpure</span> <span class="varid">impure</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="varid">impure</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="varid">impure</span> <span class="varid">a</span> <span class="comment">-- by induction hypotheis</span> <span class="keyglyph">=</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="conid">Done</span> <span class="varid">id</span>) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> ((<span class="varop">.</span>) <span class="varop">&lt;\$&gt;</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="conid">Done</span> <span class="varid">id</span>) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="varid">fmap</span> (<span class="varop">\$</span><span class="varid">id</span>) (<span class="varid">fmap</span> (<span class="varop">.</span>) <span class="varid">z</span>)) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="varid">fmap</span> (<span class="varop">.</span><span class="varid">id</span>) <span class="varid">z</span>) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span> </pre><p>By induction <tt class='complex'><span class="varid">withImpure</span> <span class="varid">impure</span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">z</span></tt> for all <tt><span class="varid">z</span></tt>. </p><p><br> I actually came upon FunList from the other direction. I started with the higher order type </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">ApplicativeFunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="keyword">forall</span> <span class="varid">f</span><span class="varop">.</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">b</span> </pre><p>An ApplicativeFunList is a function of the form <tt class='complex'><span class="keyglyph">\</span><span class="varid">imp</span> <span class="keyglyph">-&gt;</span> <span class="varid">applicativeStuff</span></tt>. Since the applicativeStuff has to work for <em>any</em> applicative functor it can only use operations from that class in addition to the <tt><span class="varid">imp</span></tt> argument. Because of the Applicative laws, things like <tt class='complex'><span class="varid">anything</span> <span class="varop">&lt;*&gt;</span> <span class="varid">pure</span> <span class="varid">x</span></tt> are the same as <tt class='complex'>(<span class="varop"><span class="math"></span><span class="varid">x</span>) <span class="varop">&lt;</span>&gt;</span> <span class="varid">anything</span></tt>, so the only interesting functions of this form are </p><pre class="ghci"><span class="keyglyph">\</span><span class="varid">imp</span> <span class="keyglyph">-&gt;</span> <span class="varid">pure</span> <span class="varid">b</span> <span class="keyglyph">\</span><span class="varid">imp</span> <span class="keyglyph">-&gt;</span> <span class="varid">pure</span> <span class="varid">b</span> <span class="varop">&lt;*&gt;</span> <span class="varid">imp</span> <span class="varid">a<sub>1</sub></span> <span class="keyglyph">\</span><span class="varid">imp</span> <span class="keyglyph">-&gt;</span> <span class="varid">pure</span> <span class="varid">b</span> <span class="varop">&lt;*&gt;</span> <span class="varid">imp</span> <span class="varid">a<sub>1</sub></span> <span class="varop">&lt;*&gt;</span> <span class="varid">imp</span> <span class="varid">a<sub>2</sub></span> <span class="comment">-- etc.</span> </pre><p>Which is precisely what a <tt><span class="conid">FunList</span></tt> can represent! Indeed, we can convert any FunList to an ApplicativeFunList, and back again: </p><pre class="haskell"><span class="varid">toAFL</span> <span class="keyglyph">::</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">ApplicativeFunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">toAFL</span> <span class="varid">fl</span> <span class="varid">imp</span> <span class="keyglyph">=</span> <span class="varid">withImpure</span> <span class="varid">imp</span> <span class="varid">fl</span> <div class='empty-line'></div> <span class="varid">fromAFL</span> <span class="keyglyph">::</span> <span class="conid">ApplicativeFunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">fromAFL</span> <span class="varid">afl</span> <span class="keyglyph">=</span> <span class="varid">afl</span> <span class="varid">impure</span> </pre><p>We already know that <tt class='complex'><span class="varid">fromAFL</span> <span class="varop">.</span> <span class="varid">toAFL</span> <span class="keyglyph">=</span> <span class="varid">withImpure</span> <span class="varid">impure</span> <span class="keyglyph">=</span> <span class="varid">id</span></tt>. The other way around, I claim (but do not prove yet) that <tt class='complex'><span class="varid">toAFL</span> <span class="varop">.</span> <span class="varid">fromAFL</span> <span class="keyglyph">=</span> <span class="varid">id</span></tt>. Hence, <tt><span class="conid">FunList</span></tt> and <tt><span class="conid">ApplicativeFunList</span></tt> are isomorphic! </p> A non-regular data type challenge http://twanvl.nl/blog/haskell/non-regular1 2009-04-22T22:00:00Z <p>While playing around with generalized functional references I encountered the following list-like data type: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="varid">b</span> <span class="keyglyph">|</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="conid">FunList</span> <span class="varid">a</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>)) </pre><p>This is a non-regular data type, meaning that inside the <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span></tt> there is a <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span> <i>not-b</i></tt>. So, what does a value of this type look like? Well, it can be </p><ul><li> <tt class='complex'><span class="conid">Done</span> (<span class="varid">x</span> <span class="keyglyph">::</span> <span class="varid">b</span>)</tt>, or</li> <li> <tt class='complex'><span class="conid">More</span> <span class="varid">a<sub>1</sub></span> (<span class="conid">Done</span> (<span class="varid">x</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>))</tt>, or</li> <li> <tt class='complex'><span class="conid">More</span> <span class="varid">a<sub>1</sub></span> (<span class="conid">More</span> <span class="varid">a<sub>2</sub></span> (<span class="conid">Done</span> (<span class="varid">x</span> <span class="keyglyph">::</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>)))</tt>, etc.</li> </ul><p>We either have just <tt><span class="varid">b</span></tt>, or an <tt><span class="varid">a</span></tt> and a function <tt class='complex'><span class="varid">a</span><span class="keyglyph">-&gt;</span><span class="varid">b</span></tt>, or two <tt><span class="varid">a</span></tt>s (i.e. <tt><span class="varid">a</span></tt><span class="math"><sup>2</sup></span>) and a function <tt class='complex'><span class="varid">a</span><sup>2</sup><span class="keyglyph">-&gt;</span><span class="varid">b</span></tt>, or <tt><span class="varid">a</span></tt><span class="math"><sup>3</sup></span> and <tt class='complex'><span class="varid">a</span><sup>3</sup><span class="keyglyph">-&gt;</span><span class="varid">b</span></tt>, etc. </p><p>A <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span></tt> is therefore a list of <tt><span class="varid">a</span></tt>s together with a function that takes <em>exactly</em> that number of <tt><span class="varid">a</span></tt>s to give you a <tt><span class="varid">b</span></tt>. Extracting the single represented <tt><span class="varid">b</span></tt> value is easy: </p><pre class="haskell"><span class="varid">getB</span> <span class="keyglyph">::</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="varid">getB</span> (<span class="conid">Done</span> <span class="varid">b</span>) <span class="keyglyph">=</span> <span class="varid">b</span> <span class="varid">getB</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span>) <span class="keyglyph">=</span> <span class="varid">getB</span> <span class="varid">z</span> <span class="varid">a</span> </pre><p>As is getting to the list of <tt><span class="varid">a</span></tt>s: </p><pre class="haskell"><span class="varid">getAs</span> <span class="keyglyph">::</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="varid">getAs</span> (<span class="conid">Done</span> <span class="varid">_</span>) <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">getAs</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span>) <span class="keyglyph">=</span> <span class="varid">a</span> <span class="listcon">:</span> <span class="varid">getAs</span> <span class="varid">z</span> </pre><p>But then things quickly get much trickier. Since a <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span></tt> holds exactly one <tt><span class="varid">b</span></tt>, we might ask how much access we have to it. First of, <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span></tt> is a Functor, so the <tt><span class="varid">b</span></tt> value can be changed: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Functor</span> (<span class="conid">FunList</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">fmap</span> <span class="varid">f</span> (<span class="conid">Done</span> <span class="varid">b</span>) <span class="keyglyph">=</span> <span class="conid">Done</span> (<span class="varid">f</span> <span class="varid">b</span>) <span class="varid">fmap</span> <span class="varid">f</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span>) <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="varid">fmap</span> (<span class="varid">f</span> <span class="varop">.</span>) <span class="varid">z</span>) </pre><p>The above case for <tt><span class="conid">More</span></tt> looks a bit strange, but remember that the data type is non-regular, so we recurse with a different function <tt><span class="varid">f</span></tt>. In this case instead of having type <tt class='complex'><span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span></tt> as the outer <tt><span class="varid">f</span></tt> does, we need something with type <tt class='complex'>(<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>)</tt>. </p><p>The <tt><span class="conid">Applicative</span></tt> instance is even stranger. There is a <tt><span class="varid">flip</span></tt> there, where the heck did that come from? </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Applicative</span> (<span class="conid">FunList</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">pure</span> <span class="keyglyph">=</span> <span class="conid">Done</span> <span class="conid">Done</span> <span class="varid">b</span> <span class="varop">&lt;*&gt;</span> <span class="varid">c</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">b</span> <span class="varid">c</span> <span class="comment">-- follows from Applicative laws</span> <span class="conid">More</span> <span class="varid">a</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="varid">c</span> <span class="keyglyph">=</span> <span class="conid">More</span> <span class="varid">a</span> (<span class="varid">flip</span> <span class="varop">&lt;\$&gt;</span> <span class="varid">z</span> <span class="varop">&lt;*&gt;</span> <span class="varid">c</span>) <span class="comment">-- flip??</span> </pre><p>Aside from manipulating the <tt><span class="varid">b</span></tt> value we can also do more list like things to the list of <tt><span class="varid">a</span></tt>s, such as zipping: </p><pre class="haskell"><span class="varid">zipFun</span> <span class="keyglyph">::</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> <span class="varid">c</span> <span class="varid">d</span> <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> (<span class="varid">a</span>,<span class="varid">c</span>) (<span class="varid">b</span>,<span class="varid">d</span>) <span class="varid">zipFun</span> (<span class="conid">Done</span> <span class="varid">b</span>) <span class="varid">d</span> <span class="keyglyph">=</span> <span class="conid">Done</span> (<span class="varid">b</span>,<span class="varid">getB</span> <span class="varid">d</span>) <span class="varid">zipFun</span> <span class="varid">b</span> (<span class="conid">Done</span> <span class="varid">d</span>) <span class="keyglyph">=</span> <span class="conid">Done</span> (<span class="varid">getB</span> <span class="varid">b</span>,<span class="varid">d</span>) <span class="varid">zipFun</span> (<span class="conid">More</span> <span class="varid">a</span> <span class="varid">b</span>) (<span class="conid">More</span> <span class="varid">c</span> <span class="varid">d</span>) <span class="keyglyph">=</span> <span class="conid">More</span> (<span class="varid">a</span>,<span class="varid">c</span>) (<span class="varid">applyPair</span> <span class="varop">&lt;\$&gt;</span> <span class="varid">zipFun</span> <span class="varid">b</span> <span class="varid">d</span>) <span class="keyword">where</span> <span class="varid">applyPair</span> (<span class="varid">f</span>,<span class="varid">g</span>) (<span class="varid">x</span>,<span class="varid">y</span>) <span class="keyglyph">=</span> (<span class="varid">f</span> <span class="varid">x</span>,<span class="varid">g</span> <span class="varid">y</span>) </pre><p>Surprisingly, the applicative operator defined above can be used as a kind of append, just look at the type: </p><pre>(&lt;*&gt;) :: FunList a (b -&gt; c) -&gt; FunList a b -&gt; FunList a c </pre><p>it takes two 'lists' and combines them into one. It is indeed true that <tt class='complex'><span class="varid">getAs</span> <span class="varid">a</span> <span class="varop">++</span> <span class="varid">getAs</span> <span class="varid">b</span> <span class="varop">==</span> <span class="varid">getAs</span> (<span class="varid">a</span> <span class="varop">&lt;*&gt;</span> <span class="varid">b</span>)</tt>. </p><p>This is as far as I got, so I will end this post with a couple of challenges: </p><ul><li> Show that <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span></tt> is a monad.</li> <li> Show that <tt class='complex'><span class="conid">FunList</span> <span class="varid">a</span></tt> is not a monad.</li> <li> Write a function <tt class='complex'><span class="varid">reverseFun</span> <span class="keyglyph">::</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">FunList</span> <span class="varid">a</span> <span class="varid">b</span></tt> that reverses a FunList, i.e. <tt class='complex'><span class="varid">getAs</span> <span class="varop">.</span> <span class="varid">reverseFun</span> <span class="varop">==</span> <span class="varid">reverse</span> <span class="varop">.</span> <span class="varid">getAs</span></tt>.</li> <li> Write a <span class="math">O(n)</span> reverse function.</li> </ul> Knight in n, part 4: tensors http://twanvl.nl/blog/haskell/Knight4 2008-12-09T23:00:00Z <p>Previously in this series: </p><ul><li> <a href="http://twanvl.nl/blog/haskell/Knight1">part 1: moves</a></li> <li> <a href="http://twanvl.nl/blog/haskell/Knight2">part 2: combinatorics</a></li> <li> <a href="http://twanvl.nl/blog/haskell/Knight3">part 3: rings</a></li> </ul><p>Welcome to the fourth installement of the <em>Knight in n</em> series. In part 3 we talked about the direct product of rings, and how they helped us solve the knight moves problem. This time yet another type of product is going to help in decomposing the algorithm to allow faster parts to be put in. </p><h2><a name="the-tensor-product-of-rings"></a>The tensor product of rings </h2> <p>In part three I introduced the direct product on rings, which is nothing more than a pair of numbers. Confusingly this operation is also called <a href="http://en.wikipedia.org/wiki/Direct_sum">direct <em>sum</em></a>. To illustrate this name, take the direct sum/product of <tt class='complex'><span class="conid">Array</span> <span class="varid">i</span> <span class="varid">a</span></tt> with <tt class='complex'><span class="conid">Array</span> <span class="varid">j</span> <span class="varid">b</span></tt>. For every index <tt><span class="varid">i</span></tt> (within the bounds of the first array) there is a value of type <tt><span class="varid">a</span></tt>, and for every index <tt><span class="varid">j</span></tt> there is a value of type <tt><span class="varid">b</span></tt>. Instead of a pair of arrays, this could also be implemented as a single array with the type <tt class='complex'><span class="conid">Array</span> (<span class="conid">Either</span> <span class="varid">i</span> <span class="varid">j</span>) (<span class="conid">Either</span> <span class="varid">a</span> <span class="varid">b</span>)</tt>. "Either" is just Haskell's way of saying "disjoint union" or "sum type", hence "direct <em>sum</em>". </p><p>There is another product operation that we can perform on two rings: the <a href="http://en.wikipedia.org/wiki/Tensor_product">tensor product</a>. Dually to the direct sum, the tensor product of <tt class='complex'><span class="conid">Array</span> <span class="varid">i</span> <span class="varid">a</span></tt> and <tt class='complex'><span class="conid">Array</span> <span class="varid">j</span> <span class="varid">b</span></tt> has type <tt class='complex'><span class="conid">Array</span> (<span class="varid">i</span>,<span class="varid">j</span>) (<span class="varid">a</span>,<span class="varid">b</span>)</tt>. The definition is very simple: the array contains all pairs where the first part comes from the first array, and the second part comes from the second array. </p><p>Slightly more generally, we can use any combining function. The general tensor product of two arrays can be implemented as: </p><pre class="haskell"><span class="varid">tensorWith</span> <span class="keyglyph">::</span> (<span class="conid">Ix</span> <span class="varid">i</span>, <span class="conid">Ix</span> <span class="varid">j</span>) <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Array</span> <span class="varid">i</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array</span> <span class="varid">j</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="varid">c</span> <span class="varid">tensorWith</span> <span class="varid">f</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">array</span> ((<span class="varid">a<sub>lo</sub></span>,<span class="varid">b<sub>lo</sub></span>),(<span class="varid">a<sub>hi</sub></span>,<span class="varid">b<sub>hi</sub></span>)) <span class="listcon">[</span> ((<span class="varid">i</span>,<span class="varid">j</span>), <span class="varid">f</span> <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">|</span> (<span class="varid">i</span>,<span class="varid">x</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">a</span>, (<span class="varid">j</span>,<span class="varid">y</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">b</span> <span class="listcon">]</span> <span class="keyword">where</span> (<span class="varid">a<sub>lo</sub></span>,<span class="varid">a<sub>hi</sub></span>) <span class="keyglyph">=</span> <span class="varid">bounds</span> <span class="varid">a</span> (<span class="varid">b<sub>lo</sub></span>,<span class="varid">b<sub>hi</sub></span>) <span class="keyglyph">=</span> <span class="varid">bounds</span> <span class="varid">b</span> </pre><p>Usually elements are multiplied: </p><pre class="haskell">(<span class="varop">&gt;&lt;</span>) <span class="keyglyph">::</span> (<span class="conid">Ix</span> <span class="varid">i</span>, <span class="conid">Ix</span> <span class="varid">j</span>, <span class="conid">Num</span> <span class="varid">a</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Array</span> <span class="varid">i</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array</span> <span class="varid">j</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Array</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="varid">a</span> (<span class="varop">&gt;&lt;</span>) <span class="keyglyph">=</span> <span class="varid">tensorWith</span> (<span class="varop">*</span>) </pre><p>The mathematical notation for this <tt class='complex'>(<span class="varop">&gt;&lt;</span>)</tt> operator is &otimes;. Now an example: Here we take two <span class="math">4</span>-element vectors, their tensor product has <span class="math">4*4=16</span> elements. The two vectors are "one dimensional<a href="#footnote-dimension" name="footnote-dimension-back">*</a>" objects, their tensor product is a "two dimensional" matrix. </p><p><img src='image/knight/tensor-product1.png'> </p><p>A special case we will use often is the tensor product of an array with itself: </p><pre class="haskell"><span class="varid">square</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">x</span> <span class="varop">&gt;&lt;</span> <span class="varid">x</span> </pre><p>For example (using <a href="http://twanvl.nl/blog/haskell/simple-reflection-of-expressions">simple reflection of expressions</a> which is now on hackage as <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/simple-reflect">Debug.SimpleReflect</a>): </p><pre class="ghci"><span class="input">Knight4&gt;</span> <span class="varid">square</span> (<span class="varid">listArray</span> (<span class="num">0</span>,<span class="num">2</span>) <span class="listcon">[</span><span class="varid">u</span>,<span class="varid">v</span>,<span class="varid">w</span><span class="listcon">]</span>) <span class="varid">listArray</span> ((<span class="num">0</span>,<span class="num">0</span>),(<span class="num">2</span>,<span class="num">2</span>)) <span class="listcon">[</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span>, <span class="varid">u</span><span class="varop">*</span><span class="varid">v</span>, <span class="varid">u</span><span class="varop">*</span><span class="varid">w</span> ,<span class="varid">v</span><span class="varop">*</span><span class="varid">u</span>, <span class="varid">v</span><span class="varop">*</span><span class="varid">v</span>, <span class="varid">v</span><span class="varop">*</span><span class="varid">w</span> ,<span class="varid">w</span><span class="varop">*</span><span class="varid">u</span>, <span class="varid">w</span><span class="varop">*</span><span class="varid">v</span>, <span class="varid">w</span><span class="varop">*</span><span class="varid">w</span><span class="listcon">]</span> </pre><h2><a name="interchange-law"></a>Interchange law </h2> <p>The tensor product and convolution operations satisfy the very useful <em>interchange law</em>: <img src='image/knight/tensor-interchange.png'> </p><p>!!!style="margin-top:.1em"!!!And since exponentiation is repeated convolution, also <img src='image/knight/tensor-interchange-exponent.png'> </p><p>For a proof sketch of this equation, compare the definitions of <tt class='complex'>(<span class="varop">&gt;&lt;</span>)</tt> and <tt><span class="varid">mulArray</span></tt>. Ignoring array bounds stuff, we have: </p><pre class="ghci"><span class="varid">convolution</span><span class="listcon">:</span> <span class="listcon">[</span> ( <strong><span class="varid">i</span><span class="varop">+</span><span class="varid">j</span></strong>, <span class="varid">x</span><span class="varop">*</span><span class="varid">y</span>) <span class="keyglyph">|</span> (<span class="varid">i</span>,<span class="varid">x</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">a</span>, (<span class="varid">j</span>,<span class="varid">y</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">b</span> <span class="listcon">]</span> <span class="varid">tensor</span> <span class="varid">product</span><span class="listcon">:</span> <span class="listcon">[</span> (<strong>(<span class="varid">i</span>,<span class="varid">j</span>)</strong>, <span class="varid">x</span><span class="varop">*</span><span class="varid">y</span>) <span class="keyglyph">|</span> (<span class="varid">i</span>,<span class="varid">x</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">a</span>, (<span class="varid">j</span>,<span class="varid">y</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">b</span> <span class="listcon">]</span> </pre><p>The only difference is in what happens to indices, with convolution the indices are added, with the tensor product a pair is formed. Now consider the interchange law. Informally, the indices of the left hand side are of the form <tt class='complex'>(<span class="varid">i<sub>a</sub></span>,<span class="varid">i<sub>b</sub></span>)<span class="varop">+</span>(<span class="varid">i<sub>c</sub></span>,<span class="varid">i<sub>d</sub></span>)</tt>, and on the right hand side <tt class='complex'>(<span class="varid">i<sub>a</sub></span><span class="varop">+</span><span class="varid">i<sub>c</sub></span>,<span class="varid">i<sub>b</sub></span><span class="varop">+</span><span class="varid">i<sub>d</sub></span>)</tt>. This corresponds exactly to the piecewise addition for <tt class='complex'><span class="conid">Num</span> (<span class="varid">α</span>,<span class="varid">β</span>)</tt>. </p><p>The interchange law is often exploited to perform faster convolutions. For example, consider blurring an image by taking the convolution with a Gaussian blur kernel: <br><img src="image/knight/convolution-blur1.png" alt="image*blur=blurred_image" style="margin-left:2em;margin-top:2px;"> <br>Performing this convolution requires <span class="math">O(n<sup>4</sup>)</span> operations for an <span class="math">n</span> by <span class="math">n</span> image. </p><p>The two dimensional Gaussian blur kernel can be written as the tensor product of two one dimensional kernels, with a bit algebra this gives: <br><img src="image/knight/convolution-blur2.png" alt="" style="margin-left:0;margin-top:2px;"> </p><p>So now to blur an image we can perform two convolution, first with the horizontal kernel, and then with the vertical one: <br><img src="image/knight/convolution-blur3.png" alt="image*blurH*blurV=blurred_image" style="margin-left:2em;margin-top:2px;"> <br>This procedure needs only <span class="math">O(n<sup>3</sup>)</span> operations. </p><h2><a name="back-to-business"></a>Back to business </h2> <p>Blurring images is not what we are trying to do. Instead of convolution with the Gaussian blur kernel, we are interested in convolution with <tt><span class="varid">moveMatrix</span></tt>. We could try the same trick, finding an <tt><span class="varid">a</span></tt> such that <tt class='complex'><span class="varid">moveMatrix</span> <span class="varop">==</span> <span class="varid">a</span> <span class="varop">&gt;&lt;</span> <span class="varid">a</span></tt>. Unfortunately, this is impossible. </p><p>But we can still get close, there <em>is</em> a way to write <tt class='complex'><span class="varid">moveMatrix</span> <span class="varop">==</span> <span class="varid">square</span> <span class="varid">a</span> <span class="varop">+</span> <span class="varid">square</span> <span class="varid">b</span></tt>, well, almost. Actually, what we have is: </p><pre class="ghci"><span class="num">2</span> <span class="varop">*</span> <span class="varid">moveMatrix</span> 0 2 0 2 0 1 1 0 1 1 1 -1 0 -1 1 2 0 0 0 2 1 1 0 1 1 -1 1 0 1 -1 == 0 0 0 0 0 == 0 0 0 0 0 - 0 0 0 0 0 == square a - square b 2 0 0 0 2 1 1 0 1 1 -1 1 0 1 -1 0 2 0 2 0 1 1 0 1 1 1 -1 0 -1 1 </pre><p>where </p><pre class="haskell"><span class="varid">a</span>,<span class="varid">b</span> <span class="keyglyph">::</span> <span class="conid">Array</span> <span class="conid">Int</span> <span class="conid">Integer</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">-2</span>,<span class="num">2</span>) <span class="listcon">[</span><span class="num">1</span>,<span class="num">1</span>,<span class="num">0</span>,<span class="num">1</span>,<span class="num">1</span><span class="listcon">]</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">-2</span>,<span class="num">2</span>) <span class="listcon">[</span><span class="num">1</span>,<span class="num">-1</span>,<span class="num">0</span>,<span class="num">-1</span>,<span class="num">1</span><span class="listcon">]</span> </pre><p>Now we can start with <tt><span class="varid">paths<sub>conv</sub></span></tt> from last time: </p><pre class="haskell"><span class="varid">paths<sub>conv</sub></span> <span class="varid">n</span> <span class="varid">ij</span> <span class="keyglyph">=</span> (<span class="varid">moveMatrix</span> <span class="varop">^</span> <span class="varid">n</span>) <span class="varop">`safeAt`</span> <span class="varid">ij</span> </pre><p>Where <tt><span class="varid">safeAt</span></tt> is a safe array indexing operator, that returns <tt><span class="num">0</span></tt> for indices that are out of bounds: </p><pre class="haskell"><span class="varid">safeAt</span> <span class="varid">ar</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">inRange</span> (<span class="varid">bounds</span> <span class="varid">ar</span>) <span class="varid">i</span> <span class="keyglyph">=</span> <span class="varid">ar</span> <span class="varop">!</span> <span class="varid">i</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="num">0</span> </pre><p>Now let's do some algebraic manipulation: </p><pre class="ghci"> <span class="varid">paths<sub>conv</sub></span> <span class="varid">n</span> <span class="varid">ij</span> <span class="keyglyph">=</span> <span class="comment">{- by definition of paths<sub>conv</sub> -}</span> (<span class="varid">moveMatrix</span> <span class="varop">^</span> <span class="varid">n</span>) <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="keyglyph">=</span> <span class="comment">{- by defintion of a and b -}</span> ((<span class="varid">square</span> <span class="varid">a</span> <span class="varop">-</span> <span class="varid">square</span> <span class="varid">b</span>) <span class="varop">`div`</span> <span class="num">2</span>)<span class="varop">^</span><span class="varid">n</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="comment">-- division by 2 is pseudocode</span> <span class="keyglyph">=</span> <span class="comment">{- division does not depend on the index -}</span> (<span class="varid">square</span> <span class="varid">a</span> <span class="varop">-</span> <span class="varid">square</span> <span class="varid">b</span>)<span class="varop">^</span><span class="varid">n</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> </pre><p>We still cannot apply the interchange law, because the exponentiation <tt class='complex'>(<span class="varop">^</span><span class="varid">n</span>)</tt> is applied to the difference of two tensor products and not a single one. We can, however, expand this exponentation by the formula: </p><pre class="ghci">(<span class="varid">a</span> <span class="varop">+</span> <span class="varid">b</span>)<span class="varop">^</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> </pre><p>This is just the usual <a href="http://en.wikipedia.org/wiki/Binomial_theorem">binomial expansion</a>, as in <img src='image/knight/binomial-expansion-2.png'> </p><p>Applying binomial expansion to our work-in-progress gives: </p><pre class="ghci"> (<span class="varid">square</span> <span class="varid">a</span> <span class="varop">-</span> <span class="varid">square</span> <span class="varid">b</span>)<span class="varop">^</span><span class="varid">n</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="comment">{- binomial expansion -}</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">square</span> <span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> (<span class="varop">-</span><span class="varid">square</span> <span class="varid">b</span>)<span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="comment">{- (-square b)^n<sub>b</sub> == (-1)^n<sub>b</sub> * square b^n<sub>b</sub> -}</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> (<span class="num">-1</span>)<span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="varop">*</span> <span class="varid">square</span> <span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">square</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="comment">{- interchange law -}</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> (<span class="num">-1</span>)<span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="varop">*</span> <span class="varid">square</span> (<span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span>) <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="comment">{- move `safeAt` inwards, since addition is pointwise -}</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> (<span class="num">-1</span>)<span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="varop">*</span> <span class="varid">square</span> (<span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span>) <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> </pre><h2><a name="fast-indexing"></a>Fast indexing </h2> <p>Since <tt class='complex'><span class="varid">square</span> <em><span class="varid">something</span></em></tt> already has <span class="math">n<sup>2</sup></span> elements and the loop is performed <span class="math">n+1</span> times, this algorithm still requires <span class="math">O(n<sup>3</sup>)</span> operations. </p><p>The only reason for calculating <tt class='complex'><span class="varid">square</span> (<span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span>)</tt> is because we need the element at index <tt><span class="varid">ij</span></tt>. So instead of constructing a whole array, let's just calculate that single element: </p><pre class="haskell"><span class="comment">-- square x `safeAt` ij == x `squareAt` ij</span> <span class="varid">x</span> <span class="varop">`squareAt`</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">x</span> <span class="varop">`safeAt`</span> <span class="varid">i</span> <span class="varop">*</span> <span class="varid">x</span> <span class="varop">`safeAt`</span> <span class="varid">j</span> </pre><p>So the inner part of the algorithm becomes: </p><pre class="ghci"> <span class="varid">square</span> (<span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span>) <span class="varop">`safeAt`</span> <span class="varid">ij</span> <span class="keyglyph">=</span> <span class="comment">{- property of squareAt -}</span> (<span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span> <span class="varop">*</span> <span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span>) <span class="varop">`squareAt`</span> <span class="varid">ij</span> </pre><p>We are still not there yet. Both <tt class='complex'><span class="varid">a</span><span class="varop">^</span><span class="varid">n<sub>a</sub></span></tt> and <tt class='complex'><span class="varid">b</span><span class="varop">^</span><span class="varid">n<sub>b</sub></span></tt> have <span class="math">O(n)</span> elements, so just calculating their convolution takes <span class="math">O(n<sup>2</sup>)</span> work. But again, we need only two elements of the convolution, so we can define: </p><pre class="haskell"><span class="comment">-- a * b `safeAt` i == mulArrayAt a b i</span> <span class="varid">mulArrayAt</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">x</span> <span class="varop">*</span> <span class="varid">b</span> <span class="varop">`safeAt`</span> (<span class="varid">n</span><span class="varop">-</span><span class="varid">i</span>) <span class="keyglyph">|</span> (<span class="varid">i</span>,<span class="varid">x</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">a</span> <span class="listcon">]</span> </pre><p>And update <tt><span class="varid">squareAt</span></tt> accordingly: </p><pre class="haskell"><span class="varid">mulSquareAt</span> <span class="varid">a</span> <span class="varid">b</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">mulArrayAt</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">i</span> <span class="varop">*</span> <span class="varid">mulArrayAt</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">j</span> </pre><p>Finally we need a more efficient way to calculate all the powers of <tt><span class="varid">a</span></tt> and <tt><span class="varid">b</span></tt>. The <tt><span class="varid">iterate</span></tt> function can help us with that: </p><pre class="ghci"><span class="input">Knight4&gt;</span> <span class="varid">iterate</span> (<span class="varop">*</span><span class="varid">u</span>) <span class="num">1</span> <span class="listcon">[</span><span class="num">1</span>, <span class="num">1</span><span class="varop">*</span><span class="varid">u</span>, <span class="num">1</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span>, <span class="num">1</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span>, <span class="num">1</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span><span class="varop">*</span><span class="varid">u</span>, <span class="varop">...</span> </pre><p>Putting the pieces together gives a <span class="math">O(n<sup>2</sup>)</span> algorithm for the knight moves problem: </p><pre class="haskell"><span class="varid">paths<sub>tensor</sub></span> <span class="varid">n</span> <span class="varid">ij</span> <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span> <span class="varop">*</span> (<span class="num">-1</span>)<span class="varop">^</span><span class="varid">n<sub>b</sub></span> <span class="varop">*</span> <span class="varid">mulSquareAt</span> (<span class="varid">powers_of_a</span> <span class="varop">!!</span> <span class="varid">n<sub>a</sub></span>) (<span class="varid">powers_of_b</span> <span class="varop">!!</span> <span class="varid">n<sub>b</sub></span>) <span class="varid">ij</span> <span class="keyglyph">|</span> (<span class="varid">n<sub>a</sub></span>,<span class="varid">n<sub>b</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> <span class="varop">`div`</span> <span class="num">2</span><span class="varop">^</span><span class="varid">n</span> <span class="keyword">where</span> <span class="varid">powers_of_a</span> <span class="keyglyph">=</span> <span class="varid">iterate</span> (<span class="varop">*</span><span class="varid">a</span>) <span class="num">1</span> <span class="varid">powers_of_b</span> <span class="keyglyph">=</span> <span class="varid">iterate</span> (<span class="varop">*</span><span class="varid">b</span>) <span class="num">1</span> </pre><p>Note that the savings we have made do not come directly from decomposing the <tt><span class="varid">moveMatrix</span></tt>. It is just that this decomposition allows us to see that we are computing all elements of am expensive product where a single one would do. </p><p>This post brings another order of improvement. Do you think you can do better than <span class="math">O(n<sup>2</sup>)</span> time and <span class="math">O(n<sup>2</sup>)</span> space complexity? If so I would like to hear. </p><p><br><a name="footnote-dimension" href="#footnote-dimension-back">*</a>: The number of elements is often called the dimension of a vector. Here we use the term dimension to refer to the number of indices used, also known as the <a href="http://en.wikipedia.org/wiki/Tensor_order#Tensor_rank">(tensor) order</a>. So a <span class="math">100*100</span> pixel image has dimension <span class="math">10000</span> according to the first interpretation (the number of elements), but dimension two in the second interpretation (the number of indices). </p> Knight in n, part 3: rings http://twanvl.nl/blog/haskell/Knight3 2008-12-03T23:00:00Z <p>Previously in this series: </p><ul><li> <a href="http://twanvl.nl/blog/haskell/Knight1">part 1: moves</a></li> <li> <a href="http://twanvl.nl/blog/haskell/Knight2">part 2: combinatorics</a></li> </ul><p>In this third installment, we will look at how to use various types as numbers, i.e. how to make them an instance of the <tt><span class="conid">Num</span></tt> type class. The solution the Knight-moves-problem will emerge at the end, almost as if by magic. <span class="math">:)</span> </p><h2><a name="tangent-things-as-numbers"></a>Tangent: Things as numbers </h2> <p>Many types can be used as if they are numbers. Haskell-wise this means they can be an instance of the <tt><span class="conid">Num</span></tt> type class. Mathematically it means that these types are <a href="http://en.wikipedia.org/wiki/Ring_(algebra)">rings</a>. </p><h2><a name="pairs-as-numbers"></a>Pairs as numbers </h2> <p>Let's start with a <tt><span class="conid">Num</span></tt> instance for pairs <tt class='complex'>(<span class="varid">α</span>,<span class="varid">β</span>)</tt>. In general, our only choice is to do everything pointwise. So for all operations &otimes; (i.e. <tt class='complex'>(<span class="varop">+</span>)</tt>, <tt class='complex'>(<span class="varop">-</span>)</tt> and <tt class='complex'>(<span class="varop">*</span>)</tt>: </p><p><img src='image/knight/pointwise_tuple.png'> </p><p>In ring theory this is called the <a href="http://en.wikipedia.org/wiki/Direct_product_(ring_theory)"><em>direct product</em></a>. In Haskell we can write it as: </p><pre class="haskell"><span class="keyword">instance</span> (<span class="conid">Num</span> <span class="varid">α</span>, <span class="conid">Num</span> <span class="varid">β</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Num</span> (<span class="varid">α</span>,<span class="varid">β</span>) <span class="keyword">where</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varop">+</span> (<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> (<span class="varid">a</span><span class="varop">+</span><span class="varid">c</span>,<span class="varid">b</span><span class="varop">+</span><span class="varid">d</span>) (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varop">-</span> (<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> (<span class="varid">a</span><span class="varop">-</span><span class="varid">c</span>,<span class="varid">b</span><span class="varop">-</span><span class="varid">d</span>) (<span class="varid">a</span>,<span class="varid">b</span>) <span class="varop">*</span> (<span class="varid">c</span>,<span class="varid">d</span>) <span class="keyglyph">=</span> (<span class="varid">a</span><span class="varop">*</span><span class="varid">c</span>,<span class="varid">b</span><span class="varop">*</span><span class="varid">d</span>) <span class="varid">fromInteger</span> <span class="varid">i</span> <span class="keyglyph">=</span> (<span class="varid">fromInteger</span> <span class="varid">i</span>, <span class="varid">fromInteger</span> <span class="varid">i</span>) <span class="varid">abs</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> (<span class="varid">abs</span> <span class="varid">a</span>, <span class="varid">abs</span> <span class="varid">b</span>) <span class="varid">signum</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">=</span> (<span class="varid">signum</span> <span class="varid">a</span>, <span class="varid">signum</span> <span class="varid">b</span>) </pre><p>We could also make instances for triples, quadruples and other tuples this way, but those are not needed for the rest of the story. </p><h2><a name="arrays-as-numbers"></a>Arrays as numbers </h2> <p>A more general kind of tuple is an array; which is somewhat like a tuple of arbitrary size. Of course, that is not quite true, since two arrays with the same type can have a <em>different</em> size. One way around this problem is to treat all arrays as if they are infinite, by taking values outside the bounds to be equal to <span class="math">0</span>. So </p><pre class="ghci"><span class="comment">-- EXAMPLE</span> <span class="varid">listArray</span> (<span class="num">0</span>,<span class="num">0</span>) <span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span> <span class="varop">==</span> <span class="varid">listArray</span> (<span class="varop">-</span>&infin;,&infin;) <span class="listcon">[</span><span class="listcon">..</span>,<span class="num">0</span>,<span class="num">0</span>,<span class="num">1</span>,<span class="num">0</span>,<span class="num">0</span>,<span class="listcon">..</span><span class="listcon">]</span> <span class="comment">-- pseudocode</span> </pre><p>That way we can still do addition pointwise, <img src='image/knight/pointwise_add_array.png'> </p><p>The <tt><span class="varid">accumArray</span></tt> function can help with the missing elements by setting them to <tt><span class="num">0</span></tt> by default: </p><pre class="haskell"><span class="varid">addArray</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">accumArray</span> (<span class="varop">+</span>) <span class="num">0</span> (<span class="varid">min</span> <span class="varid">a<sub>lo</sub></span> <span class="varid">b<sub>lo</sub></span>, <span class="varid">max</span> <span class="varid">a<sub>hi</sub></span> <span class="varid">b<sub>hi</sub></span>) (<span class="varid">assocs</span> <span class="varid">a</span> <span class="varop">++</span> <span class="varid">assocs</span> <span class="varid">b</span>) <span class="keyword">where</span> (<span class="varid">a<sub>lo</sub></span>,<span class="varid">a<sub>hi</sub></span>) <span class="keyglyph">=</span> <span class="varid">bounds</span> <span class="varid">a</span> (<span class="varid">b<sub>lo</sub></span>,<span class="varid">b<sub>hi</sub></span>) <span class="keyglyph">=</span> <span class="varid">bounds</span> <span class="varid">b</span> </pre><p>Next up is the <tt><span class="varid">fromInteger</span></tt> function. <tt class='complex'><span class="varid">fromInteger</span> <span class="num">0</span></tt> is easy; there are two options for other values </p><p>.# <tt class='complex'><span class="varid">fromInteger</span> <span class="varid">i</span></tt> is an infinite array of values <tt><span class="varid">i</span></tt>. .# <tt class='complex'><span class="varid">fromInteger</span> <span class="varid">i</span></tt> is an array with values <tt><span class="varid">i</span></tt> at some single point. </p><p>The first choice mimics the definition for tuples, <tt class='complex'><span class="varid">fromInteger</span> <span class="varid">i</span> <span class="keyglyph">=</span> (<span class="varid">fromInteger</span> <span class="varid">i</span>, <span class="varid">fromInteger</span> <span class="varid">i</span>)</tt>. But for arrays this has the slight problem of requiring an infinite array. For the second alternative we need to pick the index where to put the number <tt><span class="varid">i</span></tt>. The obvious choice is to put <tt><span class="varid">i</span></tt> at 'the origin', index <tt><span class="num">0</span></tt>: </p><pre class="haskell"><span class="varid">intArray</span> <span class="varid">i</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">0</span>,<span class="num">0</span>) <span class="listcon">[</span><span class="varid">fromInteger</span> <span class="varid">i</span><span class="listcon">]</span> </pre><p>Finally, multiplication. As you have learned in school, multiplication can be seen as repeated addition, In our Haskell world that means that we expect the law <tt class='complex'><span class="varid">a</span> <span class="varop">+</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">fromInteger</span> <span class="num">2</span> <span class="varop">*</span> <span class="varid">a</span></tt> to hold. </p><p>If we had used the first choice for <tt><span class="varid">fromInteger</span></tt> then multiplication could be done pointwise as it was for tuples. But we have made a different choice, so now <tt class='complex'><span class="varid">fromInteger</span> <span class="num">2</span></tt> is an array that contains the value <tt><span class="num">2</span></tt> at index <tt><span class="num">0</span></tt> (and is implicitly zero everywhere else). When calculating <tt class='complex'><span class="varid">fromInteger</span> <span class="num">2</span> <span class="varop">*</span> <span class="varid">a</span></tt>, this <tt><span class="num">2</span></tt> should by multiplied with <em>all</em> elements of the array <tt><span class="varid">a</span></tt>. </p><p>The operation that does the right thing is <a href="http://en.wikipedia.org/wiki/Convolution"><em>convolution</em></a>. It looks like this: </p><p><img src='image/knight/pointwise_mul_array.png'> </p><p>So for each element <tt><span class="varid">v</span></tt> at index <tt><span class="varid">i</span></tt> in the first array, we shift a copy of the second array so that its origin becomes <tt><span class="varid">i</span></tt>. This copy is multiplied by <tt><span class="varid">v</span></tt> and all these copies are added. If one of the arrays is <tt class='complex'><span class="varid">fromInteger</span> <span class="varid">v</span></tt> (i.e. a scalar), then this corresponds to multiplying all elements in the other array by <tt><span class="varid">v</span></tt>; exactly what we wanted. </p><p>Convolution can be implemented with <tt><span class="varid">accumArray</span></tt> as: </p><pre class="haskell"><span class="varid">mulArray</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">accumArray</span> (<span class="varop">+</span>) <span class="num">0</span> (<span class="varid">bounds</span> <span class="varid">a</span> <span class="varop">+</span> <span class="varid">bounds</span> <span class="varid">b</span>) <span class="listcon">[</span> (<span class="varid">i</span><span class="varop">+</span><span class="varid">j</span>, <span class="varid">x</span><span class="varop">*</span><span class="varid">y</span>) <span class="keyglyph">|</span> (<span class="varid">i</span>,<span class="varid">x</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">a</span>, (<span class="varid">j</span>,<span class="varid">y</span>) <span class="keyglyph">&lt;-</span> <span class="varid">assocs</span> <span class="varid">b</span> <span class="listcon">]</span> </pre><p>Notice that we use the <tt class='complex'><span class="conid">Num</span> (<span class="varid">α</span>,<span class="varid">β</span>)</tt> instance for the bounds, and that this definition is nicely symmetrical. </p><p>Putting it all together, we get the following instance: </p><pre class="haskell"><span class="keyword">instance</span> (<span class="conid">Ix</span> <span class="varid">i</span>, <span class="conid">Num</span> <span class="varid">i</span>, <span class="conid">Num</span> <span class="varid">a</span>) <span class="keyglyph">=&gt;</span> <span class="conid">Num</span> (<span class="conid">Array</span> <span class="varid">i</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="varid">fromInteger</span> <span class="keyglyph">=</span> <span class="varid">intArray</span> (<span class="varop">+</span>) <span class="keyglyph">=</span> <span class="varid">addArray</span> (<span class="varop">*</span>) <span class="keyglyph">=</span> <span class="varid">mulArray</span> <span class="varid">negate</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">negate</span> <span class="varid">abs</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">abs</span> <span class="varid">signum</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">signum</span> </pre><p>In mathematical terms, what we constructed here is called a <a href="http://en.wikipedia.org/wiki/Group_ring"><em>group ring</em></a>. There is a group ring <span class="math">G[R]</span> for any group <span class="math">G</span> and ring <span class="math">R</span>, which corresponds to an instance <tt class='complex'><span class="conid">Num</span> (<span class="conid">Array</span> <span class="varid">g</span> <span class="varid">r</span>)</tt> when <tt><span class="varid">g</span></tt> is a group (i.e. an instance of <tt><span class="conid">Num</span></tt>) and <tt><span class="varid">r</span></tt> is a ring (also an instance of <tt><span class="conid">Num</span></tt>). </p><h2><a name="arrays-as-polynomials"></a>Arrays as polynomials </h2> <p>Another way to interpret the above instance, is by treating arrays as polynomials over some variable <span class="math">x</span>. The array <tt class='complex'><span class="varid">array</span> <span class="listcon">[</span>(<span class="varid">i</span>,<span class="varid">a</span>),(<span class="varid">j</span>,<span class="varid">b</span>),(<span class="varid">k</span>,<span class="varid">c</span>),<span class="listcon">..</span><span class="listcon">]</span></tt> then represents the polynomial <span class="math">ax<sup>i</sup>+bx<sup>j</sup>+cx<sup>k</sup>+...</span>. The addition and multiplication defined above now have the expected meaning, for example: </p><pre class="ghci"><span class="input">&gt; </span><span class="keyword">let</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">0</span>,<span class="num">2</span>) <span class="listcon">[</span><span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span> <span class="comment">-- 2 + 3x + 4x^2</span> <span class="input">&gt; </span><span class="keyword">let</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">1</span>,<span class="num">2</span>) <span class="listcon">[</span><span class="num">5</span>,<span class="num">6</span><span class="listcon">]</span> <span class="comment">-- 5x + 6x^2</span> <span class="input">&gt; </span><span class="varid">a</span> <span class="varop">+</span> <span class="varid">b</span> <span class="varid">array</span> (<span class="num">0</span>,<span class="num">2</span>) <span class="listcon">[</span>(<span class="num">0</span>,<span class="num">2</span>),(<span class="num">1</span>,<span class="num">8</span>),(<span class="num">2</span>,<span class="num">10</span>)<span class="listcon">]</span> <span class="comment">-- 2 + 8x + 10x^2</span> <span class="input">&gt; </span><span class="varid">a</span> <span class="varop">*</span> <span class="varid">b</span> <span class="varid">array</span> (<span class="num">1</span>,<span class="num">4</span>) <span class="listcon">[</span>(<span class="num">1</span>,<span class="num">10</span>),(<span class="num">2</span>,<span class="num">27</span>),(<span class="num">3</span>,<span class="num">38</span>),(<span class="num">4</span>,<span class="num">24</span>)<span class="listcon">]</span> <span class="comment">-- 10x + 27x^2 + 38x^3 + 24x^4</span> </pre><p>We can make this even more suggestive by defining: </p><pre class="haskell"><span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">1</span>,<span class="num">1</span>) <span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span> </pre><pre class="ghci"><span class="input">&gt; </span>(<span class="num">2</span> <span class="varop">+</span> <span class="num">3</span><span class="varop">*</span><span class="varid">x</span> <span class="varop">+</span> <span class="num">4</span><span class="varop">*</span><span class="varid">x</span><span class="varop">^</span><span class="num">2</span>) <span class="varop">*</span> (<span class="num">5</span><span class="varop">*</span><span class="varid">x</span> <span class="varop">+</span> <span class="num">6</span><span class="varop">*</span><span class="varid">x</span><span class="varop">^</span><span class="num">2</span>) <span class="varop">==</span> <span class="num">10</span><span class="varop">*</span><span class="varid">x</span> <span class="varop">+</span> <span class="num">27</span><span class="varop">*</span><span class="varid">x</span><span class="varop">^</span><span class="num">2</span> <span class="varop">+</span> <span class="num">38</span><span class="varop">*</span><span class="varid">x</span><span class="varop">^</span><span class="num">3</span> <span class="varop">+</span> <span class="num">24</span><span class="varop">*</span><span class="varid">x</span><span class="varop">^</span><span class="num">4</span> <span class="conid">True</span> </pre><p>If you are interested in this interpretation, sigfpe wrote <a href="http://sigfpe.blogspot.com/2007/11/small-combinatorial-library.html">an interesting blog post</a> about convolutions, polynomials and power series. </p><h2><a name="it-s-magic-"></a>It's magic! </h2> <p>Now, let's go back to our original problem, the moves of a chess knight. </p><p>The positions reachable in a single move can be put into a two dimensional array (i.e. a matrix). </p><pre class="haskell"><span class="varid">moveMatrix</span> <span class="keyglyph">::</span> <span class="conid">Array</span> (<span class="conid">Int</span>,<span class="conid">Int</span>) <span class="conid">Integer</span> <span class="varid">moveMatrix</span> <span class="keyglyph">=</span> <span class="varid">accumArray</span> (<span class="varop">+</span>) <span class="num">0</span> ((<span class="num">-2</span>,<span class="num">-2</span>),(<span class="num">2</span>,<span class="num">2</span>)) <span class="listcon">[</span> (<span class="varid">m</span>,<span class="num">1</span>) <span class="keyglyph">|</span> <span class="varid">m</span> <span class="keyglyph">&lt;-</span> <span class="varid">moves</span> <span class="listcon">]</span> </pre><p>This is the familiar <em>move matrix</em>, which we already saw in part 1. </p><pre class="ghci"><span class="input">Knight3&gt;</span> <span class="varid">printMatrix</span> <span class="varid">moveMatrix</span> 0 1 0 1 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 1 0 1 0 </pre><p>Now the magic. We defined multiplication of two arrays <tt><span class="varid">a</span></tt> and <tt><span class="varid">b</span></tt> as adding copies of <tt><span class="varid">b</span></tt> for each value in <tt><span class="varid">a</span></tt>. If we use the move matrix as <tt><span class="varid">b</span></tt>, then this means we add all possible destinations of a knight making one move from each place it can reach. Repeating this <span class="math">n</span> times gives us our answer. Since repeated multiplication is exponentiation: </p><pre class="haskell"><span class="varid">allPaths<sub>conv</sub></span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">moveMatrix</span> <span class="varop">^</span> <span class="varid">n</span> </pre><p>For example, for <span class="math">n=2</span>:<br> <img src="image/knight/convolution2.png" alt="moveMatrix * moveMatrix" style="margin-left:2em;"> </p><p>If we are interested in just a single point there is the array indexing operator (!!) to help us, </p><pre class="haskell"><span class="varid">paths<sub>conv</sub></span> <span class="varid">n</span> <span class="varid">ij</span> <span class="keyglyph">|</span> <span class="varid">inRange</span> (<span class="varid">bounds</span> <span class="varid">m</span>) <span class="varid">ij</span> <span class="keyglyph">=</span> <span class="varid">m</span> <span class="varop">!</span> <span class="varid">ij</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="keyword">where</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="varid">allPaths<sub>conv</sub></span> <span class="varid">n</span> </pre><p>This convolutional algorithm can count the number of paths in <span class="math">O(n<sup>3</sup>)</span>, but not just for a single end point, but for <em>all</em> end points at once! The program is also a lot simpler than the </p><p>The <tt><span class="varid">paths<sub>conv</sub></span></tt> algorithm is pretty good, but we can <em>still</em> do better. Next time I will show how the algorithm from part 3 can be improved further, and curiously, how it will start to look more like the algorithm from part 2. </p> Knight in n, part 2: combinatorics http://twanvl.nl/blog/haskell/Knight2 2008-11-30T23:00:00Z <p>Previously in this series: </p><ul><li> <a href="http://twanvl.nl/blog/haskell/Knight1">part 1: moves</a></li> </ul><p>In my previous post I introduced the 'knight moves problem': How many ways are there for a chess knight to reach cell <span class="math">(i,j)</span> in exactly <span class="math">n</span> moves? The recursive solution from last time is horribly inefficient for larger values of <span class="math">n</span>. Today I will show some more efficient solutions. </p><h2><a name="ignoring-the-order-of-moves"></a>Ignoring the order of moves </h2> <p>If the knight first makes a move <span class="math">(-1,2)</span> and then a move <span class="math">(2,1)</span> it will end up at <span class="math">(1,3)</span>. If it first moves <span class="math">(2,1)</span> and then <span class="math">(-1,2)</span> it will also end up at <span class="math">(1,3)</span>. So, the order in which the moves happen does not matter for the final position! We can exploit this fact to make a faster program. Instead of determining what move to make at each step, we can count how many moves we make of each type and then determine in how many different orders these moves can be performed. </p><p>Denote by <tt><span class="varid">n<sub>1</sub></span></tt> the number of moves of the first type, <tt><span class="varid">n<sub>123</sub></span></tt> the number of moves of type 1, 2 or 3, etc. So <tt class='complex'><span class="varid">n<sub>1234</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>1</sub></span><span class="varop">+</span><span class="varid">n<sub>2</sub></span><span class="varop">+</span><span class="varid">n<sub>3</sub></span><span class="varop">+</span><span class="varid">n<sub>4</sub></span></tt>, and since there are eight different moves, <tt class='complex'><span class="varid">n<sub>12345678</sub></span> <span class="keyglyph">=</span> <span class="varid">n</span></tt>. A count <tt><span class="varid">n<sub>ab</sub></span></tt> can be <em>split</em> into <tt class='complex'><span class="varid">n<sub>a</sub></span><span class="varop">+</span><span class="varid">n<sub>b</sub></span></tt> in several ways, for now we will consider all possibilities: </p><pre class="haskell"><span class="varid">split</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="listcon">[</span> (<span class="varid">i</span>,<span class="varid">n</span><span class="varop">-</span><span class="varid">i</span>) <span class="keyglyph">|</span> <span class="varid">i</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="varid">n</span><span class="listcon">]</span> <span class="listcon">]</span> </pre><p>So for example, <tt class='complex'><span class="varid">split</span> <span class="num">3</span> <span class="keyglyph">=</span> <span class="listcon">[</span>(<span class="num">0</span>,<span class="num">3</span>),(<span class="num">1</span>,<span class="num">2</span>),(<span class="num">2</span>,<span class="num">1</span>),(<span class="num">3</span>,<span class="num">0</span>)<span class="listcon">]</span></tt>. </p><p>By repeatedly splitting <tt><span class="varid">n</span></tt> we arrive at: </p><pre class="haskell"><span class="varid">paths<sub>split</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> <span class="keyword">let</span> <span class="varid">n<sub>12345678</sub></span> <span class="keyglyph">=</span> <span class="varid">n</span> (<span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2345678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12345678</sub></span> (<span class="varid">n<sub>2</sub></span>,<span class="varid">n<sub>345678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>2345678</sub></span> (<span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>45678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>345678</sub></span> (<span class="varid">n<sub>4</sub></span>,<span class="varid">n<sub>5678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>45678</sub></span> (<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">n<sub>6</sub></span>,<span class="varid">n<sub>78</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>678</sub></span> (<span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>78</sub></span> <span class="keyword">let</span> <span class="varid">counts</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>,<span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span>,<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>,<span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span> <span class="varid">guard</span> <span class="varop">\$</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="varop">==</span> <span class="varid">destination</span> <span class="varid">counts</span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="varid">counts</span> </pre><p>Here we only keep sequences of moves that end up in <span class="math">(i,j)</span>, as determined by the <tt><span class="varid">destination</span></tt> function: </p><pre class="haskell"><span class="varid">destination</span> <span class="varid">counts</span> <span class="keyglyph">=</span> (<span class="varid">sum</span> <span class="varid">hs</span>, <span class="varid">sum</span> <span class="varid">vs</span>) <span class="keyword">where</span> (<span class="varid">hs</span>,<span class="varid">vs</span>) <span class="keyglyph">=</span> <span class="varid">unzip</span> <span class="listcon">[</span> (<span class="varid">n</span><span class="varop">*</span><span class="varid">δ<sub>i</sub></span>,<span class="varid">n</span><span class="varop">*</span><span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">|</span> (<span class="varid">n</span>,(<span class="varid">δ<sub>i</sub></span>,<span class="varid">δ<sub>j</sub></span>)) <span class="keyglyph">&lt;-</span> <span class="varid">zip</span> <span class="varid">counts</span> <span class="varid">moves</span> <span class="listcon">]</span> </pre><p>Next, we need to know how many different paths can be formed with a particular set of moves. You might remember <a href="http://en.wikipedia.org/wiki/Binomial_coefficient">binomial coefficients</a> from high school, which give the number of ways to pick <span class="math">k</span> items from a set of size <span class="math">n</span>: <img src="image/knight/multinomial-2-1-1.png" alt="multinomial [2,1,1]" style="float:right;margin-left:1em;border:1px solid #aaa;"> </p><p><img src='image/knight/binomial.png'> </p><p>If we take <span class="math">n</span> equal to <span class="math">m+k</span> we get the number of different lists containing exactly <span class="math">k</span> red balls and <span class="math">m</span> green balls. Or put differently, the number of different paths containing <span class="math">k</span> moves of the first type and <span class="math">m</span> moves of the second type. This interpretation of binomial coefficients can be generalized two more than two types, giving <em>multinomial coefficients</em>. These are exactly what we need to determine the number of paths given the counts of each type of move: </p><pre class="haskell"><span class="varid">multinomial</span> <span class="varid">xs</span> <span class="keyglyph">|</span> <span class="varid">any</span> (<span class="varop">&lt;</span> <span class="num">0</span>) <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">multinomial</span> <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="varid">factorial</span> (<span class="varid">sum</span> <span class="varid">xs</span>) <span class="varop">`div`</span> <span class="varid">product</span> (<span class="varid">map</span> <span class="varid">factorial</span> <span class="varid">xs</span>) </pre><p>This multinomial function requires calculating a lot of factorials, to make this as fast as possible they should be stored in an <a href="http://twanvl.nl/blog/haskell/UnboundedArray">'array'</a>: </p><pre class="haskell"><span class="varid">factorial</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Integer</span> <span class="varid">factorial</span> <span class="keyglyph">=</span> <span class="varid">unboundedArray</span> <span class="varop">\$</span> <span class="varid">scanl</span> (<span class="varop">*</span>) <span class="num">1</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="listcon">]</span> </pre><p>Calculating <tt><span class="varid">paths<sub>split</sub></span></tt> only takes <span class="math">O(n<sup>7</sup>)</span> integer operations, since each <tt><span class="varid">split</span></tt> effectively costs a factor <tt><span class="varid">n</span></tt>. While this is better than the previous result, it is still not satisfactory. </p><h2><a name="solving-the-guard-condition"></a>Solving the guard condition </h2> <p>The above function uses a "generate and test" approach: Generate all possibilities and test which ones reach the destination. It would be more efficient to generate <em>only</em> those possibilities. </p><p>Algebraic reasoning can help us here. Let's start by expanding the condition in the <tt><span class="varid">guard</span></tt> statement: </p><pre class="ghci"> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="varop">==</span> <span class="varid">destination</span> <span class="varid">counts</span> <span class="keyglyph">=</span> <span class="comment">{- by definition of destination -}</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="varop">==</span> (<span class="varid">sum</span> <span class="varid">hs</span>, <span class="varid">sum</span> <span class="varid">vs</span>) <span class="keyword">where</span> (<span class="varid">hs</span>,<span class="varid">vs</span>) <span class="keyglyph">=</span> <span class="varid">unzip</span> <span class="listcon">[</span> (<span class="varid">n</span><span class="varop">*</span><span class="varid">δ<sub>i</sub></span>,<span class="varid">n</span><span class="varop">*</span><span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">|</span> (<span class="varid">n</span>,(<span class="varid">δ<sub>i</sub></span>,<span class="varid">δ<sub>j</sub></span>)) <span class="keyglyph">&lt;-</span> <span class="varid">zip</span> <span class="varid">counts</span> <span class="varid">moves</span> <span class="listcon">]</span> <span class="keyglyph">=</span> <span class="comment">{- expand unzip and simplify -}</span> <span class="varid">i</span> <span class="varop">==</span> <span class="varid">sum</span> (<span class="varid">zipWith</span> (<span class="varop">*</span>) <span class="varid">counts</span> (<span class="varid">map</span> <span class="varid">fst</span> <span class="varid">moves</span>) <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="varop">==</span> <span class="varid">sum</span> (<span class="varid">zipWith</span> (<span class="varop">*</span>) <span class="varid">counts</span> (<span class="varid">map</span> <span class="varid">snd</span> <span class="varid">moves</span>) <span class="keyglyph">=</span> <span class="comment">{- by definition of moves (see previous post) -}</span> <span class="varid">i</span> <span class="varop">==</span> <span class="varid">sum</span> (<span class="varid">zipWith</span> (<span class="varop">*</span>) <span class="varid">counts</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">2</span>,<span class="num">-2</span>,<span class="num">-2</span>,<span class="num">1</span>,<span class="num">-1</span>,<span class="num">1</span>,<span class="num">-1</span><span class="listcon">]</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="varop">==</span> <span class="varid">sum</span> (<span class="varid">zipWith</span> (<span class="varop">*</span>) <span class="varid">counts</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">-1</span>,<span class="num">1</span>,<span class="num">-1</span>,<span class="num">2</span>,<span class="num">2</span>,<span class="num">-2</span>,<span class="num">-2</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="comment">{- expanding the sum and product, remember n<sub>12</sub> = n<sub>1</sub>+n<sub>2</sub>, etc. -}</span> <span class="varid">i</span> <span class="varop">==</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span> <span class="varop">+</span> <span class="varid">n<sub>57</sub></span> <span class="varop">-</span> <span class="varid">n<sub>68</sub></span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="varop">==</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>56</sub></span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>78</sub></span> <span class="varop">+</span> <span class="varid">n<sub>13</sub></span> <span class="varop">-</span> <span class="varid">n<sub>24</sub></span> <span class="keyglyph">=</span> <span class="comment">{- reordering -}</span> <span class="varid">n<sub>57</sub></span> <span class="varop">-</span> <span class="varid">n<sub>68</sub></span> <span class="varop">==</span> <span class="varid">i</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span> <span class="varop">&amp;&amp;</span> <span class="varid">n<sub>13</sub></span> <span class="varop">-</span> <span class="varid">n<sub>24</sub></span> <span class="varop">==</span> <span class="varid">j</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>56</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>78</sub></span> </pre><p>These are equations we can work with. Take the equation involving <tt><span class="varid">i</span></tt>. We know that <tt class='complex'><span class="varid">n<sub>57</sub></span> <span class="varop">+</span> <span class="varid">n<sub>68</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>5678</sub></span></tt>, and that <tt class='complex'><span class="varid">n<sub>57</sub></span> <span class="varop">-</span> <span class="varid">n<sub>68</sub></span> <span class="varop">==</span> <span class="varid">i</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span></tt>. From these two equations, we can solve for <tt><span class="varid">n<sub>57</sub></span></tt> and <tt><span class="varid">n<sub>68</sub></span></tt>, without needing an expensive <tt><span class="varid">split</span></tt>: </p><pre class="haskell"><span class="comment">-- | find a and b such that a+b == c, a-b == d, a,b &gt;= 0</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">c</span> <span class="varid">d</span> <span class="keyglyph">|</span> <span class="varid">ok</span> <span class="varop">==</span> <span class="num">0</span> <span class="varop">&amp;&amp;</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="num">0</span> <span class="varop">&amp;&amp;</span> <span class="varid">a</span> <span class="varop">&lt;=</span> <span class="varid">c</span> <span class="keyglyph">=</span> <span class="varid">return</span> (<span class="varid">a</span>,<span class="varid">c</span><span class="varop">-</span><span class="varid">a</span>) <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">mzero</span> <span class="keyword">where</span> (<span class="varid">a</span>,<span class="varid">ok</span>) <span class="keyglyph">=</span> (<span class="varid">c</span> <span class="varop">+</span> <span class="varid">d</span>) <span class="varop">`divMod`</span> <span class="num">2</span> </pre><p>This gives an <span class="math">O(n<sup>5</sup>)</span> algorithm: </p><pre class="haskell"><span class="varid">paths<sub>pm</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> <span class="keyword">let</span> <span class="varid">n<sub>12345678</sub></span> <span class="keyglyph">=</span> <span class="varid">n</span> (<span class="varid">n<sub>1234</sub></span>,<span class="varid">n<sub>5678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12345678</sub></span> (<span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">n<sub>57</sub></span>,<span class="varid">n<sub>68</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">i</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span>) (<span class="varid">n<sub>13</sub></span>,<span class="varid">n<sub>24</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">j</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>56</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>78</sub></span>) (<span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>3</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>13</sub></span> <span class="varop">-</span> <span class="varid">n<sub>1</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>4</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>24</sub></span> <span class="varop">-</span> <span class="varid">n<sub>2</sub></span> (<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>56</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>7</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>57</sub></span> <span class="varop">-</span> <span class="varid">n<sub>5</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>8</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>68</sub></span> <span class="varop">-</span> <span class="varid">n<sub>6</sub></span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>,<span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span>,<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>,<span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span> </pre><h2><a name="multinomial-laws"></a>Multinomial laws </h2> <p>It turns out that we don't actually need to know <tt><span class="varid">n<sub>1</sub></span></tt>, <tt><span class="varid">n<sub>2</sub></span></tt>, etc. If you think about it, the multinomial coefficient <tt class='complex'><span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>,<span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span>,<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>,<span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span></tt> means: "The number of different lists with <span class="math">n<sub>1</sub></span> red balls, <span class="math">n<sub>2</sub></span> of green balls, etc.". To make such a list we can first pick where to put the red balls, then where to put the blue balls, then the green balls and so on. </p><p>But we could also first decide where the brightly colored balls (red and green) go and where the dark collored ones (blue) go. Now there are only two types of balls, so this is a binomial coefficient, or in terms of a multinomial, <tt class='complex'><span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>rg</sub></span>,<span class="varid">n<sub>b</sub></span><span class="listcon">]</span></tt>. Then for the positions with brightly colored balls, we need to determine which ones are which color, which can be done in <tt class='complex'><span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>r</sub></span>,<span class="varid">n<sub>g</sub></span><span class="listcon">]</span></tt> ways. In a picture: </p><p><img src="image/knight/multinomial-law1.png" alt="multinomial [2,1,1] = multinomial [3,1] * multinomial [2,1]" style="margin-left:2em;border:1px solid #aaa;"> </p><p>This same arguments also holds when there are eight types of balls (or moves), so </p><pre class="ghci"><span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>,<span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span>,<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>,<span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span> <span class="varop">==</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>,<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span><span class="listcon">[</span><span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span><span class="listcon">[</span><span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span> </pre><p>If you plug this into the <tt><span class="varid">paths<sub>pm</sub></span></tt> function, you might notice that the last part of the function is calculating the product of two independent things. One part is about <tt class='complex'><span class="varid">n<sub>1</sub></span><span class="listcon">..</span><span class="varid">n<sub>4</sub></span></tt> and the other about <tt class='complex'><span class="varid">n<sub>5</sub></span><span class="listcon">..</span><span class="varid">n<sub>8</sub></span></tt>. Now remember that the function <tt><span class="varid">paths</span></tt> takes the sum of all possibilities, and that products distributes over sums. This means that the two loops for <tt><span class="varid">n<sub>1234</sub></span></tt> and <tt><span class="varid">n<sub>5678</sub></span></tt> can be performed independently, giving us an <span class="math">O(n<sup>4</sup>)</span> algorithm: </p><pre class="haskell"><span class="varid">paths<sub>O4</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> <span class="keyword">let</span> <span class="varid">n<sub>12345678</sub></span> <span class="keyglyph">=</span> <span class="varid">n</span> (<span class="varid">n<sub>1234</sub></span>,<span class="varid">n<sub>5678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12345678</sub></span> (<span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">n<sub>57</sub></span>,<span class="varid">n<sub>68</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">i</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span>) (<span class="varid">n<sub>13</sub></span>,<span class="varid">n<sub>24</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">j</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>56</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>78</sub></span>) <span class="keyword">let</span> <span class="varid">result<sub>1234</sub></span> <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> (<span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>3</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>13</sub></span> <span class="varop">-</span> <span class="varid">n<sub>1</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>4</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>24</sub></span> <span class="varop">-</span> <span class="varid">n<sub>2</sub></span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>1</sub></span>,<span class="varid">n<sub>2</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span><span class="listcon">[</span><span class="varid">n<sub>3</sub></span>,<span class="varid">n<sub>4</sub></span><span class="listcon">]</span> <span class="keyword">let</span> <span class="varid">result<sub>5678</sub></span> <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> (<span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>56</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>7</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>57</sub></span> <span class="varop">-</span> <span class="varid">n<sub>5</sub></span> <span class="keyword">let</span> <span class="varid">n<sub>8</sub></span> <span class="keyglyph">=</span> <span class="varid">n<sub>68</sub></span> <span class="varop">-</span> <span class="varid">n<sub>6</sub></span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>5</sub></span>,<span class="varid">n<sub>6</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span><span class="listcon">[</span><span class="varid">n<sub>7</sub></span>,<span class="varid">n<sub>8</sub></span><span class="listcon">]</span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>,<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">result<sub>1234</sub></span> <span class="varop">*</span> <span class="varid">result<sub>5678</sub></span> </pre><p>Here both of the <tt><span class="varid">result</span></tt> parts are of the form </p><pre class="ghci"><span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">a</span>,<span class="varid">b</span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span><span class="listcon">[</span><span class="varid">x</span><span class="varop">-</span><span class="varid">a</span>,<span class="varid">y</span><span class="varop">-</span><span class="varid">b</span><span class="listcon">]</span> <span class="keyglyph">|</span> (<span class="varid">a</span>,<span class="varid">b</span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n</span> <span class="listcon">]</span> </pre><p>which just so happens to be equivalent to just <tt class='complex'><span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">x</span>,<span class="varid">y</span><span class="listcon">]</span></tt> (a proof of this statement is left as an exercise, i.e. I am too lazy to write it out). This equation immediately leads to a (much simpler) <span class="math">O(n<sup>3</sup>)</span> algorithm: </p><pre class="haskell"><span class="varid">paths<sub>O3</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="varop">\$</span> <span class="keyword">do</span> <span class="keyword">let</span> <span class="varid">n<sub>12345678</sub></span> <span class="keyglyph">=</span> <span class="varid">n</span> (<span class="varid">n<sub>1234</sub></span>,<span class="varid">n<sub>5678</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>12345678</sub></span> (<span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">split</span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">n<sub>57</sub></span>,<span class="varid">n<sub>68</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>5678</sub></span> (<span class="varid">i</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>12</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>34</sub></span>) (<span class="varid">n<sub>13</sub></span>,<span class="varid">n<sub>24</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">solve<sub>pm</sub></span> <span class="varid">n<sub>1234</sub></span> (<span class="varid">j</span> <span class="varop">-</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>56</sub></span> <span class="varop">+</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n<sub>78</sub></span>) <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>12</sub></span>,<span class="varid">n<sub>34</sub></span>,<span class="varid">n<sub>56</sub></span>,<span class="varid">n<sub>78</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>57</sub></span>,<span class="varid">n<sub>68</sub></span><span class="listcon">]</span> <span class="varop">*</span> <span class="varid">multinomial</span> <span class="listcon">[</span><span class="varid">n<sub>13</sub></span>,<span class="varid">n<sub>24</sub></span><span class="listcon">]</span> </pre><h2><a name="verifying-the-results"></a>Verifying the results </h2> <p>After all this manipulation it is a good idea to check whether the program still does the right thing. We can either manually compare the path matrices: </p><pre class="haskell"><span class="varid">check</span> <span class="varid">paths</span> <span class="keyglyph">=</span> <span class="varid">and</span> <span class="listcon">[</span> <span class="varid">pathMatrix</span> <span class="varid">paths<sub>rec</sub></span> <span class="varid">n</span> <span class="varop">==</span> <span class="varid">pathMatrix</span> <span class="varid">paths</span> <span class="varid">n</span> <span class="keyglyph">|</span> <span class="varid">n</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="num">3</span><span class="listcon">]</span> <span class="listcon">]</span> </pre><p>Or use QuickCheck or SmallCheck: </p><pre class="ghci"><span class="input">Knight2&gt;</span> <span class="varid">smallCheck</span> <span class="num">5</span> (<span class="keyglyph">\</span>(<span class="conid">N</span> <span class="varid">n</span>) <span class="varid">ij</span> <span class="keyglyph">-&gt;</span> <span class="varid">paths<sub>O3</sub></span> <span class="varid">n</span> <span class="varid">ij</span> <span class="varop">==</span> <span class="varid">paths<sub>rec</sub></span> <span class="varid">n</span> <span class="varid">ij</span>) ... Depth 5: Completed 726 test(s) without failure. </pre><p>Finally, to contrast with the first part of this series, here is the time it takes to calculate the number of paths in <span class="math">100</span> steps: </p><pre class="ghci"><span class="input">Knight2&gt;</span> <span class="varid">paths<sub>O3</sub></span> <span class="num">100</span> (<span class="num">4</span>,<span class="num">4</span>) 2422219241769802380469882122062019059350760968380804461263234408581143863208781993964800 (4.75 secs, 270708940 bytes) </pre><p>The recursive algorithm would need in the order of <span class="math">10<sup>77</sup></span> years to arrive at this answer. </p><p>Still, <tt><span class="varid">paths<sub>O3</sub></span></tt> is not the fastest possible algorithm. Next time I will look at a completely different approach, but further improvements to the solution in this post are possible as well. As an exercise for the reader, you should try transforming <tt><span class="varid">paths<sub>O3</sub></span></tt> into an <span class="math">O(n<sup>2</sup>)</span> solution. Hint: there are more sums-of-products of independent values. </p> Knight in n, part 1: moves http://twanvl.nl/blog/haskell/Knight1 2008-11-25T23:00:00Z <p>Consider the following problem: </p><blockquote style='font-style:italic'> A knight is placed at the origin of a chessboard that is infinite in all directions. How many ways are there for that knight to reach cell <span class="math">(i,j)</span> in exactly <span class="math">n</span> moves? </blockquote> <p>This <em>knight moves problem</em> is not hard, nor does it have any real life applications. The problem is still interesting because there are many different ways to solve it, ranging from very simple to quite complex. In this series of articles I will describe some of these solutions. </p><h2><a name="knight-s-moves"></a>Knight's moves </h2> <p><img src="image/knight/chessboard1.png" style="float:right;margin-left:1em;" alt="The possible moves for a chess knight"> </p><p>In chess, a knight can move two squares horizontally and one square vertically, or two squares vertically and one square horizontally. One complete move therefore looks like the letter 'L'. The picture on the right shows all possible moves for the black knight in the center. </p><p>We can summarize all these moves in an array: </p><pre class="haskell"><span class="varid">moves</span> <span class="keyglyph">::</span> <span class="listcon">[</span>(<span class="conid">Int</span>,<span class="conid">Int</span>)<span class="listcon">]</span> <span class="varid">moves</span> <span class="keyglyph">=</span> <span class="listcon">[</span>(<span class="num">2</span>,<span class="num">1</span>),(<span class="num">2</span>,<span class="num">-1</span>),(<span class="num">-2</span>,<span class="num">1</span>),(<span class="num">-2</span>,<span class="num">-1</span>) ,(<span class="num">1</span>,<span class="num">2</span>),(<span class="num">-1</span>,<span class="num">2</span>),(<span class="num">1</span>,<span class="num">-2</span>),(<span class="num">-1</span>,<span class="num">-2</span>)<span class="listcon">]</span> </pre><p>Counting the number of paths to <span class="math">(i,j)</span> in <span class="math">n</span> steps can now be done with a simple recursive function. The base case is that in <span class="math">0</span> moves only cell <span class="math">(0,0)</span> is reachable. In the recursion step we simply try all moves: </p><pre class="haskell"><span class="varid">paths<sub>rec</sub></span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> (<span class="conid">Int</span>,<span class="conid">Int</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Integer</span> <span class="varid">paths<sub>rec</sub></span> <span class="num">0</span> (<span class="num">0</span>,<span class="num">0</span>) <span class="keyglyph">=</span> <span class="num">1</span> <span class="varid">paths<sub>rec</sub></span> <span class="num">0</span> (<span class="varid">_</span>,<span class="varid">_</span>) <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>rec</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">paths<sub>rec</sub></span> (<span class="varid">n</span><span class="num">-1</span>) (<span class="varid">i</span><span class="varop">+</span><span class="varid">δ<sub>i</sub></span>,<span class="varid">j</span><span class="varop">+</span><span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">|</span> (<span class="varid">δ<sub>i</sub></span>,<span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">moves</span> <span class="listcon">]</span> </pre><p>So for example </p><pre class="ghci"><span class="input">Knight1&gt;</span> <span class="varid">paths_rec</span> <span class="num">4</span> (<span class="num">2</span>,<span class="num">2</span>) <span class="num">54</span> </pre><p>I.e. there are 54 ways to reach cell <span class="math">(2,2)</span> in <span class="math">4</span> moves. </p><p>Unfortunately the function <tt><span class="varid">paths<sub>rec</sub></span></tt> is not very efficient. In fact, it is very much not efficient. At each step all <span class="math">8</span> possible moves are considered, so the total time complexity of this function is <span class="math">O(8<sup>n</sup>)</span>. </p><h2><a name="tables"></a>Tables </h2> <p>Besides calculating the number of paths to a single point it can also be interesting to display the number of pats for each possible end point. We can make a list of lists containing all the path counts, </p><pre class="haskell"><span class="varid">pathMatrix</span> <span class="varid">paths</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="listcon">[</span> <span class="listcon">[</span> <span class="varid">paths</span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">|</span> <span class="varid">j</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">-2</span><span class="varop">*</span><span class="varid">n</span> <span class="listcon">..</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n</span><span class="listcon">]</span> <span class="listcon">]</span> <span class="keyglyph">|</span> <span class="varid">i</span> <span class="keyglyph">&lt;-</span> <span class="listcon">[</span><span class="num">-2</span><span class="varop">*</span><span class="varid">n</span> <span class="listcon">..</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n</span><span class="listcon">]</span> <span class="listcon">]</span> </pre><p>and then display this list in a tabular format </p><pre class="haskell"><span class="varid">showMatrix</span> <span class="keyglyph">::</span> <span class="conid">Show</span> <span class="varid">α</span> <span class="keyglyph">=&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="varid">α</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">String</span> <span class="varid">showMatrix</span> <span class="varid">xss</span> <span class="keyglyph">=</span> <span class="varid">unlines</span> <span class="listcon">[</span> <span class="varid">unwords</span> <span class="listcon">[</span> <span class="varid">show</span> <span class="varid">x</span> <span class="keyglyph">|</span> <span class="varid">x</span> <span class="keyglyph">&lt;-</span> <span class="varid">xs</span> <span class="listcon">]</span> <span class="keyglyph">|</span> <span class="varid">xs</span> <span class="keyglyph">&lt;-</span> <span class="varid">xss</span> <span class="listcon">]</span> <div class='empty-line'></div> <span class="varid">printPathMatrix</span> <span class="varid">paths</span> <span class="keyglyph">=</span> <span class="varid">putStr</span> <span class="varop">.</span> <span class="varid">showMatrix</span> <span class="varop">.</span> <span class="varid">pathMatrix</span> <span class="varid">paths</span> </pre><p>The path matrix for <span class="math">n=1</span> should be familiar, it is the same as the image of possible moves of a knight. </p><pre class="ghci"><span class="input">Knight1&gt;</span> <span class="varid">printPathMatrix</span> <span class="varid">paths<sub>rec</sub></span> <span class="num">1</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> </pre><p>But now we can also make larger tables: </p><pre class="ghci"><span class="input">Knight1&gt;</span> <span class="varid">printPathMatrix</span> <span class="varid">paths<sub>rec</sub></span> <span class="num">2</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">8</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">0</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">2</span> <span class="num">0</span> <span class="num">1</span> <span class="num">0</span> <span class="num">0</span> </pre><p>If you were to continue increasing <span class="math">n</span>, the table and the numbers in it become ever larger. It is a good idea to make a 'density plot', i.e. to use colors to visualize larger numbers. For example for <span class="math">n=4</span>, the path matrix can be rendered as: <br><img src="image/knight/knight-density4.png" alt="" style="vertical-align:middle;margin-left:2em;margin-top:3px;"> </p><h2><a name="special-cases"></a>Special cases </h2> <p>Looking at the above matrices, you might start to see some patterns emerge: </p><ul><li> A knight cannot move more than <span class="math">2n</span> cells in any direction (horizontal or vertical).</li> <li> Similarly, the knight moves no more than <span class="math">3n</span> squares in total.</li> <li> A knight always moves from a white square to a black square and vice-versa. In other words, the parity of <span class="math">i+j+n</span> must be zero.</li> </ul><p>These observations can be used as additional cases in the recursive function to quickly eliminate large parts of the input space: </p><pre class="haskell"><span class="varid">paths<sub>case</sub></span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> (<span class="conid">Int</span>,<span class="conid">Int</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Integer</span> <span class="varid">paths<sub>case</sub></span> <span class="num">0</span> (<span class="num">0</span>,<span class="num">0</span>) <span class="keyglyph">=</span> <span class="num">1</span> <span class="varid">paths<sub>case</sub></span> <span class="num">0</span> (<span class="varid">_</span>,<span class="varid">_</span>) <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>case</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">|</span> (<span class="varid">n</span><span class="varop">+</span><span class="varid">i</span><span class="varop">+</span><span class="varid">j</span>) <span class="varop">`mod`</span> <span class="num">2</span> <span class="varop">/=</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>case</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">|</span> <span class="varid">abs</span> <span class="varid">i</span> <span class="varop">+</span> <span class="varid">abs</span> <span class="varid">j</span> <span class="varop">&gt;</span> <span class="num">3</span><span class="varop">*</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>case</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">|</span> <span class="varid">abs</span> <span class="varid">i</span> <span class="varop">&gt;</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>case</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">|</span> <span class="varid">abs</span> <span class="varid">j</span> <span class="varop">&gt;</span> <span class="num">2</span><span class="varop">*</span><span class="varid">n</span> <span class="keyglyph">=</span> <span class="num">0</span> <span class="varid">paths<sub>case</sub></span> <span class="varid">n</span> (<span class="varid">i</span>,<span class="varid">j</span>) <span class="keyglyph">=</span> <span class="varid">sum</span> <span class="listcon">[</span> <span class="varid">paths<sub>case</sub></span> (<span class="varid">n</span><span class="num">-1</span>) (<span class="varid">i</span><span class="varop">+</span><span class="varid">δ<sub>i</sub></span>,<span class="varid">j</span><span class="varop">+</span><span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">|</span> (<span class="varid">δ<sub>i</sub></span>,<span class="varid">δ<sub>j</sub></span>) <span class="keyglyph">&lt;-</span> <span class="varid">moves</span> <span class="listcon">]</span> </pre><p>A quick test shows that this can be a big improvement for the run time: </p><pre class="ghci"><span class="input">Knight1&gt;</span> <span class="varid">paths<sub>rec</sub></span> <span class="num">8</span> (<span class="num">4</span>,<span class="num">4</span>) <span class="num">124166</span> (<span class="num">92</span><span class="varop">.</span><span class="num">88</span> <span class="varid">secs</span>, <span class="num">4605991724</span> <span class="varid">bytes</span>) <span class="input">Knight1&gt;</span> <span class="varid">paths<sub>case</sub></span> <span class="num">8</span> (<span class="num">4</span>,<span class="num">4</span>) <span class="num">124166</span> (<span class="num">17</span><span class="varop">.</span><span class="num">69</span> <span class="varid">secs</span>, <span class="num">807191624</span> <span class="varid">bytes</span>) </pre><p>The asymptotic time complexity of <tt><span class="varid">paths<sub>case</sub></span></tt> is harder to analyze. It is still <span class="math">O(8<sup>n</sup>)</span> in the worst case, but the complexity is now also output dependant. </p><p><br>That is all for now, next time we will look at smarter algorithms. For the interested reader I would suggest that you try to come up with some ideas of your own. I would love to hear how other people approach this problem. </p> Arrays without bounds http://twanvl.nl/blog/haskell/UnboundedArray 2008-11-13T23:00:00Z <p>Regular old arrays have a size; you can't just have an infinite array. On the other hand, a lazy language such as Haskell does allow infinite lists. The idea behind the <tt><span class="conid">UnboundedArray</span></tt> module is to combine the <span class="math">O(1)</span> access of arrays with the unbounded size of lazy lists. </p><pre class="haskell"><span class="keyword">module</span> <span class="conid">UnboundedArray</span> <span class="keyword">where</span> </pre><p>This data type is built on top of ordinary arrays and unsafe IO operations: </p><pre class="haskell"><span class="keyword">import</span> <span class="conid">Data.Array</span> <span class="keyword">import</span> <span class="conid">Data.IORef</span> <span class="keyword">import</span> <span class="conid">System.IO.Unsafe</span> </pre><p>To keep things simple, an unbounded array is just a function from the natural numbers to array elements: </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">UnboundedArray</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> </pre><p>I am just going to dump the code here instead of explaining it. The idea is to make an array and resize it when it becomes too small. If the size increases geometrically with each resize, then the amortized cost of a single access will be <span class="math">O(1)</span>. </p><pre class="haskell"><span class="comment">-- | Create an unbounded array from an infinite list</span> <span class="comment">-- Accessing element /n/ takes /O(n)/ time, but only /O(1)/ amortized time.</span> <span class="varid">unboundedArray</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">UnboundedArray</span> <span class="varid">a</span> <span class="varid">unboundedArray</span> <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="varid">unsafePerformIO</span> <span class="varop">.</span> <span class="varid">unsafePerformIO</span> (<span class="varid">unboundedArrayIO</span> <span class="varid">xs</span>) <div class='empty-line'></div> <span class="varid">unboundedArrayIO</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">IO</span> (<span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">IO</span> <span class="varid">a</span>) <span class="varid">unboundedArrayIO</span> <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="keyword">do</span> <span class="varid">theArray</span> <span class="keyglyph">&lt;-</span> <span class="varid">newIORef</span> (<span class="varid">listArray</span> (<span class="num">0</span>,<span class="num">0</span>) <span class="varid">xs</span>) <span class="varid">return</span> <span class="varop">\$</span> <span class="keyglyph">\</span><span class="varid">n</span> <span class="keyglyph">-&gt;</span> <span class="keyword">do</span> <span class="varid">ar</span> <span class="keyglyph">&lt;-</span> <span class="varid">readIORef</span> <span class="varid">theArray</span> <span class="keyword">let</span> (<span class="num">0</span>,<span class="varid">size</span>) <span class="keyglyph">=</span> <span class="varid">bounds</span> <span class="varid">ar</span> <span class="keyword">if</span> <span class="varid">n</span> <span class="varop">&lt;=</span> <span class="varid">size</span> <span class="keyword">then</span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">ar</span> <span class="varop">!</span> <span class="varid">n</span> <span class="keyword">else</span> <span class="keyword">do</span> <span class="keyword">let</span> <span class="varid">size'</span> <span class="keyglyph">=</span> <span class="varid">max</span> <span class="varid">n</span> (<span class="varid">size</span> <span class="varop">*</span> <span class="num">3</span> <span class="varop">`div`</span> <span class="num">2</span>) <span class="keyword">let</span> <span class="varid">ar'</span> <span class="keyglyph">=</span> <span class="varid">listArray</span> (<span class="num">0</span>,<span class="varid">size'</span>) <span class="varid">xs</span> <span class="varid">writeIORef</span> <span class="varid">theArray</span> <span class="varid">ar'</span> <span class="varid">return</span> <span class="varop">\$</span> <span class="varid">ar'</span> <span class="varop">!</span> <span class="varid">n</span> </pre><p>So, what are UnboundedArrays good for? A simple application is memoization, for example: </p><pre class="haskell"><span class="varid">memo<sub>Int</sub></span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">unboundedArray</span> (<span class="varid">map</span> <span class="varid">f</span> <span class="listcon">[</span><span class="num">0</span><span class="listcon">..</span><span class="listcon">]</span>) <div class='empty-line'></div> <span class="varid">fib</span> <span class="keyglyph">=</span> <span class="varid">memo<sub>Int</sub></span> <span class="varid">realFib</span> <span class="keyword">where</span> <span class="varid">realFib</span> <span class="num">0</span> <span class="keyglyph">=</span> <span class="num">1</span> <span class="varid">realFib</span> <span class="num">1</span> <span class="keyglyph">=</span> <span class="num">1</span> <span class="varid">realFib</span> <span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">fib</span> (<span class="varid">n</span> <span class="varop">-</span> <span class="num">1</span>) <span class="varop">+</span> <span class="varid">fib</span> (<span class="varid">n</span> <span class="varop">-</span> <span class="num">2</span>) </pre><pre class="ghci"><span class="input">&gt; </span><span class="varid">map</span> <span class="varid">fib</span> <span class="listcon">[</span><span class="num">1</span><span class="listcon">..</span><span class="num">20</span><span class="listcon">]</span> [1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946] </pre><p>But since we can use an arbitrary list for initialization the <tt><span class="varid">unboundedArray</span></tt> function can sometimes be more flexible/convenient than <tt><span class="varid">memo<sub>Int</sub></span></tt>. </p> A generic merge function http://twanvl.nl/blog/haskell/generic-merge 2008-08-14T22:00:00Z <p>When working with sorted lists you often come to the point where you want to combine two or more of them. This <em>merge</em> procedure forms the heart of <a href="http://en.wikipedia.org/wiki/Merge_sort">merge sort</a> it works something like: </p><pre class="ghci"><span class="varid">merge</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">2</span>,<span class="num">3</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span> </pre><p>This <tt><span class="varid">merge</span></tt> function is not in the Haskell standard library, and even if there were, it might not be very useful. </p><p>The problem is that when you need <tt><span class="varid">merge</span></tt> you often need a slight variation. For example, you might want to remove duplicates, </p><pre class="ghci"><span class="varid">merge_union</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span> </pre><p>Or find the elements common to both lists, </p><pre class="ghci"><span class="varid">merge_intersection</span> <span class="listcon">[</span><span class="num">1</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span><span class="listcon">]</span> <span class="listcon">[</span><span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="num">3</span>,<span class="num">4</span><span class="listcon">]</span> </pre><p>Or you want the difference, the symmetric difference, or... </p><p><br>The solution for all these problems is to make a more general <tt><span class="varid">merge</span></tt> function. To do that we take a note from the most generic function over a single list, <tt><span class="varid">foldr</span></tt>. The generic merge function is also a right fold, but over two lists. Behold the type signature: </p><pre class="haskell"><span class="varid">mergeByR</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="conid">Ordering</span>) <span class="comment">-- ^ cmp: Comparison function</span> <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>) <span class="comment">-- ^ f<sub>xy</sub>: Combine when a and b are equal</span> <span class="keyglyph">-&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>) <span class="comment">-- ^ f<sub>x</sub>: Combine when a is less</span> <span class="keyglyph">-&gt;</span> (<span class="varid">b</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span>) <span class="comment">-- ^ f<sub>y</sub>: Combine when b is less</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="comment">-- ^ z: Base case</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="varid">b</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="varid">c</span> <span class="comment">-- ^ Argument lists and result list</span> </pre><p>Don't be scared by the size. The reason there are a lot of arguments is that for each case we use a different combining function: If the smallest element comes from the first list we use <tt><span class="varid">f<sub>x</sub></span></tt>, if it comes from the second list we use <tt><span class="varid">f<sub>y</sub></span></tt>, and when the two elements are equal, we combine them both with <tt><span class="varid">f<sub>xy</sub></span></tt>. As in <tt><span class="varid">foldr</span></tt> these calls to <tt class='complex'><span class="varid">f<sub>x</sub></span><span class="varop">/</span><span class="varid">f<sub>y</sub></span><span class="varop">/</span><span class="varid">f<sub>xy</sub></span></tt> are then chained like <tt class='complex'><span class="varid">f<sub>x</sub></span> <span class="varid">x<sub>1</sub></span> (<span class="varid">f<sub>x</sub></span> <span class="varid">x<sub>2</sub></span> (<span class="listcon">..</span> <span class="varid">z</span>))</tt>. </p><p>The lists from the example above can be aligned as follows: </p><pre class="ghci"><span class="varid">xs</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="num">1</span>, <span class="num">3</span>, <span class="num">4</span>, <span class="num">5</span> <span class="listcon">]</span> <span class="varid">ys</span> <span class="keyglyph">=</span> <span class="listcon">[</span> <span class="num">2</span>, <span class="num">3</span>, <span class="num">4</span> <span class="listcon">]</span> <span class="varid">function</span> <span class="varid">to</span> <span class="varid">use</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="varid">f<sub>x</sub></span>, <span class="varid">f<sub>y</sub></span>, <span class="varid">f<sub>xy</sub></span>, <span class="varid">f<sub>xy</sub></span>, <span class="varid">f<sub>x</sub></span><span class="listcon">]</span> <span class="varid">mergeByR</span> <span class="varop">....</span> <span class="keyglyph">=</span> <span class="varid">f<sub>x</sub></span> <span class="num">1</span> <span class="varop">.</span> <span class="varid">f<sub>y</sub></span> <span class="num">2</span> <span class="varop">.</span> <span class="varid">f<sub>xy</sub></span> <span class="num">3</span> <span class="num">3</span> <span class="varop">.</span> <span class="varid">f<sub>xy</sub></span> <span class="num">4</span> <span class="num">4</span> <span class="varop">.</span> <span class="varid">f<sub>x</sub></span> <span class="num">5</span> <span class="varop">\$</span> <span class="varid">z</span> </pre><p>The function implementation is straightforward: </p><pre class="haskell"><span class="varid">mergeByR</span> <span class="varid">cmp</span> <span class="varid">f<sub>xy</sub></span> <span class="varid">f<sub>x</sub></span> <span class="varid">f<sub>y</sub></span> <span class="varid">z</span> <span class="keyglyph">=</span> <span class="varid">go</span> <span class="keyword">where</span> <span class="varid">go</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">ys</span> <span class="keyglyph">=</span> <span class="varid">foldr</span> <span class="varid">f<sub>y</sub></span> <span class="varid">z</span> <span class="varid">ys</span> <span class="varid">go</span> <span class="varid">xs</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="varid">foldr</span> <span class="varid">f<sub>x</sub></span> <span class="varid">z</span> <span class="varid">xs</span> <span class="varid">go</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) (<span class="varid">y</span><span class="listcon">:</span><span class="varid">ys</span>) <span class="keyglyph">=</span> <span class="keyword">case</span> <span class="varid">cmp</span> <span class="varid">x</span> <span class="varid">y</span> <span class="keyword">of</span> <span class="conid">LT</span> <span class="keyglyph">-&gt;</span> <span class="varid">f<sub>x</sub></span> <span class="varid">x</span> (<span class="varid">go</span> <span class="varid">xs</span> (<span class="varid">y</span><span class="listcon">:</span><span class="varid">ys</span>)) <span class="conid">EQ</span> <span class="keyglyph">-&gt;</span> <span class="varid">f<sub>xy</sub></span> <span class="varid">x</span> <span class="varid">y</span> (<span class="varid">go</span> <span class="varid">xs</span> <span class="varid">ys</span>) <span class="conid">GT</span> <span class="keyglyph">-&gt;</span> <span class="varid">f<sub>y</sub></span> <span class="varid">y</span> (<span class="varid">go</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="varid">ys</span>) </pre><p><br>Now, let's look at some uses of this function. First of all, the usual merge sort <tt><span class="varid">merge</span></tt> function: </p><pre class="haskell"><span class="varid">mergeBy</span> <span class="varid">cmp</span> <span class="keyglyph">=</span> <span class="varid">mergeByR</span> <span class="varid">cmp</span> (<span class="keyglyph">\</span><span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span><span class="listcon">:</span><span class="varid">b</span><span class="listcon">:</span><span class="varid">c</span>) <span class="listcon">(:)</span> <span class="listcon">(:)</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">merge</span> <span class="keyglyph">=</span> <span class="varid">mergeBy</span> <span class="varid">compare</span> </pre><p>Instead of adding both <tt><span class="varid">a</span></tt> and <tt><span class="varid">b</span></tt> to the resulting list when they are equal, we can instead add only one of them, or even the result of some function on them. This gives the set <tt><span class="varid">union</span></tt> operation: </p><pre class="haskell"><span class="varid">unionByWith</span> <span class="varid">cmp</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">mergeByR</span> <span class="varid">cmp</span> (<span class="keyglyph">\</span><span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span> <span class="varid">b</span><span class="listcon">:</span><span class="varid">c</span>) <span class="listcon">(:)</span> <span class="listcon">(:)</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">unionWith</span> <span class="keyglyph">=</span> <span class="varid">unionByWith</span> <span class="varid">compare</span> </pre><p>If we ignore elements that occur in only one of the lists by setting <tt><span class="varid">f<sub>x</sub></span></tt> and <tt><span class="varid">f<sub>y</sub></span></tt> to <tt class='complex'><span class="varid">const</span> <span class="varid">id</span></tt>, we get the intersection instead: </p><pre class="haskell"><span class="varid">intersectionByWith</span> <span class="varid">cmp</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">mergeByR</span> <span class="varid">cmp</span> (<span class="keyglyph">\</span><span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="varid">a</span> <span class="varid">b</span><span class="listcon">:</span><span class="varid">c</span>) (<span class="varid">const</span> <span class="varid">id</span>) (<span class="varid">const</span> <span class="varid">id</span>) <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">intersectionWith</span> <span class="keyglyph">=</span> <span class="varid">intersectionByWith</span> <span class="varid">compare</span> </pre><p><br>With these merge functions, implementing merge sort becomes simple. All that is left to do is split a list in two, and recursively sort and merge. </p><pre class="haskell"><span class="varid">split</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> (<span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span>,<span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span>) <span class="varid">split</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">y</span><span class="listcon">:</span><span class="varid">zs</span>) <span class="keyglyph">=</span> <span class="keyword">let</span> (<span class="varid">xs</span>,<span class="varid">ys</span>) <span class="keyglyph">=</span> <span class="varid">split</span> <span class="varid">zs</span> <span class="keyword">in</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>,<span class="varid">y</span><span class="listcon">:</span><span class="varid">ys</span>) <span class="varid">split</span> <span class="varid">xs</span> <span class="keyglyph">=</span> (<span class="varid">xs</span>,<span class="listcon">[</span><span class="listcon">]</span>) <div class='empty-line'></div> <span class="varid">sort</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">sort</span> <span class="listcon">[</span><span class="varid">x</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="varid">x</span><span class="listcon">]</span> <span class="varid">sort</span> <span class="varid">xs</span> <span class="keyglyph">=</span> <span class="keyword">let</span> (<span class="varid">ys</span>,<span class="varid">zs</span>) <span class="keyglyph">=</span> <span class="varid">split</span> <span class="varid">xs</span> <span class="keyword">in</span> <span class="varid">merge</span> (<span class="varid">sort</span> <span class="varid">ys</span>) (<span class="varid">sort</span> <span class="varid">zs</span>) </pre><p>If we replace <tt><span class="varid">merge</span></tt> by <tt><span class="varid">unionWith</span></tt> we instead get a sort that combines duplicate elements. </p><p><br>Besides set operations, <tt><span class="varid">mergeByR</span></tt> can also be (ab)used for other things, such as </p><pre class="haskell"><span class="varid">zipWith</span> <span class="keyglyph">=</span> <span class="varid">intersectionByWith</span> (<span class="varid">const</span> <span class="varop">\$</span> <span class="varid">const</span> <span class="conid">EQ</span>) </pre><p>Or a variant of <tt><span class="varid">zipWith</span></tt>, that keeps the tail of the longer list: </p><pre class="haskell"><span class="varid">zipWith'</span> <span class="keyglyph">=</span> <span class="varid">unionByWith</span> (<span class="varid">const</span> <span class="varop">\$</span> <span class="varid">const</span> <span class="conid">EQ</span>) </pre><p>We can even implement concatenation: </p><pre class="haskell">(<span class="varop">++</span>) <span class="keyglyph">=</span> <span class="varid">mergeByR</span> (<span class="varid">const</span> <span class="varop">\$</span> <span class="varid">const</span> <span class="conid">LT</span>) <span class="varid">undefined</span> <span class="listcon">(:)</span> <span class="listcon">(:)</span> <span class="listcon">[</span><span class="listcon">]</span> </pre> Solving nonograms http://twanvl.nl/blog/haskell/Nonograms 2008-07-25T22:00:00Z <p>In this post I will show how to solve nonograms automatically using a computer. The code has been on <a href="http://haskell.org/haskellwiki/Nonogram#Set_based_solver">the Haskell wiki</a> for over year, but I have never taken the time to explain how it works. </p><p>This post is literate haskell (<a href="http://twanvl.nl/blog/haskell/Nonograms.lhs">download the source here</a>), so we need to start with some imports: </p><pre class="haskell"><span class="keyword">import</span> <span class="keyword">qualified</span> <span class="conid">Data.Set</span> <span class="varid">as</span> <span class="conid">Set</span> <span class="keyword">import</span> <span class="keyword">qualified</span> <span class="conid">Data.Map</span> <span class="varid">as</span> <span class="conid">Map</span> <span class="keyword">import</span> <span class="conid">Data.Set</span> (<span class="conid">Set</span>) <span class="keyword">import</span> <span class="conid">Data.List</span> <span class="keyword">import</span> <span class="conid">Control.Applicative</span> </pre><p>Since we will be working with sets a lot, here are some additional utility functions: </p><pre class="haskell"><span class="varid">setAll</span> <span class="keyglyph">::</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Set</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">setAll</span> <span class="varid">pred</span> <span class="keyglyph">=</span> <span class="varid">all</span> <span class="varid">pred</span> <span class="varop">.</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">toList</span> <span class="varid">unionMap</span> <span class="keyglyph">::</span> (<span class="conid">Ord</span> <span class="varid">a</span>, <span class="conid">Ord</span> <span class="varid">b</span>) <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Set</span> <span class="varid">b</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Set</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="conid">Set</span> <span class="varid">b</span> <span class="varid">unionMap</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">unions</span> <span class="varop">.</span> <span class="varid">map</span> <span class="varid">f</span> <span class="varop">.</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">toList</span> </pre><h2><a name="the-puzzle"></a>The puzzle </h2> <p>So, what is a nonogram anyway? Quoting <a href="http://en.wikipedia.org/wiki/Nonogram">Wikipedia</a>: </p> <blockquote><p>Nonograms are picture logic puzzles in which cells in a grid have to be colored or left blank according to numbers given at the side of the grid to reveal a hidden picture. In this puzzle type, the numbers measure how many unbroken lines of filled-in squares there are in any given row or column. For example, a clue of "4 8 3" would mean there are sets of four, eight, and three filled squares, in that order, with at least one blank square between successive groups.</p></blockquote> <p>A solved nonogram might look like the following image:<br> <img src="image/nonogram/nonogram-lambda1.png" style="vertical-align:middle;margin-left:2em;margin-top:3px;" alt=""> </p><p>A Haskell function to solve nonograms for us could have the following type, taking the clues for the rows and columns, and returning a grid indicating which squares are filled, </p><pre class="ghci"><span class="varid">solvePuzzle</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Bool</span><span class="listcon">]</span><span class="listcon">]</span> </pre><h2><a name="values-and-cells"></a>Values and cells </h2> <p>For simplicity we will start with a single row. A first idea is to represent the cells in a row as booleans, <tt class='complex'><span class="keyword">type</span> <span class="conid">Row</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="conid">Bool</span><span class="listcon">]</span></tt>. This works fine for a finished puzzle like:<br> <img src="image/nonogram/nonogram-row1.png" style="vertical-align:middle;margin-left:2em;" alt="[3,4][.####.###]">;<br> but consider a partially solved row:<br> <img src="image/nonogram/nonogram-row2.png" style="vertical-align:middle;margin-left:2em;" alt="[3,4][.#???.??#]">. </p><p>First of all we will need a way to distinguish between blank cells (indicated by a cross) and unknown cells. Secondly, we throw away a lot of information. For instance, we know that the last filled cell will be the last cell of a group of three. </p><p>To solve the second problem we can give each position an unique label, so the first filled cell will always be, for instance <tt><span class="num">1</span></tt>, the second one will be <tt><span class="num">2</span></tt>, etc. For blank cells we can use negative numbers; the first group of blanks will be labeled <tt class='complex'><span class="num">-1</span></tt>, the second group will be <tt class='complex'><span class="num">-2</span></tt>, etc. Since the groups of blanks are of variable size, we give each one the same value. Our solved row now looks like:<br> <img src="image/nonogram/nonogram-row1-labeled.png" style="vertical-align:middle;margin-left:2em;" alt="[3 4][-1,2,3,4,5,-6,-6,7,8,9]">. </p><p>In Haskell we can define the type of cell values as simply </p><pre class="haskell"><span class="keyword">newtype</span> <span class="conid">Value</span> <span class="keyglyph">=</span> <span class="conid">Value</span> <span class="conid">Int</span> <span class="keyword">deriving</span> (<span class="conid">Eq</span>, <span class="conid">Ord</span>, <span class="conid">Show</span>) </pre><p>Since negative values encode empty cells, and positive values are filled cells, we can add some utility functions: </p><pre class="haskell"><span class="varid">blank</span> (<span class="conid">Value</span> <span class="varid">n</span>) <span class="keyglyph">=</span> <span class="varid">n</span> <span class="varop">&lt;</span> <span class="num">0</span> <span class="varid">filled</span> <span class="keyglyph">=</span> <span class="varid">not</span> <span class="varop">.</span> <span class="varid">blank</span> </pre><p>This still leaves the first issue, dealing with partially solved puzzles. </p><h2><a name="partial-information"></a>Partial information </h2> <p>When we don't know the exact value of a cell it is still possible that there is <em>some</em> information. For instance, we might know that the first cell will not contain the value <tt><span class="num">9</span></tt>, since that value is already somewhere else. One way of representing this is to keep a set of possible values: </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">Cell</span> <span class="keyglyph">=</span> <span class="conid">Set</span> <span class="conid">Value</span> </pre><p>An unknown cell is simply a cell containing all possible values, and the more we know about a cell, the less the set will contain. </p><p>At a higher level we can still divide cells into four categories: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">CellState</span> <span class="keyglyph">=</span> <span class="conid">Blank</span> <span class="keyglyph">|</span> <span class="conid">Filled</span> <span class="keyglyph">|</span> <span class="conid">Indeterminate</span> <span class="keyglyph">|</span> <span class="conid">Error</span> <span class="keyword">deriving</span> <span class="conid">Eq</span> <div class='empty-line'></div> <span class="varid">cellState</span> <span class="keyglyph">::</span> <span class="conid">Cell</span> <span class="keyglyph">-&gt;</span> <span class="conid">CellState</span> <span class="varid">cellState</span> <span class="varid">x</span> <span class="keyglyph">|</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">null</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">Error</span> <span class="comment">-- Something went wrong, no options remain</span> <span class="keyglyph">|</span> <span class="varid">setAll</span> <span class="varid">blank</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">Blank</span> <span class="comment">-- The cell is guaranteed to be blank</span> <span class="keyglyph">|</span> <span class="varid">setAll</span> <span class="varid">filled</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">Filled</span> <span class="comment">-- The cell is guaranteed to be filled</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="conid">Indeterminate</span> </pre><p>CellStates are convenient for displaying (partial) solution grids, </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Show</span> <span class="conid">CellState</span> <span class="keyword">where</span> <span class="varid">show</span> <span class="conid">Blank</span> <span class="keyglyph">=</span> <span class="str">&quot;.&quot;</span> <span class="varid">show</span> <span class="conid">Filled</span> <span class="keyglyph">=</span> <span class="str">&quot;#&quot;</span> <span class="varid">show</span> <span class="conid">Indeterminate</span> <span class="keyglyph">=</span> <span class="str">&quot;?&quot;</span> <span class="varid">show</span> <span class="conid">Error</span> <span class="keyglyph">=</span> <span class="str">&quot;E&quot;</span> </pre><p>For example, here is our running example again, this time rotated 90°. The CellStates are shown on the left as before; while the actual <tt><span class="conid">Cell</span></tt> set is on the right:<br> <img src="image/nonogram/nonogram-row2-labeled.png" style="vertical-align:middle;margin-left:2em;" alt="[3 4][-1,2,3,4,5,-6,-6,7,8,9]"> </p><h2><a name="solving-a-single-row"></a>Solving a single row </h2> <p>Now it is time to solve a row. </p><p>As stated before, each filled cell gets a unique value. From a clue of the group lengths we need to construct such a unique labeling, such that <tt class='complex'><span class="varid">labeling</span> <span class="listcon">[</span><span class="num">4</span>,<span class="num">3</span><span class="listcon">]</span> <span class="varop">==</span> <span class="listcon">[</span><span class="num">-1</span>,<span class="num">-1</span>,<span class="num">2</span>,<span class="num">3</span>,<span class="num">4</span>,<span class="num">5</span>,<span class="num">-6</span>,<span class="num">-6</span>,<span class="num">7</span>,<span class="num">8</span>,<span class="num">9</span>,<span class="num">-10</span>,<span class="num">-10</span><span class="listcon">]</span></tt>. The exact values don't matter, as long as they are unique and have the right sign. </p><p>Constructing this labeling is simply a matter of iterating over the clues, </p><pre class="haskell"><span class="varid">labeling</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Value</span><span class="listcon">]</span> <span class="varid">labeling</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="conid">Value</span> <span class="varop">.</span> <span class="varid">labeling'</span> <span class="num">1</span> <span class="keyword">where</span> <span class="varid">labeling'</span> <span class="varid">n</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="varop">-</span><span class="varid">n</span>,<span class="varop">-</span><span class="varid">n</span><span class="listcon">]</span> <span class="varid">labeling'</span> <span class="varid">n</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="keyglyph">=</span> <span class="listcon">[</span><span class="varop">-</span><span class="varid">n</span>,<span class="varop">-</span><span class="varid">n</span><span class="listcon">]</span> <span class="varop">++</span> <span class="listcon">[</span><span class="varid">n</span><span class="varop">+</span><span class="num">1</span> <span class="listcon">..</span> <span class="varid">n</span><span class="varop">+</span><span class="varid">x</span><span class="listcon">]</span> <span class="varop">++</span> <span class="varid">labeling'</span> (<span class="varid">n</span><span class="varop">+</span><span class="varid">x</span><span class="varop">+</span><span class="num">1</span>) <span class="varid">xs</span> </pre><p>This labeling gives us important <em>local information</em>: we know what values can occur before and after a particular value. This is also the reason for including the negative (blank) values twice, since after a <tt class='complex'><span class="num">-1</span></tt> another <tt class='complex'><span class="num">-1</span></tt> can occur. </p><p>We can determine what comes after a value by zipping the labeling with its <tt><span class="varid">tail</span></tt>. In our example: </p><pre>after [-1,-1, 2, 3, 4, 5,-6,-6, 7, 8, 9, -10, -10] comes [-1,-1, 2, 3, 4, 5,-6,-6, 7, 8, 9,-10, -10] </pre><p>Collecting all pairs gives the mapping: </p><pre>{ -1 -&gt; {-1,2}, 2 -&gt; {3}, 3 -&gt; {4}, 4 -&gt; {5}, 5 -&gt; {-6}, -6 -&gt; {-6,7}, ...} </pre><p>Instead of carrying a <tt><span class="conid">Map</span></tt> around we can use a function that does the lookup in that map. Of course we don't want to recalculate the map every time the function is called, so we need to be careful about sharing: </p><pre class="ghci"><span class="varid">bad1</span> <span class="varid">a</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">Map</span><span class="varop">.</span><span class="varid">lookup</span> <span class="varid">x</span> (<span class="varid">expensiveThing</span> <span class="varid">a</span>) <span class="varid">bad2</span> <span class="varid">a</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="conid">Map</span><span class="varop">.</span><span class="varid">lookup</span> <span class="varid">x</span> <span class="varid">theMap</span> <span class="keyword">where</span> <span class="varid">theMap</span> <span class="keyglyph">=</span> <span class="varid">expensiveThing</span> <span class="varid">a</span> <span class="varid">good</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">-&gt;</span> <span class="conid">Map</span><span class="varop">.</span><span class="varid">lookup</span> <span class="varid">x</span> <span class="varid">theMap</span> <span class="keyword">where</span> <span class="varid">theMap</span> <span class="keyglyph">=</span> <span class="varid">expensiveThing</span> <span class="varid">a</span> </pre><p>So for determining what comes after a value in the labeling: </p><pre class="haskell"><span class="varid">mkAfter</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Value</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> (<span class="conid">Value</span> <span class="keyglyph">-&gt;</span> <span class="conid">Cell</span>) <span class="varid">mkAfter</span> <span class="varid">vs</span> <span class="keyglyph">=</span> <span class="keyglyph">\</span><span class="varid">v</span> <span class="keyglyph">-&gt;</span> <span class="conid">Map</span><span class="varop">.</span><span class="varid">findWithDefault</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">empty</span> <span class="varid">v</span> <span class="varid">afters</span> <span class="keyword">where</span> <span class="varid">afters</span> <span class="keyglyph">=</span> <span class="conid">Map</span><span class="varop">.</span><span class="varid">fromListWith</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">union</span> <span class="varop">\$</span> <span class="varid">zip</span> <span class="varid">vs</span> (<span class="varid">map</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">singleton</span> <span class="varop">\$</span> <span class="varid">tail</span> <span class="varid">vs</span>) </pre><h2><a name="row-data-type"></a>Row data type </h2> <p>In the <tt><span class="conid">Row</span></tt> datatype we put all the information we have: </p><ul><li> The cells in the row</li> <li> What values can come before and after a value</li> <li> The values at the edges</li> </ul><pre class="haskell"><span class="keyword">data</span> <span class="conid">Row</span> <span class="keyglyph">=</span> <span class="conid">Row</span> { <span class="varid">cells</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Cell</span><span class="listcon">]</span> , <span class="varid">before</span>, <span class="varid">after</span> <span class="keyglyph">::</span> <span class="conid">Value</span> <span class="keyglyph">-&gt;</span> <span class="conid">Cell</span> , <span class="varid">start</span>, <span class="varid">end</span> <span class="keyglyph">::</span> <span class="conid">Cell</span> } </pre><p>Some simple <tt><span class="conid">Show</span></tt> and <tt><span class="conid">Eq</span></tt> instances: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Show</span> <span class="conid">Row</span> <span class="keyword">where</span> <span class="varid">show</span> <span class="varid">row</span> <span class="keyglyph">=</span> <span class="str">&quot;[&quot;</span> <span class="varop">++</span> <span class="varid">concatMap</span> <span class="varid">show</span> (<span class="varid">rowStates</span> <span class="varid">row</span>) <span class="varop">++</span> <span class="str">&quot;]&quot;</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Eq</span> <span class="conid">Row</span> <span class="keyword">where</span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">cells</span> <span class="varid">a</span> <span class="varop">==</span> <span class="varid">cells</span> <span class="varid">b</span> </pre><p>To construct a row we first make a labeling for the clues. Then we can determine what comes after each value, and what comes after each value in the reversed labeling (and hence comes before it in the normal order). </p><pre class="haskell"><span class="varid">mkRow</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="varid">mkRow</span> <span class="varid">width</span> <span class="varid">clue</span> <span class="keyglyph">=</span> <span class="conid">Row</span> { <span class="varid">cells</span> <span class="keyglyph">=</span> <span class="varid">replicate</span> <span class="varid">width</span> (<span class="conid">Set</span><span class="varop">.</span><span class="varid">fromList</span> <span class="varid">l</span>) , <span class="varid">before</span> <span class="keyglyph">=</span> <span class="varid">mkAfter</span> (<span class="varid">reverse</span> <span class="varid">l</span>) , <span class="varid">after</span> <span class="keyglyph">=</span> <span class="varid">mkAfter</span> <span class="varid">l</span> , <span class="varid">start</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">singleton</span> <span class="varop">\$</span> <span class="varid">head</span> <span class="varid">l</span> , <span class="varid">end</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">singleton</span> <span class="varop">\$</span> <span class="varid">last</span> <span class="varid">l</span> } <span class="keyword">where</span> <span class="varid">l</span> <span class="keyglyph">=</span> <span class="varid">labeling</span> <span class="varid">clue</span> </pre><h2><a name="actually-solving-something"></a>Actually solving something </h2> <p>Now all the things are in place to solve our row: For each cell we can determine what values can come after it, so we can filter the next cell using this information. To be more precise, we can take the intersection of the set of values in a cell with the set of values that can occur after the previous cell. In this way we can make a <em>forward</em> pass through the row: </p><pre class="haskell"><span class="varid">solveForward</span>, <span class="varid">solveBackward</span> <span class="keyglyph">::</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="varid">solveForward</span> <span class="varid">row</span> <span class="keyglyph">=</span> <span class="varid">row</span> { <span class="varid">cells</span> <span class="keyglyph">=</span> <span class="varid">newCells</span> (<span class="varid">start</span> <span class="varid">row</span>) (<span class="varid">cells</span> <span class="varid">row</span>) } <span class="keyword">where</span> <span class="varid">newCells</span> <span class="varid">_</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">newCells</span> <span class="varid">prev</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="keyglyph">=</span> <span class="varid">x'</span> <span class="listcon">:</span> <span class="varid">newCells</span> <span class="varid">x'</span> <span class="varid">xs</span> <span class="keyword">where</span> <span class="varid">x'</span> <span class="keyglyph">=</span> <span class="varid">x</span> <span class="varop">`Set.intersection`</span> <span class="varid">afterPrev</span> <span class="varid">afterPrev</span> <span class="keyglyph">=</span> <span class="varid">unionMap</span> (<span class="varid">after</span> <span class="varid">row</span>) <span class="varid">prev</span> </pre><p>Applying <tt><span class="varid">solveForward</span></tt> to the example row above, we get </p><p><img src="image/nonogram/nonogram-row2-labeled.png" style="vertical-align:middle;margin-left:2em;" alt=""><span style="padding:0 26px 12px 23px;margin:0 1em 0 0.4em;background:url(image/nonogram/arrow-right2.png) no-repeat bottom right;"><tt><span class="varid">solveForward</span></tt></span><img src="image/nonogram/nonogram-row3-labeled.png" style="vertical-align:middle;" alt=""> </p><p>In much the same way we can do a <em>backwards</em> pass. Instead of duplicating the code from <tt><span class="varid">solveForward</span></tt> it is easier to reverse the row, do a forward pass and then reverse the row again: </p><pre class="haskell"><span class="varid">solveBackward</span> <span class="keyglyph">=</span> <span class="varid">reverseRow</span> <span class="varop">.</span> <span class="varid">solveForward</span> <span class="varop">.</span> <span class="varid">reverseRow</span> </pre><p>Where <tt><span class="varid">reverseRow</span></tt> reverses the <tt><span class="varid">cells</span></tt> and swaps <tt><span class="varid">before</span></tt>/<tt><span class="varid">after</span></tt> and <tt><span class="varid">start</span></tt>/<tt><span class="varid">end</span></tt>: </p><pre class="haskell"><span class="varid">reverseRow</span> <span class="keyglyph">::</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="varid">reverseRow</span> <span class="varid">row</span> <span class="keyglyph">=</span> <span class="conid">Row</span> { <span class="varid">cells</span> <span class="keyglyph">=</span> <span class="varid">reverse</span> (<span class="varid">cells</span> <span class="varid">row</span>) , <span class="varid">before</span> <span class="keyglyph">=</span> <span class="varid">after</span> <span class="varid">row</span>, <span class="varid">after</span> <span class="keyglyph">=</span> <span class="varid">before</span> <span class="varid">row</span> , <span class="varid">start</span> <span class="keyglyph">=</span> <span class="varid">end</span> <span class="varid">row</span>, <span class="varid">end</span> <span class="keyglyph">=</span> <span class="varid">start</span> <span class="varid">row</span> } </pre><p>In the running example even more cells will be known after doing a backwards pass, </p><p><img src="image/nonogram/nonogram-row3-labeled.png" style="vertical-align:middle;margin-left:2em;" alt=""><span style="padding:0 26px 12px 23px;margin:0 1em 0 0.1em;background:url(image/nonogram/arrow-right2.png) no-repeat bottom right;"><tt><span class="varid">solveBackward</span></tt></span><img src="image/nonogram/nonogram-row4-labeled.png" style="vertical-align:middle;margin-right:-4em;" alt=""> </p><p>These two steps together are as far as we are going to get with a single row, so let's package them up: </p><pre class="haskell"><span class="varid">solveRow</span> <span class="keyglyph">::</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="varid">solveRow</span> <span class="keyglyph">=</span> <span class="varid">solveBackward</span> <span class="varop">.</span> <span class="varid">solveForward</span> </pre><p>In the end we hopefully have a row that is completely solved, or we might h We can determine whether this is the case by looking at the <tt><span class="conid">CellState</span></tt>s of the cells: </p><pre class="haskell"><span class="varid">rowStates</span> <span class="keyglyph">::</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="conid">CellState</span><span class="listcon">]</span> <span class="varid">rowStates</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="varid">cellState</span> <span class="varop">.</span> <span class="varid">cells</span> <div class='empty-line'></div> <span class="varid">rowDone</span>, <span class="varid">rowFailed</span> <span class="keyglyph">::</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="conid">Bool</span> <span class="varid">rowDone</span> <span class="keyglyph">=</span> <span class="varid">not</span> <span class="varop">.</span> <span class="varid">any</span> (<span class="varop">==</span> <span class="conid">Indeterminate</span>) <span class="varop">.</span> <span class="varid">rowStates</span> <span class="varid">rowFailed</span> <span class="keyglyph">=</span> <span class="varid">any</span> (<span class="varop">==</span> <span class="conid">Error</span>) <span class="varop">.</span> <span class="varid">rowStates</span> </pre><h2><a name="human-solution-strategies"></a>Human solution strategies </h2> <p>By using just one single solution strategy we can in fact emulate most of the techniques humans use. The <a href="http://en.wikipedia.org/wiki/Nonogram">Wikipedia page on nongrams</a> lists several of these techniques. For instance, the <em>simple boxes</em> technique is illustrated with the example:<br> <img src="http://upload.wikimedia.org/wikipedia/commons/9/9b/Paint_by_numbers_-_Solving_-_Example1.png" style="vertical-align:middle;margin-left:2em; alt=""> </p><p>The Haskell program gives the same result: </p><pre class="ghci"><span class="input">Nonograms&gt;</span> <span class="varid">solveRow</span> <span class="varop">\$</span> <span class="varid">mkRow</span> <span class="num">10</span> <span class="listcon">[</span><span class="num">8</span><span class="listcon">]</span> [??######??] </pre><p>The reason why humans need many different techniques, while a single technique suffices for the program is that this simple technique requires a huge amount of administration. For each cell there is a while set of values, which would never fit into the small square grid of a puzzle. </p><h2><a name="the-whole-puzzle"></a>The whole puzzle </h2> <p>Just a single row, or even a list of rows is not enough. In a whole nonogram there are clues for both the rows and the columns. So, let's make a data type to hold both: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Puzzle</span> <span class="keyglyph">=</span> <span class="conid">Puzzle</span> { <span class="varid">rows</span>, <span class="varid">columns</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Row</span><span class="listcon">]</span> } <span class="keyword">deriving</span> <span class="conid">Eq</span> </pre><p>And a function for constructing the <tt><span class="conid">Puzzle</span></tt> from a list of clues, </p><pre class="haskell"><span class="varid">mkPuzzle</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="listcon">[</span><span class="conid">Int</span><span class="listcon">]</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="varid">mkPuzzle</span> <span class="varid">rowClues</span> <span class="varid">colClues</span> <span class="keyglyph">=</span> <span class="conid">Puzzle</span> { <span class="varid">rows</span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">mkRow</span> (<span class="varid">length</span> <span class="varid">colClues</span>)) <span class="varid">rowClues</span> , <span class="varid">columns</span> <span class="keyglyph">=</span> <span class="varid">map</span> (<span class="varid">mkRow</span> (<span class="varid">length</span> <span class="varid">rowClues</span>)) <span class="varid">colClues</span> } </pre><p>To display a puzzle we show the rows, </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Show</span> <span class="conid">Puzzle</span> <span class="keyword">where</span> <span class="varid">show</span> <span class="keyglyph">=</span> <span class="varid">unlines</span> <span class="varop">.</span> <span class="varid">map</span> <span class="varid">show</span> <span class="varop">.</span> <span class="varid">rows</span> <span class="varid">showList</span> <span class="keyglyph">=</span> <span class="varid">showString</span> <span class="varop">.</span> <span class="varid">unlines</span> <span class="varop">.</span> <span class="varid">map</span> <span class="varid">show</span> </pre><p>Initially the puzzle grids are a bit boring, for example entering in GHCi </p><pre class="ghci"><img src="image/nonogram/nonogram-small1.png" style="float:right;margin:3px;" alt=""><span class="conid">Nonograms</span><span class="varop">&gt;</span> <span class="varid">mkPuzzle</span> <span class="listcon">[</span><span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span>,<span class="listcon">[</span><span class="num">3</span><span class="listcon">]</span>,<span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span><span class="listcon">]</span> <span class="listcon">[</span><span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span>,<span class="listcon">[</span><span class="num">3</span><span class="listcon">]</span>,<span class="listcon">[</span><span class="num">1</span><span class="listcon">]</span><span class="listcon">]</span> [???] [???] [???] </pre><p>We already know how to solve a single row, so solving a whole list of rows is not much harder, </p><pre class="haskell"><span class="varid">stepRows</span> <span class="keyglyph">::</span> <span class="conid">Puzzle</span> <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="varid">stepRows</span> <span class="varid">puzzle</span> <span class="keyglyph">=</span> <span class="varid">puzzle</span> { <span class="varid">rows</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="varid">solveRow</span> (<span class="varid">rows</span> <span class="varid">puzzle</span>) } </pre><p>Continuing in GHCi: </p><pre class="ghci"><img src="image/nonogram/nonogram-small2.png" style="float:right;margin:3px;" alt=""><span class="conid">Nonograms</span><span class="varop">&gt;</span> <span class="varid">stepRows</span> <span class="varid">previousPuzzle</span> [???] [###] [???] </pre><p>To also solve the columns we can use the same trick as with <tt><span class="varid">reverseRow</span></tt>, this time transposing the puzzle by swapping rows and columns. </p><pre class="haskell"><span class="varid">transposePuzzle</span> <span class="keyglyph">::</span> <span class="conid">Puzzle</span> <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="varid">transposePuzzle</span> (<span class="conid">Puzzle</span> <span class="varid">rows</span> <span class="varid">cols</span>) <span class="keyglyph">=</span> <span class="conid">Puzzle</span> <span class="varid">cols</span> <span class="varid">rows</span> </pre><p>But this doesn't actually help anything! We still display only the rows, and what happens there is not affected by the values in the columns. Of course when a certain cell in a row is filled (its <tt><span class="varid">cellState</span></tt> is <tt><span class="conid">Filled</span></tt>), then we know that the cell in the corresponding column is also filled. We can therefore filter that cell by removing all blank values </p><pre class="haskell"><span class="varid">filterCell</span> <span class="keyglyph">::</span> <span class="conid">CellState</span> <span class="keyglyph">-&gt;</span> <span class="conid">Cell</span> <span class="keyglyph">-&gt;</span> <span class="conid">Cell</span> <span class="varid">filterCell</span> <span class="conid">Blank</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">filter</span> <span class="varid">blank</span> <span class="varid">filterCell</span> <span class="conid">Filled</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">filter</span> <span class="varid">filled</span> <span class="varid">filterCell</span> <span class="varid">_</span> <span class="keyglyph">=</span> <span class="varid">id</span> </pre><p>A whole row can be filtered by filtering each cell, </p><pre class="haskell"><span class="varid">filterRow</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">CellState</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="varid">filterRow</span> <span class="varid">states</span> <span class="varid">row</span> <span class="keyglyph">=</span> <span class="varid">row</span> { <span class="varid">cells</span> <span class="keyglyph">=</span> <span class="varid">zipWith</span> <span class="varid">filterCell</span> <span class="varid">states</span> (<span class="varid">cells</span> <span class="varid">row</span>) } </pre><p>By transposing the list of states for each row we get a list of states for the columns. With <tt><span class="varid">filterRow</span></tt> the column cells are then filtered. </p><pre class="haskell"><span class="varid">stepCombine</span> <span class="keyglyph">::</span> <span class="conid">Puzzle</span> <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="varid">stepCombine</span> <span class="varid">puzzle</span> <span class="keyglyph">=</span> <span class="varid">puzzle</span> { <span class="varid">columns</span> <span class="keyglyph">=</span> <span class="varid">zipWith</span> <span class="varid">filterRow</span> <span class="varid">states</span> (<span class="varid">columns</span> <span class="varid">puzzle</span>) } <span class="keyword">where</span> <span class="varid">states</span> <span class="keyglyph">=</span> <span class="varid">transpose</span> <span class="varop">\$</span> <span class="varid">map</span> <span class="varid">rowStates</span> <span class="varop">\$</span> <span class="varid">rows</span> <span class="varid">puzzle</span> </pre><p>To solve the puzzle we apply <tt><span class="varid">stepRows</span></tt> and <tt><span class="varid">stepCombine</span></tt> alternatingly to the rows and to the columns. When to stop this iteration? We could stop when the puzzle is done, but not all puzzles can be solved this way. A better aproach is to take the fixed point: </p><pre class="haskell"><span class="varid">solveDirect</span> <span class="keyglyph">::</span> <span class="conid">Puzzle</span> <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="varid">solveDirect</span> <span class="keyglyph">=</span> <span class="varid">fixedPoint</span> (<span class="varid">step</span> <span class="varop">.</span> <span class="varid">step</span>) <span class="keyword">where</span> <span class="varid">step</span> <span class="keyglyph">=</span> <span class="varid">transposePuzzle</span> <span class="varop">.</span> <span class="varid">stepCombine</span> <span class="varop">.</span> <span class="varid">stepRows</span> </pre><p>The fixed point of a function <tt><span class="varid">f</span></tt> is the value <tt><span class="varid">x</span></tt> such that <tt class='complex'><span class="varid">x</span> <span class="varop">==</span> <span class="varid">f</span> <span class="varid">x</span></tt>. Note that there are different fixed points, but the one we are interested in here is found by simply iterating <tt><span class="varid">x</span></tt>, <tt class='complex'><span class="varid">f</span> <span class="varid">x</span></tt>, <tt class='complex'><span class="varid">f</span> (<span class="varid">f</span> <span class="varid">x</span>)</tt>, ... </p><pre class="haskell"><span class="varid">fixedPoint</span> <span class="keyglyph">::</span> <span class="conid">Eq</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span> <span class="varid">fixedPoint</span> <span class="varid">f</span> <span class="varid">x</span> <span class="keyglyph">|</span> <span class="varid">x</span> <span class="varop">==</span> <span class="varid">fx</span> <span class="keyglyph">=</span> <span class="varid">x</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">fixedPoint</span> <span class="varid">f</span> <span class="varid">fx</span> <span class="keyword">where</span> <span class="varid">fx</span> <span class="keyglyph">=</span> <span class="varid">f</span> <span class="varid">x</span> </pre><p>The tiny 3*3 example can now be solved: </p><pre class="ghci"><img src="image/nonogram/nonogram-small3.png" style="float:right;margin:3px;" alt=""><span class="conid">Nonograms</span><span class="varop">&gt;</span> <span class="varid">solveDirect</span> <span class="varid">previousPuzzle</span> [.#.] [###] [.#.] </pre><p>But for other puzzles, such as the letter lambda from the introduction, we have no such luck: </p><pre class="ghci"><span class="input">Nonograms&gt;</span> <span class="varid">solveDirect</span> <span class="varid">lambdaPuzzle</span> [??????????] [??????????] ... </pre><h2><a name="guessing"></a>Guessing </h2> <p>To solve more difficult puzzles the direct reasoning approach is not enough. To still solve these puzzles we need to make a <em>guess</em>, and backtrack if it is wrong. </p><p>Note that there are puzzles with more than one solution, for example<br> <img src="image/nonogram/nonogram-grid1.png" style="vertical-align:middle;margin-left:2em;margin-right:1em;margin-top:2px;" alt="">and <img src="image/nonogram/nonogram-grid2.png" style="vertical-align:middle;margin-left:1em;margin-top:2px;" alt=""> </p><p>To find <em>all</em> solutions, and not just the first one, we can use the list monad. </p><p>To make a guess we can pick a cell that has multiple values in its set, and for each of these values see what happens if the cell contains just that value. Since there are many cells in a puzzle there are also many cells to choose from when we need to guess. It is a good idea to pick the <em>best one</em>. </p><p>For picking the best alternative a pair of a value and a <em>score</em> can be used: </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Scored</span> <span class="varid">m</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Scored</span> { <span class="varid">best</span> <span class="keyglyph">::</span> <span class="varid">m</span> <span class="varid">a</span>, <span class="varid">score</span> <span class="keyglyph">::</span> <span class="conid">Int</span> } </pre><p>This data type is an applicative functor if we use <tt><span class="num">0</span></tt> as a default score: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Functor</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Functor</span> (<span class="conid">Scored</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">fmap</span> <span class="varid">f</span> (<span class="conid">Scored</span> <span class="varid">a</span> <span class="varid">i</span>) <span class="keyglyph">=</span> <span class="conid">Scored</span> (<span class="varid">fmap</span> <span class="varid">f</span> <span class="varid">a</span>) <span class="varid">i</span> <span class="keyword">instance</span> <span class="conid">Applicative</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Applicative</span> (<span class="conid">Scored</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">pure</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="conid">Scored</span> (<span class="varid">pure</span> <span class="varid">a</span>) <span class="num">0</span> <span class="conid">Scored</span> <span class="varid">f</span> <span class="varid">n</span> <span class="varop">&lt;*&gt;</span> <span class="conid">Scored</span> <span class="varid">x</span> <span class="varid">m</span> <span class="keyglyph">=</span> <span class="conid">Scored</span> (<span class="varid">f</span> <span class="varop">&lt;*&gt;</span> <span class="varid">x</span>) (<span class="varid">n</span> <span class="varop">`min`</span> <span class="varid">m</span>) </pre><p>When there are alternatives we want to pick the best one, the one with the highest score: </p><pre class="haskell"><span class="keyword">instance</span> <span class="conid">Alternative</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> <span class="conid">Alternative</span> (<span class="conid">Scored</span> <span class="varid">m</span>) <span class="keyword">where</span> <span class="varid">empty</span> <span class="keyglyph">=</span> <span class="conid">Scored</span> <span class="varid">empty</span> <span class="varid">minBound</span> <span class="varid">a</span> <span class="varop">&lt;|&gt;</span> <span class="varid">b</span> <span class="keyglyph">|</span> <span class="varid">score</span> <span class="varid">a</span> <span class="varop">&gt;=</span> <span class="varid">score</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="varid">a</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="varid">b</span> </pre><p>Now given a list we can apply a function to each element, but change only the best one. This way we can find the best cell to guess and immediately restrict it to a single alternative. We can do this by simply enumerating all ways to change a single element in a list. </p><pre class="haskell"><span class="varid">mapBest</span> <span class="keyglyph">::</span> <span class="conid">Alternative</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> (<span class="varid">a</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="varid">mapBest</span> <span class="varid">_</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="keyglyph">=</span> <span class="varid">pure</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">mapBest</span> <span class="varid">f</span> (<span class="varid">x</span><span class="listcon">:</span><span class="varid">xs</span>) <span class="keyglyph">=</span> (<span class="listcon">:</span><span class="varid">xs</span>) <span class="varop">&lt;\$&gt;</span> <span class="varid">f</span> <span class="varid">x</span> <span class="comment">-- change x and keep the tail</span> <span class="varop">&lt;|&gt;</span> (<span class="varid">x</span><span class="listcon">:</span>) <span class="varop">&lt;\$&gt;</span> <span class="varid">mapBest</span> <span class="varid">f</span> <span class="varid">xs</span> <span class="comment">-- change the tail and keep x</span> </pre><p>This can also be generalized to <tt><span class="conid">Row</span></tt>s and whole <tt><span class="conid">Puzzle</span></tt>s: </p><pre class="haskell"><span class="varid">mapBestRow</span> <span class="keyglyph">::</span> <span class="conid">Alternative</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Cell</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="conid">Cell</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Row</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="conid">Row</span> <span class="varid">mapBestRow</span> <span class="varid">f</span> <span class="varid">row</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">setCells</span> <span class="varop">\$</span> <span class="varid">mapBest</span> <span class="varid">f</span> <span class="varop">\$</span> <span class="varid">cells</span> <span class="varid">row</span> <span class="keyword">where</span> <span class="varid">setCells</span> <span class="varid">cells'</span> <span class="keyglyph">=</span> <span class="varid">row</span> { <span class="varid">cells</span> <span class="keyglyph">=</span> <span class="varid">cells'</span> } <div class='empty-line'></div> <span class="varid">mapBestRows</span> <span class="keyglyph">::</span> <span class="conid">Alternative</span> <span class="varid">m</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Cell</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="conid">Cell</span>) <span class="keyglyph">-&gt;</span> <span class="conid">Puzzle</span> <span class="keyglyph">-&gt;</span> <span class="varid">m</span> <span class="conid">Puzzle</span> <span class="varid">mapBestRows</span> <span class="varid">f</span> <span class="varid">puzzle</span> <span class="keyglyph">=</span> <span class="varid">fmap</span> <span class="varid">setRows</span> <span class="varop">\$</span> <span class="varid">mapBest</span> (<span class="varid">mapBestRow</span> <span class="varid">f</span>) <span class="varop">\$</span> <span class="varid">rows</span> <span class="varid">puzzle</span> <span class="keyword">where</span> <span class="varid">setRows</span> <span class="varid">rows'</span> <span class="keyglyph">=</span> <span class="varid">puzzle</span> { <span class="varid">rows</span> <span class="keyglyph">=</span> <span class="varid">rows'</span> } </pre><p>What is the best cell to guess? A simple idea is to use the cell with the most alternatives, in the hope of eliminating as many of them as soon as possible. Then the score of a cell is the size of its set. The alternatives are a singleton set for each value in the cell. </p><pre class="haskell"><span class="varid">guessCell</span> <span class="keyglyph">::</span> <span class="conid">Cell</span> <span class="keyglyph">-&gt;</span> <span class="conid">Scored</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="conid">Cell</span> <span class="varid">guessCell</span> <span class="varid">cell</span> <span class="keyglyph">=</span> <span class="conid">Scored</span> { <span class="varid">best</span> <span class="keyglyph">=</span> <span class="varid">map</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">singleton</span> <span class="varop">\$</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">toList</span> <span class="varid">cell</span> , <span class="varid">score</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop&qu