Twan van Laarhoven's blog http://twanvl.nl/blog 2018-01-04T21:18:00Z Twan van Laarhoven blog@twanvl.nl Type theory with indexed equality - the theory http://twanvl.nl/blog/hott/ttie-theory 2018-01-04T21:18:00Z <p>In <a href="https://www.twanvl.nl/blog/hott/indexed-equality-implementation">a previous post</a> I introduced the TTIE language, along with a <a href="https://github.com/twanvl/ttie">type checker and interpreter</a>. My motivation for writing that (aside from it being fun!) was to explore the type system. At the time I started this project, formalizing this system as a shallow embedding in Agda was not easy. But with the addition of a rewriting mechanism, it has become much easier to use Agda without going insane from having to put substitutions everywhere. So, in this post I will formalize the TTIE type system. </p><p>This post is literate Agda, and uses my own utility library. The utility library mainly defines automatic rewrite rules like <tt class='complex'><span class="varid">trans</span> <span class="varid">x</span> (<span class="varid">sym</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="agda-ctor">refl</span></tt>, which make life a bit more pleasant. All these rewrites use the standard library propositional equality <tt class='complex'><span class="varop">≡</span></tt>, which I will call <em>meta equality</em>. . All these rewrites use the standard library propositional equality, which I will denote as <tt class='complex'>⟹</tt> and call <em>meta equality</em>. </p><pre class="agda"><span class="pragma">{-# OPTIONS --rewriting #-}</span> <span class="keyword">module</span> <span class="keyglyph">_</span> <span class="keyword">where</span> <div class='empty-line'></div> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Util.Equality</span> <span class="varid">as</span> <span class="conid">Meta</span> <span class="varid">using</span> (<span class="keyglyph">_</span>∎) <span class="keyword">renaming</span> (<span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> <span class="varid">to</span> <span class="keyglyph">_</span>⟹<span class="keyglyph">_</span>; <span class="agda-ctor">refl</span> <span class="varid">to</span> □; <span class="keyglyph">_</span><span class="varop">≡⟨</span><span class="keyglyph">_</span><span class="varop">⟩</span><span class="keyglyph">_</span> <span class="varid">to</span> <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="varop">≡⟨</span><span class="keyglyph">_</span><span class="varop">⟩⁻¹</span><span class="keyglyph">_</span> <span class="varid">to</span> <span class="keyglyph">_</span>⟸<span class="varop">⟨</span><span class="keyglyph">_</span><span class="varop">⟩</span><span class="keyglyph">_</span>) <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Product</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Sum</span> <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Nat</span> <span class="varid">using</span> (<span class="conop">ℕ</span>; <span class="varid">zero</span>; <span class="agda-ctor">suc</span>) <span class="keyword">open</span> <span class="keyword">import</span> <span class="conid">Data.Vec</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">Level</span> <span class="keyword">renaming</span> (<span class="agda-ctor">zero</span> <span class="varid">to</span> <span class="varid">lzero</span>; <span class="agda-ctor">suc</span> <span class="varid">to</span> <span class="varid">lsuc</span>) </pre><p>First we postulate the existence of the interval. I will abbreviate the interval type as <tt><span class="conid">I</span></tt>. </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">I</span> <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyword">postulate</span> <span class="agda-ctor">i₀</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyword">postulate</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">:</span> <span class="conid">I</span> </pre><p>The canonical eliminator for the interval needs equalities, to show that <tt class='complex'><span class="agda-ctor">i₀</span></tt> and <tt class='complex'><span class="agda-ctor">i₁</span></tt> are mapped to equal values. But we haven't defined those yet. However, there is one eliminator that we can define, namely into <tt><span class="conid">I</span></tt>, since values in <tt><span class="conid">I</span></tt> are always equal. </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">icase</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyword">postulate</span> <span class="agda-fun">icase-i₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="varid">a</span> <span class="varid">b</span> <span class="agda-ctor">i₀</span> ⟹ <span class="varid">a</span> <span class="keyword">postulate</span> <span class="agda-fun">icase-i₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="varid">a</span> <span class="varid">b</span> <span class="agda-ctor">i₁</span> ⟹ <span class="varid">b</span> <span class="pragma">{-# REWRITE icase-i₀ icase-i₁ #-}</span> </pre><p>And with this <tt><span class="agda-fun">icase</span></tt> construct, we can define conjunction, disjunction, and negation </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">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">j</span> <span class="varid">i</span> <div class='empty-line'></div> <span class="keyglyph">_</span><span class="keyglyph">|</span><span class="keyglyph">|</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="varid">i</span> <span class="keyglyph">|</span><span class="keyglyph">|</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-fun">icase</span> <span class="varid">j</span> <span class="agda-ctor">i₁</span> <span class="varid">i</span> <div class='empty-line'></div> <span class="agda-fun">inot</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="agda-fun">inot</span> <span class="keyglyph">=</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₀</span> </pre><p>We can define some extra computation rules based on the principle that when evaluating <tt class='complex'><span class="agda-fun">icase</span> <span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span></tt>, if we use the <tt><span class="varid">a</span></tt> branch then <tt class='complex'><span class="varid">c</span> <span class="keyglyph">=</span> <span class="agda-ctor">i₀</span></tt>, and similarly for <tt><span class="varid">b</span></tt>. </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">icase-same</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> (<span class="varid">a</span> <span class="varid">b</span> <span class="varid">c</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span>) <span class="varid">d</span> <span class="keyglyph">→</span> <span class="varid">a</span> <span class="agda-ctor">i₀</span> ⟹ <span class="varid">c</span> <span class="agda-ctor">i₀</span> <span class="keyglyph">→</span> <span class="varid">b</span> <span class="agda-ctor">i₁</span> ⟹ <span class="varid">c</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> (<span class="varid">a</span> <span class="varid">d</span>) (<span class="varid">b</span> <span class="varid">d</span>) <span class="varid">d</span> ⟹ <span class="varid">c</span> <span class="varid">d</span> <div class='empty-line'></div> <span class="agda-fun">icase-const</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="varid">a</span> <span class="varid">a</span> <span class="varid">b</span> ⟹ <span class="varid">a</span> <span class="agda-fun">icase-id</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="agda-ctor">i₁</span> <span class="varid">a</span> ⟹ <span class="varid">a</span> <span class="agda-fun">icase-i₀-x</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">b</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">b</span> <span class="varid">b</span> ⟹ <span class="varid">b</span> <span class="agda-fun">icase-i₁-x</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">b</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="varid">b</span> <span class="varid">b</span> ⟹ <span class="agda-ctor">i₁</span> <span class="agda-fun">icase-x-i₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="varid">a</span> <span class="agda-ctor">i₀</span> <span class="varid">a</span> ⟹ <span class="agda-ctor">i₀</span> <span class="agda-fun">icase-x-i₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">a</span> <span class="keyglyph">→</span> <span class="agda-fun">icase</span> <span class="varid">a</span> <span class="agda-ctor">i₁</span> <span class="varid">a</span> ⟹ <span class="varid">a</span> <div class='empty-line'></div> <details><summary class="comment">Show implementation</summary><span class="agda-fun">icase-const</span> <span class="varid">a</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> (<span class="varid">const</span> <span class="varid">a</span>) (<span class="varid">const</span> <span class="varid">a</span>) (<span class="varid">const</span> <span class="varid">a</span>) <span class="varid">b</span> □ □ <span class="agda-fun">icase-id</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> (<span class="varid">const</span> <span class="agda-ctor">i₀</span>) (<span class="varid">const</span> <span class="agda-ctor">i₁</span>) <span class="varid">id</span> <span class="varid">a</span> □ □ <span class="agda-fun">icase-i₀-x</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> (<span class="varid">const</span> <span class="agda-ctor">i₀</span>) <span class="varid">id</span> <span class="varid">id</span> <span class="varid">b</span> □ □ <span class="agda-fun">icase-i₁-x</span> <span class="varid">b</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> (<span class="varid">const</span> <span class="agda-ctor">i₁</span>) <span class="varid">id</span> (<span class="varid">const</span> <span class="agda-ctor">i₁</span>) <span class="varid">b</span> □ □ <span class="agda-fun">icase-x-i₀</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> <span class="varid">id</span> (<span class="varid">const</span> <span class="agda-ctor">i₀</span>) (<span class="varid">const</span> <span class="agda-ctor">i₀</span>) <span class="varid">a</span> □ □ <span class="agda-fun">icase-x-i₁</span> <span class="varid">a</span> <span class="keyglyph">=</span> <span class="agda-fun">icase-same</span> <span class="varid">id</span> (<span class="varid">const</span> <span class="agda-ctor">i₁</span>) <span class="varid">id</span> <span class="varid">a</span> □ □ <div class='empty-line'></div> <span class="pragma">{-# REWRITE icase-const #-}</span> <span class="pragma">{-# REWRITE icase-id #-}</span> <span class="pragma">{-# REWRITE icase-i₀-x #-}</span> <span class="pragma">{-# REWRITE icase-i₁-x #-}</span> <span class="pragma">{-# REWRITE icase-x-i₀ #-}</span> <span class="pragma">{-# REWRITE icase-x-i₁ #-}</span> </details></pre><h2><a name="the-equality-type"></a>The equality type</h2> <p>We can now define the indexed equality type </p><pre class="agda"><span class="keyword">data</span> <span class="agda-fun">Eq</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">:</span> A <span class="agda-ctor">i₀</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> <span class="keyword">where</span> <span class="agda-ctor">refl</span> <span class="keyglyph">:</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">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>For convenience we write the non-indexed object level equality as </p><pre class="agda"><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 <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="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> {A <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="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A) <span class="varid">x</span> <span class="varid">y</span> </pre><p>And now that we have equalities, we can write down the the general dependent eliminator for the interval, </p><pre class="agda"><span class="keyword">postulate</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 <span class="varid">x</span> <span class="varid">y</span>} <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> {<span class="varid">a</span>} A <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">I</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="keyword">postulate</span> <span class="varop">^-i₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">x</span> <span class="varid">y</span>} <span class="varid">x≡y</span> <span class="keyglyph">→</span> <span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> {<span class="varid">a</span>} {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">x≡y</span> <span class="agda-ctor">i₀</span> ⟹ <span class="varid">x</span> <span class="keyword">postulate</span> <span class="varop">^-i₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">x</span> <span class="varid">y</span>} <span class="varid">x≡y</span> <span class="keyglyph">→</span> <span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> {<span class="varid">a</span>} {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">x≡y</span> <span class="agda-ctor">i₁</span> ⟹ <span class="varid">y</span> <span class="keyword">postulate</span> <span class="varop">^-refl</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A} <span class="varid">x</span> <span class="keyglyph">→</span> <span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> {<span class="varid">a</span>} {A} {<span class="varid">x</span> <span class="agda-ctor">i₀</span>} {<span class="varid">x</span> <span class="agda-ctor">i₁</span>} (<span class="agda-ctor">refl</span> <span class="varid">x</span>) ⟹ <span class="varid">x</span> <span class="pragma">{-# REWRITE ^-i₀ ^-i₁ ^-refl #-}</span> <span class="keyword">infixl</span> <span class="num">6</span> <span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> </pre><p>At the same time, the <tt class='complex'><span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span></tt> operator also functions as an eliminator for <tt><span class="agda-fun">Eq</span></tt>, projecting out the argument to <tt><span class="agda-ctor">refl</span></tt>. This also means that we have the following eta contraction rule </p><pre class="agda"><span class="agda-fun">refl-eta</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">x</span> <span class="varid">y</span>} (<span class="varid">x≡y</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">x≡y</span> <span class="varop">^</span> <span class="varid">i</span>) ⟹ <span class="varid">x≡y</span> <span class="comment">-- HIDE a</span> <span class="agda-fun">refl-eta</span> (<span class="agda-ctor">refl</span> <span class="varid">x</span>) <span class="keyglyph">=</span> □ <span class="pragma">{-# REWRITE refl-eta #-}</span> </pre><p>These definitions are enough to state some object level theorems, such as function extensionality </p><pre class="agda"><span class="agda-fun">ext</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="varid">f</span> <span class="varid">g</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="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>) <span class="keyglyph">→</span> <span class="varid">f</span> <span class="varop">≡</span> <span class="varid">g</span> <span class="comment">-- HIDE a</span> <span class="agda-fun">ext</span>′ <span class="varid">f≡g</span> <span class="keyglyph">=</span> <span class="agda-ctor">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> <span class="varid">f≡g</span> <span class="varid">x</span> <span class="varop">^</span> <span class="varid">i</span> </pre><p>congruence, </p><pre class="agda"><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="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) {<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">f</span> <span class="varid">y</span> <span class="comment">-- HIDE a|b</span> <span class="agda-fun">cong</span>′ <span class="varid">f</span> <span class="varid">x≡y</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">f</span> (<span class="varid">x≡y</span> <span class="varop">^</span> <span class="varid">i</span>) </pre><p>and symmetry of <tt class='complex'><span class="varop">≡</span></tt>, </p><pre class="agda"><span class="agda-fun">sym</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">x</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="keyglyph">→</span> <span class="varid">y</span> <span class="varop">≡</span> <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="agda-fun">sym</span>′ <span class="varid">x≡y</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">x≡y</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">i</span> </pre><p>We can also define dependent versions of all of the above, which are the same, only with more general types. I'll leave these as an exercise for the reader. </p><pre class="agda"><details><summary class="comment">spoiler</summary><span class="agda-fun">sym</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="conid">I</span> <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> <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> (A <span class="varop">∘</span> <span class="agda-fun">inot</span>) <span class="varid">y</span> <span class="varid">x</span> <span class="agda-fun">sym</span> <span class="varid">x≡y</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">x≡y</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">i</span> </details></pre><h2><a name="transport"></a>Transport</h2> <p>In general, to make full use of equalities, you would use substitution, also called <em>transport</em>. I will formalize this as </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> A <span class="agda-ctor">i₀</span> <span class="keyglyph">→</span> A <span class="agda-ctor">i₁</span> <span class="comment">-- HIDE a</span> </pre><p>Where <tt><span class="agda-fun">tr</span></tt> stands for transport, since we transport a value of type <tt class='complex'>A <span class="agda-ctor">i₀</span></tt> along <tt>A</tt>, to a value of type <tt class='complex'>A <span class="agda-ctor">i₁</span></tt>. This should be possible, because there is a path between <tt class='complex'><span class="agda-ctor">i₀</span></tt> and <tt class='complex'><span class="agda-ctor">i₁</span></tt>, that is, they are indistinguishable, and because functions are continuous. So <tt>A</tt> is a continuous path between <tt class='complex'>A <span class="agda-ctor">i₀</span></tt> and <tt class='complex'>A <span class="agda-ctor">i₁</span></tt>. In a previous blog post I have used a more general <tt><span class="agda-fun">cast</span></tt> primitive, which can be defined in terms of <tt><span class="agda-fun">tr</span></tt>, </p><pre class="agda"><span class="agda-fun">cast</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="keyglyph">→</span> (<span class="varid">j₀</span> <span class="varid">j₁</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> A <span class="varid">j₀</span> <span class="keyglyph">→</span> A <span class="varid">j₁</span> <span class="comment">-- HIDE a</span> <span class="agda-fun">cast</span> A <span class="varid">j₀</span> <span class="varid">j₁</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A (<span class="agda-fun">icase</span> <span class="varid">j₀</span> <span class="varid">j₁</span> <span class="varid">i</span>)) </pre><p>And now we can define things like the usual substitution </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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} (B <span class="keyglyph">:</span> {<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>} <span class="keyglyph">→</span> A <span class="varid">i</span> <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">Eq</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="comment">-- HIDE a|b</span> <span class="agda-fun">subst</span> B <span class="varid">xy</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B (<span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span>)) </pre><p>and the J axiom </p><pre class="agda"><span class="agda-fun">jay</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>} {<span class="varid">x</span> <span class="keyglyph">:</span> A} (B <span class="keyglyph">:</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="keyglyph">→</span> <span class="agda-fun">Set</span>) <span class="keyglyph">→</span> {<span class="varid">y</span> <span class="keyglyph">:</span> A} <span class="keyglyph">→</span> (<span class="varid">x≡y</span> <span class="keyglyph">:</span> <span class="varid">x</span> <span class="varop">≡</span> <span class="varid">y</span>) <span class="keyglyph">→</span> B (<span class="agda-ctor">refl</span> (<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">x</span>)) <span class="keyglyph">→</span> B <span class="varid">x≡y</span> <span class="agda-fun">jay</span> B <span class="varid">xy</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B {<span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span>} (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">xy</span> <span class="varop">^</span> (<span class="varid">j</span> <span class="varop">&amp;&amp;</span> <span class="varid">i</span>))) </pre><p>Yay, jay! </p><h2><a name="evaluating-transport"></a>Evaluating transport</h2> <p>To be useful as a theory of computation, all primitives in our theory should reduce. In particular, we need to know how to evaluate <tt><span class="agda-fun">tr</span></tt>, at least when it is applied to arguments without free variables. We do this by pattern matching on the first argument of <tt><span class="agda-fun">tr</span></tt>, and defining transport for each type constructor. </p><p>The simplest case is if the type being transported along doesn't depend on the index at all </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-const</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="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A) <span class="varid">x</span> ⟹ <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="pragma">{-# REWRITE tr-const #-}</span> </pre><p>Much more interesting is the case when the type is a function type. To cast function types, we first transport the argument 'back', apply the function, and then transport the result forward. First look at the non-dependent case, i.e. going from <tt class='complex'>A <span class="agda-ctor">i₀</span> <span class="keyglyph">→</span> B <span class="agda-ctor">i₀</span></tt> to <tt class='complex'>A <span class="agda-ctor">i₁</span> <span class="keyglyph">→</span> B <span class="agda-ctor">i₁</span></tt>: </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-arrow</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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">f</span>} <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</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="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> B (<span class="varid">f</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₀</span> <span class="varid">x</span>))) </pre><p>The dependent case is a bit more complicated, since the type of the result depends on the transported argument. The result of the function has type <tt class='complex'>B <span class="agda-ctor">i₀</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₀</span> <span class="varid">x</span>)</tt>, and we have to transport this to <tt class='complex'>B <span class="agda-ctor">i₁</span> <span class="varid">x</span></tt>. So as we go from <tt class='complex'><span class="agda-ctor">i₀</span></tt> to <tt class='complex'><span class="agda-ctor">i₁</span></tt>, we want to "undo" the <tt><span class="agda-fun">cast</span></tt> operation. We can do this by changing both <tt class='complex'><span class="agda-ctor">i₀</span></tt>'s to <tt class='complex'><span class="agda-ctor">i₁</span></tt>'s, to get a value of the type <tt class='complex'>B <span class="agda-ctor">i₁</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₁</span> <span class="varid">x</span>)</tt>. Because <tt class='complex'><span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₁</span> <span class="varid">x</span> ⟹ <span class="varid">x</span></tt> by <tt class='complex'><span class="agda-fun">icase-const</span></tt> and <tt class='complex'><span class="agda-fun">tr-const</span></tt>, this is equivalent to <tt class='complex'>B <span class="agda-ctor">i₁</span> <span class="varid">x</span></tt>. </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-pi</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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> (A <span class="varid">i</span>) <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">f</span>} <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</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">x</span>) <span class="varid">f</span> ⟹ (<span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B <span class="varid">i</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="varid">i</span> <span class="varid">x</span>)) (<span class="varid">f</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₀</span> <span class="varid">x</span>))) </pre><p>Besides function/pi types, there are also product/sigma types. The idea here is similar: transport both parts of the pair independently. Again, the type of the second part can depend on the transported first part, </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-sigma</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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <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="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Σ</span> (A <span class="varid">i</span>) (B <span class="varid">i</span>)) (<span class="varid">x</span> , <span class="varid">y</span>) ⟹ (<span class="agda-fun">tr</span> A <span class="varid">x</span> , <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> B <span class="varid">i</span> (<span class="agda-fun">cast</span> A <span class="agda-ctor">i₀</span> <span class="varid">i</span> <span class="varid">x</span>)) <span class="varid">y</span>) </pre><p>Finally, let's look at sum types, for which we use simple recursion, </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-sum₁</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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">x</span>} <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="conop">⊎</span> B <span class="varid">i</span>) (<span class="varid">inj₁</span> <span class="varid">x</span>) ⟹ <span class="varid">inj₁</span> (<span class="agda-fun">tr</span> A <span class="varid">x</span>) <span class="keyword">postulate</span> <span class="agda-fun">tr-sum₂</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="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} {<span class="varid">x</span>} <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="conop">⊎</span> B <span class="varid">i</span>) (<span class="varid">inj₂</span> <span class="varid">x</span>) ⟹ <span class="varid">inj₂</span> (<span class="agda-fun">tr</span> B <span class="varid">x</span>) </pre><h2><a name="transport-for-equality-types"></a>Transport for equality types</h2> <p>The final type constructors in our language are equality types, and this is where things get more hairy. The idea is that a type like <tt class='complex'><span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span></tt> behaves like <tt>A</tt> in many respects. Its values will just be wrapped in a <tt><span class="agda-ctor">refl</span></tt> constructor. </p><p>Consider the case of equalities over (dependent) function types. The evaluation rule could look like </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-eq-pi</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="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="comment">-- HIDE a|b</span> {B <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} <span class="comment">-- HIDE a|b</span> {<span class="varid">u</span> <span class="keyglyph">:</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="agda-ctor">i₀</span>) <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="agda-ctor">i₀</span> <span class="varid">x</span>} {<span class="varid">v</span> <span class="keyglyph">:</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="agda-ctor">i₁</span>) <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="agda-ctor">i₁</span> <span class="varid">x</span>} {<span class="varid">f₀</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₀</span> <span class="varid">j</span>) <span class="keyglyph">→</span> B <span class="agda-ctor">i₀</span> <span class="varid">j</span> <span class="varid">x</span>) (<span class="varid">u</span> <span class="agda-ctor">i₀</span>) (<span class="varid">v</span> <span class="agda-ctor">i₀</span>)} <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varid">i</span> <span class="varid">j</span>) <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="varid">j</span> <span class="varid">x</span>) (<span class="varid">u</span> <span class="varid">i</span>) (<span class="varid">v</span> <span class="varid">i</span>)) <span class="varid">f₀</span> ⟹ <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="keyglyph">\</span><span class="varid">x</span> <span class="keyglyph">→</span> <span class="keyword">let</span> <span class="varid">x'</span> <span class="keyglyph">=</span> <span class="keyglyph">\</span><span class="varid">i'</span> <span class="varid">j'</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A (<span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="varid">i'</span> <span class="varid">i</span>) (<span class="agda-fun">icase</span> <span class="varid">j</span> <span class="varid">j'</span> <span class="varid">i</span>)) <span class="varid">x</span> <span class="keyword">in</span> (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j'</span> <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="varid">j'</span> (<span class="varid">x'</span> <span class="varid">i</span> <span class="varid">j'</span>)) (<span class="varid">u</span> <span class="varid">i</span> (<span class="varid">x'</span> <span class="varid">i</span> <span class="agda-ctor">i₀</span>)) (<span class="varid">v</span> <span class="varid">i</span> (<span class="varid">x'</span> <span class="varid">i</span> <span class="agda-ctor">i₁</span>))) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j'</span> <span class="keyglyph">→</span> (<span class="varid">f₀</span> <span class="varop">^</span> <span class="varid">j'</span>) (<span class="varid">x'</span> <span class="agda-ctor">i₀</span> <span class="varid">j'</span>))) <span class="varop">^</span> <span class="varid">j</span> </pre><p>Of course the <tt>A</tt> in <tt class='complex'><span class="agda-fun">Eq</span> A <span class="varid">x</span> <span class="varid">y</span></tt> could again be an equality type, and we would have to repeat the construction. To do this systematically, I start by collecting all the 'sides' of the equality type recursively. For example the sides of <tt class='complex'><span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="keyglyph">_</span>) <span class="varid">x</span> <span class="varid">y</span>) <span class="varid">u</span> <span class="varid">v</span>)</tt> are <tt class='complex'><span class="agda-ctor">eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-ctor">eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-ctor">done</span>) <span class="varid">x</span> <span class="varid">y</span>) <span class="varid">u</span> <span class="varid">v</span></tt>, </p><pre class="agda"><span class="varid">mutual</span> <span class="keyword">data</span> <span class="conid">Sides</span> {<span class="varid">a</span>} <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">n</span> (A <span class="keyglyph">:</span> <span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span> <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">lsuc</span> <span class="varid">a</span>) <span class="keyword">where</span> <span class="agda-ctor">done</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A} <span class="keyglyph">→</span> <span class="conid">Sides</span> <span class="agda-ctor">zero</span> A <span class="agda-ctor">eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">n</span> A} <span class="keyglyph">→</span> (<span class="agda-fun">sides</span> <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> <span class="conid">Sides</span> <span class="varid">n</span> (<span class="keyglyph">\</span><span class="varid">is</span> <span class="keyglyph">→</span> A (<span class="varid">i</span> <span class="agda-ctor">∷</span> <span class="varid">is</span>))) <span class="keyglyph">→</span> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="agda-ctor">i₀</span>) <span class="keyglyph">→</span> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="agda-ctor">i₁</span>) <span class="keyglyph">→</span> <span class="conid">Sides</span> (<span class="agda-ctor">suc</span> <span class="varid">n</span>) A <div class='empty-line'></div> <span class="conid">Eqs</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">n</span> A} <span class="keyglyph">→</span> <span class="conid">Sides</span> {<span class="varid">a</span>} <span class="varid">n</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span> <span class="conid">Eqs</span> {A <span class="keyglyph">=</span> A} <span class="agda-ctor">done</span> <span class="keyglyph">=</span> A <span class="agda-ctor">[]</span> <span class="conid">Eqs</span> {A <span class="keyglyph">=</span> A} (<span class="agda-ctor">eq</span> <span class="agda-fun">sides</span> <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> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="varid">i</span>)) <span class="varid">x</span> <span class="varid">y</span> </pre><p>Since <tt class='complex'><span class="conid">I</span> <span class="keyglyph">→</span> A</tt> are the continuous functions out of the 1-dimensional interval, you can think of a <tt class='complex'><span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span> <span class="keyglyph">→</span> A</tt> as a continuous function out of the n-dimensional hypercube. So in geometric terms, we can draw such a function as assigning a value to all elements of the hypercube. Similarly, you can think of <tt class='complex'><span class="conid">Sides</span> {<span class="varid">n</span> <span class="keyglyph">=</span> <span class="varid">n</span>}</tt> as a function out of the n-dimensional hypercube with the central cell removed, and <tt><span class="conid">Eqs</span></tt> as filling in that central cell. <table style="text-align:center"> <tr> <td style="text-align:center"><tt class='complex'><span class="conid">Eqs</span> <span class="num">0</span></tt> <td style="text-align:center"><tt class='complex'><span class="conid">Sides</span> <span class="num">1</span></tt> <td style="text-align:center"><tt class='complex'><span class="conid">Eqs</span> <span class="num">1</span></tt> <td style="text-align:center"><tt class='complex'><span class="conid">Vec</span> <span class="conid">I</span> <span class="num">1</span> <span class="keyglyph">→</span> A</tt> <td style="text-align:center"><tt class='complex'><span class="conid">Sides</span> <span class="num">2</span></tt> <td style="text-align:center"><tt class='complex'><span class="conid">Eqs</span> <span class="num">2</span></tt> <td style="text-align:center"><tt class='complex'><span class="conid">Vec</span> <span class="conid">I</span> <span class="num">2</span> <span class="keyglyph">→</span> A</tt> <tr> <td style="text-align:center"> <svg width="20" height="20"> <g transform="translate(10,10)"> <circle cx="0" cy="0" r="4" fill="black"/> </g> </svg> <td style="text-align:center"> <svg width="20" height="120"> <g transform="translate(10,60)"> <circle cx="0" cy="-50" r="4" fill="black"/> <circle cx="0" cy="50" r="4" fill="black"/> </g> </svg> <td style="text-align:center"> <svg width="20" height="120"> <marker id="arrow" markerWidth="10" markerHeight="10" refX="9" refY="4" orient="auto" markerUnits="strokeWidth"> <path d="M0,0 L3,4 L0,8 L9,4 z"/> </marker> <g transform="translate(10,60)"> <circle cx="0" cy="-50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <circle cx="0" cy="50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <line x1="0" y1="-44" x2="0" y2="44" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> </g> </svg> <td style="text-align:center"> <svg width="20" height="120"> <g transform="translate(10,60)"> <circle cx="0" cy="-50" r="4" fill="black"/> <circle cx="0" cy="50" r="4" fill="black"/> <line x1="0" y1="-44" x2="0" y2="44" stroke="black" stroke-width="1"/> </g> </svg> <td style="text-align:center"> <svg width="120" height="120"> <marker id="arrow" markerWidth="10" markerHeight="10" refX="9" refY="4" orient="auto" markerUnits="strokeWidth"> <path d="M0,0 L3,4 L0,8 L9,4 z"/> </marker> <g transform="translate(60,60)"> <circle cx="-50" cy="-50" r="4" fill="black"/> <circle cx="-50" cy="50" r="4" fill="black"/> <circle cx="50" cy="-50" r="4" fill="black"/> <circle cx="50" cy="50" r="4" fill="black"/> <line x1="-44" y1="-50" x2="44" y2="-50" stroke="black" stroke-width="1"/> <line x1="-44" y1="50" x2="44" y2="50" stroke="black" stroke-width="1"/> <line x1="-50" y1="-38" x2="-50" y2="38" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> <line x1="50" y1="-38" x2="50" y2="38" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> </g> </svg> <td style="text-align:center"> <svg width="120" height="120"> <marker id="grayArrow" markerWidth="10" markerHeight="10" refX="9" refY="4" orient="auto" markerUnits="strokeWidth"> <path d="M0,0 L3,4 L0,8 L9,4 z" fill="none" stroke="#888" stroke-dasharray="2,2"/> </marker> <g transform="translate(60,60)"> <circle cx="-50" cy="-50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <circle cx="-50" cy="50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <circle cx="50" cy="-50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <circle cx="50" cy="50" r="4" fill="none" stroke="#888" stroke-dasharray="2,2"/> <line x1="-44" y1="-50" x2="44" y2="-50" stroke="#888" stroke-dasharray="2,2" stroke-width="1"/> <line x1="-44" y1="50" x2="44" y2="50" stroke="#888" stroke-dasharray="2,2" stroke-width="1"/> <line x1="-50" y1="-38" x2="-50" y2="38" stroke="#888" stroke-dasharray="2,2" stroke-width="1" marker-end="url(#grayArrow)"/> <line x1="50" y1="-38" x2="50" y2="38" stroke="#888" stroke-dasharray="2,2" stroke-width="1" marker-end="url(#grayArrow)"/> <rect x="-44" y="-40" width="88" height="80" fill="#8cf"/> <line x1="-3" y1="-20" x2="-3" y2="20" stroke="black" stroke-width="1.5"/> <line x1="3" y1="-20" x2="3" y2="20" stroke="black" stroke-width="1.5"/> <path d="M-10,15 L0,24 L10,15" stroke="black" stroke-width="1.5" fill="none"/> </g> </svg> <td style="text-align:center"> <svg width="120" height="120"> <g transform="translate(60,60)"> <path d="M-50,-50 L50,-50 L50,50 L-50,50 z" stroke="black" stroke-width="1" fill="#8cf"/> <circle cx="-50" cy="-50" r="4" fill="black"/> <circle cx="-50" cy="50" r="4" fill="black"/> <circle cx="50" cy="-50" r="4" fill="black"/> <circle cx="50" cy="50" r="4" fill="black"/> </g> </svg> </table> </p><p>I will spare you the details, see the source code of this post if you are interested. Suffice to say, that if we generalize <tt class='complex'><span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span></tt>, <tt><span class="agda-fun">icase</span></tt>, etc. from <tt><span class="conid">I</span></tt> to <tt class='complex'><span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span></tt> and from <tt><span class="agda-fun">Eq</span></tt> to <tt><span class="conid">Eqs</span></tt>, then we can generalize <tt class='complex'><span class="agda-fun">tr-eq-pi</span></tt> to arbitrarily deep <tt><span class="conid">Eqs</span></tt>. </p><pre class="agda"><span class="agda-fun">tr-eqs-pi-rhs</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span> <span class="varid">n</span>} {A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="comment">-- HIDE a|b</span> {B <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> (<span class="varid">is</span> <span class="keyglyph">:</span> <span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varid">is</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> (<span class="agda-fun">sides</span> <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> <span class="conid">Sides</span> <span class="varid">n</span> (<span class="keyglyph">\</span><span class="varid">js</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varid">i</span> <span class="varid">js</span>) <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="varid">js</span> <span class="varid">x</span>)) <span class="keyglyph">→</span> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="agda-ctor">i₀</span>) <span class="keyglyph">→</span> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="agda-ctor">i₁</span>) </pre><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-eqs-pi</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span> <span class="varid">n</span>} {A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} {B <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> (<span class="varid">is</span> <span class="keyglyph">:</span> <span class="conid">Vec</span> <span class="conid">I</span> <span class="varid">n</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varid">is</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">b</span>} (<span class="agda-fun">sides</span> <span class="keyglyph">:</span> (<span class="varid">i</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> <span class="conid">Sides</span> <span class="varid">n</span> (<span class="keyglyph">\</span><span class="varid">js</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varid">i</span> <span class="varid">js</span>) <span class="keyglyph">→</span> B <span class="varid">i</span> <span class="varid">js</span> <span class="varid">x</span>)) (<span class="varid">f₀</span> <span class="keyglyph">:</span> <span class="conid">Eqs</span> (<span class="agda-fun">sides</span> <span class="agda-ctor">i₀</span>)) <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="conid">Eqs</span> <span class="varop">∘</span> <span class="agda-fun">sides</span>) <span class="varid">f₀</span> ⟹ <span class="agda-fun">tr-eqs-pi-rhs</span> <span class="agda-fun">sides</span> <span class="varid">f₀</span> </pre><p>You can do a similar thing for sigma types, except that the types get even messier there because we need a dependently typed <tt><span class="agda-fun">map</span></tt> function for <tt><span class="conid">Eqs</span></tt> and <tt><span class="conid">Sides</span></tt>. </p><p>This is the evaluation strategy implemented in the current TTIE interpreter. But it has two issues: 1) it is error prone and ugly 2) we still haven't defined <tt class='complex'><span class="agda-fun">tr</span> (<span class="agda-fun">Eq</span> <span class="agda-fun">Set</span> <span class="varid">u</span> <span class="varid">v</span>)</tt> </p><p>What remains is to define <tt class='complex'><span class="agda-fun">tr</span> (<span class="agda-fun">Eq</span> <span class="agda-fun">Set</span> <span class="varid">u</span> <span class="varid">v</span>)</tt>. </p><h2><a name="a-note-about-transitivity"></a>A note about transitivity</h2> <p>Note that transitivity can be defined by transporting along an equality, </p><pre class="agda"><span class="agda-fun">trans</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="varid">z</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="keyglyph">→</span> <span class="varid">y</span> <span class="varop">≡</span> <span class="varid">z</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varop">≡</span> <span class="varid">z</span> <span class="comment">-- HIDE a</span> <span class="agda-fun">trans</span>′ {<span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">y</span>} <span class="varid">x≡y</span> <span class="varid">y≡z</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> (<span class="varid">x≡y</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varop">≡</span> (<span class="varid">y≡z</span> <span class="varop">^</span> <span class="varid">i</span>)) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">y</span>) </pre><p>There are several ways to generalize this to dependent types. I'll use a variant that is explicit about the type </p><pre class="agda"><span class="agda-fun">trans</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <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="varid">z</span>} <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="agda-ctor">i₀</span> <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> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-ctor">i₁</span>) <span class="varid">y</span> <span class="varid">z</span> <span class="keyglyph">→</span> <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">i</span>) <span class="varid">x</span> <span class="varid">z</span> <span class="agda-fun">trans</span> A {<span class="varid">y</span> <span class="keyglyph">=</span> <span class="varid">y</span>} <span class="varid">x≡y</span> <span class="varid">y≡z</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> A (<span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">i</span> <span class="varid">j</span>) (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="agda-ctor">i₁</span> <span class="varid">j</span>)) (<span class="varid">x≡y</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">i</span>) (<span class="varid">y≡z</span> <span class="varop">^</span> <span class="varid">i</span>)) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">y</span>) </pre><p>Just as transitivity can be defined in terms of <tt><span class="agda-fun">tr</span></tt>, the converse is also true. Instead of specifying transport for nested equality types, we could define <tt><span class="agda-fun">tr</span></tt> for <tt><span class="agda-fun">Eq</span></tt> types in terms of transitivity and symmetry. </p><p>The most general case of such a transport is </p><pre class="agda"><span class="varid">xy</span> <span class="keyglyph">=</span> <span class="varid">fw</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varid">j</span>) (<span class="varid">ux</span> <span class="varop">^</span> <span class="varid">i</span>) (<span class="varid">vy</span> <span class="varop">^</span> <span class="varid">i</span>)) <span class="varid">uv</span> </pre><p>where </p><pre class="agda"><span class="varid">ux</span> <span class="keyglyph">:</span> <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="agda-ctor">i₀</span>) <span class="varid">u</span> <span class="varid">x</span> <span class="varid">vy</span> <span class="keyglyph">:</span> <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="agda-ctor">i₁</span>) <span class="varid">v</span> <span class="varid">y</span> <span class="varid">uv</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> A <span class="agda-ctor">i₀</span> <span class="varid">j</span>) <span class="varid">u</span> <span class="varid">v</span> </pre><p>which we can draw in a diagram as <svg style="display:block" width="300" height="230"> <defs> <marker id="arrow" markerWidth="10" markerHeight="10" refX="9" refY="4" orient="auto" markerUnits="strokeWidth"> <path d="M0,0 L3,4 L0,8 L9,4 z"/> </marker> </defs> <g transform="translate(150,110)"> <circle cx="-80" cy="-80" r="4" fill="black"/> <circle cx="80" cy="-80" r="4" fill="black"/> <circle cx="-80" cy="80" r="4" fill="black"/> <circle cx="80" cy="80" r="4" fill="black"/> <line x1="-74" y1="-80" x2="74" y2="-80" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> <line x1="-74" y1="80" x2="74" y2="80" stroke="black" stroke-width="1" marker-end="url(#arrow)" stroke-dasharray="5,5"/> <line x1="-80" y1="-75" x2="-80" y2="74" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> <line x1="80" y1="-74" x2="80" y2="74" stroke="black" stroke-width="1" marker-end="url(#arrow)"/> <text x="-80" y="-90" text-anchor="middle">u : A i₀ i₀</text> <text x="80" y="-90" text-anchor="middle">v : A i₀ i₁</text> <text x="-80" y="90" text-anchor="middle" dominant-baseline="text-before-edge">x : A i₁ i₀</text> <text x="80" y="86" text-anchor="middle" dominant-baseline="text-before-edge">y : A i₁ i₁</text> <text x="0" y="-90" text-anchor="middle">uv</text> <text x="-88" y="0" text-anchor="end" dominant-baseline="middle">ux</text> <text x="88" y="0" text-anchor="start" dominant-baseline="middle">vy</text> </g> </svg> </p><p>If you ignore the types for now, it seems obvious that </p><pre class="agda"><span class="varid">xy</span> <span class="keyglyph">=</span> <span class="agda-fun">trans</span> (<span class="agda-fun">trans</span> ((<span class="agda-fun">sym</span> <span class="varid">ux</span>) <span class="varid">uv</span>) <span class="varid">vy</span>) </pre><p>So, we could take </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="comment">-- HIDE a</span> (<span class="varid">ux</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-ctor">i₀</span>) (<span class="varid">vy</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-ctor">i₁</span>) (<span class="varid">uv</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (A <span class="agda-ctor">i₀</span>) (<span class="varid">ux</span> <span class="agda-ctor">i₀</span>) (<span class="varid">vy</span> <span class="agda-ctor">i₀</span>)) <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (A <span class="varid">i</span>) (<span class="varid">ux</span> <span class="varid">i</span>) (<span class="varid">vy</span> <span class="varid">i</span>)) <span class="varid">uv</span> ⟹ <span class="agda-fun">trans</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">→</span> A (<span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="varid">i</span> <span class="varid">j</span>) (<span class="agda-fun">icase</span> <span class="varid">i</span> <span class="varid">i</span> <span class="varid">j</span>)) (<span class="agda-ctor">refl</span> (<span class="varid">ux</span> <span class="varop">∘</span> <span class="agda-fun">inot</span>)) (<span class="agda-fun">trans</span> A <span class="varid">uv</span> (<span class="agda-ctor">refl</span> <span class="varid">vy</span>)) </pre><p>I will stick to taking <tt><span class="agda-fun">tr</span></tt> as primitive. However, this definition will come in handy for defining transport along paths between types. </p><h2><a name="inductive-types"></a>Inductive types</h2> <p>It is straightforward to extend the theory with inductive types and higher inductive types. Here are some concrete examples, taken from <a href="https://homotopytypetheory.org/book/">the HoTT book</a>. </p><h3><a name="the-homotopy-circle"></a>The homotopy circle</h3> <pre class="agda"><span class="keyword">postulate</span> <span class="conid">Circle</span> <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyword">postulate</span> <span class="agda-ctor">point</span> <span class="keyglyph">:</span> <span class="conid">Circle</span> <span class="keyword">postulate</span> <span class="agda-ctor">loop</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="conid">Circle</span>) <span class="agda-ctor">point</span> <span class="agda-ctor">point</span> <span class="keyword">postulate</span> <span class="conid">Circle-elim</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} {A <span class="keyglyph">:</span> <span class="conid">Circle</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> (<span class="varid">p</span> <span class="keyglyph">:</span> A <span class="agda-ctor">point</span>) <span class="keyglyph">→</span> (<span class="varid">l</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> A (<span class="agda-ctor">loop</span> <span class="varop">^</span> <span class="varid">i</span>)) <span class="varid">p</span> <span class="varid">p</span>) <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> <span class="conid">Circle</span>) <span class="keyglyph">→</span> A <span class="varid">x</span> </pre><p>with the computation rules </p><pre class="agda"><span class="keyword">postulate</span> <span class="varid">elim-point</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">p</span> <span class="varid">l</span>} <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> <span class="agda-ctor">point</span> ⟹ <span class="varid">p</span> <span class="comment">-- HIDE a</span> <span class="keyword">postulate</span> <span class="varid">elim-loop</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">p</span> <span class="varid">l</span> <span class="varid">i</span>} <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> (<span class="agda-ctor">loop</span> <span class="varop">^</span> <span class="varid">i</span>) ⟹ <span class="varid">l</span> <span class="varop">^</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <span class="pragma">{-# REWRITE elim-point #-}</span> <span class="pragma">{-# REWRITE elim-loop #-}</span> </pre><p>Technically we would also need to specify <tt><span class="varid">elim</span></tt> for transitive paths (or paths constructed with <tt><span class="agda-fun">tr</span></tt>). First the non-dependent version, </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Circle-elim′-tr-eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">p</span> <span class="varid">l</span>} (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">Circle</span>) <span class="varid">xy</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A} <span class="varid">p</span> <span class="varid">l</span> (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">j</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="varid">j</span>) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span>) <span class="comment">-- HIDE a</span> ⟹ <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">x</span> <span class="varid">j</span>) <span class="comment">-- HIDE a</span> <span class="varop">≡</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">y</span> <span class="varid">j</span>)) <span class="comment">-- HIDE a</span> (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">xy</span> <span class="varop">^</span> <span class="varid">k</span>)) <span class="varop">^</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <div class='empty-line'></div> </pre><p>To write down the dependent version, it is helpful to first define a generalized version of transport over equality types. This generalized equality transport doesn't just give the final path, but also any of the sides, depending on the argument. Fortunately, it can be defined in terms of the existing transport primitive <tt><span class="agda-fun">tr</span></tt>. </p><pre class="agda"><span class="varid">treq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-ctor">i₀</span>) (<span class="varid">y</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">i</span> <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="agda-ctor">i₁</span>) (<span class="varid">xy</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> A <span class="agda-ctor">i₀</span> <span class="varid">j</span>) (<span class="varid">x</span> <span class="agda-ctor">i₀</span>) (<span class="varid">y</span> <span class="agda-ctor">i₀</span>)) <span class="keyglyph">→</span> (<span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">:</span> <span class="conid">I</span>) <span class="keyglyph">→</span> A <span class="varid">i</span> <span class="varid">j</span> <span class="varid">treq</span> A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (A (<span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">k</span>)) (<span class="varid">x</span> (<span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">k</span>)) (<span class="varid">y</span> (<span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">k</span>))) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">j</span> </pre><p>Note that we have </p><pre class="agda"><span class="varid">treq-i-i₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</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">treq</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">i</span> <span class="agda-ctor">i₀</span> ⟹ <span class="varid">x</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <span class="varid">treq-i-i₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</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">treq</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">i</span> <span class="agda-ctor">i₁</span> ⟹ <span class="varid">y</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <span class="varid">treq-i₀-j</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">treq</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="agda-ctor">i₀</span> <span class="varid">j</span> ⟹ <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">j</span> <span class="comment">-- HIDE a</span> <span class="varid">treq-i₁-j</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">treq</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="agda-ctor">i₁</span> <span class="varid">j</span> ⟹ <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (A <span class="varid">i</span>) (<span class="varid">x</span> <span class="varid">i</span>) (<span class="varid">y</span> <span class="varid">i</span>)) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">j</span> <span class="comment">-- HIDE a</span> </pre><p>Now the dependent version of commuting <tt class='complex'><span class="conid">Circle-elim</span></tt> for transitive paths looks like this: </p><pre class="agda"><span class="keyword">postulate</span> <span class="conid">Circle-elim-tr-eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">p</span> <span class="varid">l</span>} (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">Circle</span>) <span class="varid">xy</span> <span class="varid">i</span> <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">j</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="varid">j</span>) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span>) ⟹ <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> A (<span class="varid">treq</span> <span class="keyglyph">_</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">xy</span> <span class="varid">j</span> <span class="varid">k</span>)) (<span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">x</span> <span class="varid">j</span>)) (<span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">y</span> <span class="varid">j</span>))) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">l</span> (<span class="varid">xy</span> <span class="varop">^</span> <span class="varid">k</span>)) <span class="varop">^</span> <span class="varid">i</span> </pre><p>We also need to continue this for higher paths, but that should be straightforward, if tedious. </p><pre class="agda"><details><summary class="comment">tedious next step...</summary><span class="keyword">postulate</span> <span class="conid">Circle-elim-tr-eq-eq</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">p</span> <span class="varid">ll</span>} (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">Circle</span>) <span class="comment">-- HIDE a</span> (<span class="varid">xy₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">k</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">k</span> <span class="agda-ctor">i₀</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="varid">k</span> <span class="agda-ctor">i₀</span>) (<span class="varid">xy₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">k</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">k</span> <span class="agda-ctor">i₁</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="varid">k</span> <span class="agda-ctor">i₁</span>) <span class="varid">xy</span> <span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">l</span> <span class="keyglyph">→</span> <span class="varid">x</span> <span class="varid">k</span> <span class="varid">l</span> <span class="varop">≡</span> <span class="varid">y</span> <span class="varid">k</span> <span class="varid">l</span>) (<span class="varid">xy₀</span> <span class="varid">k</span>) (<span class="varid">xy₁</span> <span class="varid">k</span>)) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span> <span class="varop">^</span> <span class="varid">j</span>) ⟹ <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">l</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">m</span> <span class="keyglyph">→</span> A (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">k'</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">l'</span> <span class="keyglyph">→</span> <span class="varid">x</span> (<span class="varid">k</span> <span class="varop">&amp;&amp;</span> <span class="varid">k'</span>) <span class="varid">l'</span> <span class="varop">≡</span> <span class="varid">y</span> (<span class="varid">k</span> <span class="varop">&amp;&amp;</span> <span class="varid">k'</span>) <span class="varid">l'</span>) (<span class="varid">xy₀</span> (<span class="varid">k</span> <span class="varop">&amp;&amp;</span> <span class="varid">k'</span>)) (<span class="varid">xy₁</span> (<span class="varid">k</span> <span class="varop">&amp;&amp;</span> <span class="varid">k'</span>))) <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">l</span> <span class="varop">^</span> <span class="varid">m</span>) ) (<span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="varid">x</span> <span class="varid">k</span> <span class="varid">l</span>)) (<span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="varid">y</span> <span class="varid">k</span> <span class="varid">l</span>))) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">l</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="varid">xy₀</span> <span class="varid">k</span> <span class="varop">^</span> <span class="varid">l</span>)) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">l</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="varid">xy₁</span> <span class="varid">k</span> <span class="varop">^</span> <span class="varid">l</span>))) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">l</span> <span class="keyglyph">→</span> <span class="conid">Circle-elim</span> {<span class="varid">a</span>} {A} <span class="varid">p</span> <span class="varid">ll</span> (<span class="varid">xy</span> <span class="varop">^</span> <span class="varid">k</span> <span class="varop">^</span> <span class="varid">l</span>)) <span class="varop">^</span> <span class="varid">i</span> <span class="varop">^</span> <span class="varid">j</span> </details></pre><h3><a name="truncation"></a>Truncation</h3> <pre class="agda"><span class="keyword">postulate</span> <span class="conid">Truncate</span> <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">postulate</span> <span class="varid">box</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> <span class="conid">Truncate</span> A <span class="keyword">postulate</span> <span class="varid">same</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="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="conid">Truncate</span> A) <span class="varid">x</span> <span class="varid">y</span> <div class='empty-line'></div> <span class="keyword">module</span> <span class="keyglyph">_</span> {<span class="varid">p</span>} {A} {P <span class="keyglyph">:</span> <span class="conid">Truncate</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">p</span>} <span class="comment">-- HIDE p</span> (<span class="varid">b</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> P (<span class="varid">box</span> <span class="varid">x</span>)) (<span class="varid">s</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">y</span>} (<span class="varid">px</span> <span class="keyglyph">:</span> P <span class="varid">x</span>) (<span class="varid">py</span> <span class="keyglyph">:</span> P <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> P (<span class="varid">same</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varop">^</span> <span class="varid">i</span>)) <span class="varid">px</span> <span class="varid">py</span>) <span class="keyword">where</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="conid">Truncate-elim</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> <span class="conid">Truncate</span> A) <span class="keyglyph">→</span> P <span class="varid">x</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="varid">elim-box</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="conid">Truncate-elim</span> (<span class="varid">box</span> <span class="varid">x</span>) ⟹ <span class="varid">b</span> <span class="varid">x</span> <span class="keyword">postulate</span> <span class="varid">elim-same</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">Truncate-elim</span> (<span class="varid">same</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varop">^</span> <span class="varid">i</span>) ⟹ <span class="varid">s</span> (<span class="conid">Truncate-elim</span> <span class="varid">x</span>) (<span class="conid">Truncate-elim</span> <span class="varid">y</span>) <span class="varop">^</span> <span class="varid">i</span> </pre><p>Notice that in the eliminator for every path constructor, we expect an argument of type <tt>P</tt> "along that path constructor". </p><h3><a name="quotient-types"></a>Quotient types</h3> <pre class="agda"><span class="keyword">postulate</span> <span class="keyglyph">_</span><span class="varop">/</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>) <span class="keyglyph">→</span> (R <span class="keyglyph">:</span> A <span class="keyglyph">→</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span>) <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">postulate</span> <span class="varid">quot</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A R} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> A <span class="varop">/</span> R <span class="keyword">postulate</span> <span class="varid">eqn</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A R} <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> R <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="keyglyph">_</span> <span class="keyglyph">→</span> A <span class="varop">/</span> R) (<span class="varid">quot</span> <span class="varid">x</span>) (<span class="varid">quot</span> <span class="varid">y</span>) <span class="keyword">postulate</span> <span class="varid">truncate</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {A R} <span class="keyglyph">→</span> (<span class="varid">x</span> <span class="varid">y</span> <span class="keyglyph">:</span> A <span class="varop">/</span> R) <span class="keyglyph">→</span> (<span class="varid">r</span> <span class="varid">s</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> A <span class="varop">/</span> R) <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">→</span> <span class="varid">r</span> <span class="varop">≡</span> <span class="varid">s</span> <div class='empty-line'></div> <span class="keyword">module</span> <span class="keyglyph">_</span> {A R} {P <span class="keyglyph">:</span> A <span class="varop">/</span> R <span class="keyglyph">→</span> <span class="agda-fun">Set</span>} (<span class="varid">q</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">→</span> P (<span class="varid">quot</span> <span class="varid">x</span>)) (<span class="varid">e</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">r</span> <span class="keyglyph">:</span> R <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> P (<span class="varid">eqn</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varop">^</span> <span class="varid">i</span>)) (<span class="varid">q</span> <span class="varid">x</span>) (<span class="varid">q</span> <span class="varid">y</span>)) (<span class="varid">t</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varid">s</span>} <span class="keyglyph">→</span> (<span class="varid">px</span> <span class="keyglyph">:</span> P <span class="varid">x</span>) (<span class="varid">py</span> <span class="keyglyph">:</span> P <span class="varid">y</span>) (<span class="varid">pr</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> P (<span class="varid">r</span> <span class="varop">^</span> <span class="varid">i</span>)) <span class="varid">px</span> <span class="varid">py</span>) (<span class="varid">ps</span> <span class="keyglyph">:</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> P (<span class="varid">s</span> <span class="varop">^</span> <span class="varid">i</span>)) <span class="varid">px</span> <span class="varid">py</span>) <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">Eq</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> P (<span class="varid">truncate</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varid">s</span> <span class="varop">^</span> <span class="varid">i</span> <span class="varop">^</span> <span class="varid">j</span>)) <span class="varid">px</span> <span class="varid">py</span>) <span class="varid">pr</span> <span class="varid">ps</span>) <span class="keyword">where</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="varop">/-elim</span> <span class="keyglyph">:</span> (<span class="varid">x</span> <span class="keyglyph">:</span> A <span class="varop">/</span> R) <span class="keyglyph">→</span> P <span class="varid">x</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="varid">elim-quot</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="varop">/-elim</span> (<span class="varid">quot</span> <span class="varid">x</span>) ⟹ <span class="varid">q</span> <span class="varid">x</span> <span class="keyword">postulate</span> <span class="varid">elim-eqn</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varid">i</span> <span class="keyglyph">→</span> <span class="varop">/-elim</span> (<span class="varid">eqn</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varop">^</span> <span class="varid">i</span>) ⟹ <span class="varid">e</span> <span class="varid">r</span> <span class="varop">^</span> <span class="varid">i</span> <span class="keyword">postulate</span> <span class="varid">elim-truncate</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varid">s</span> <span class="varid">i</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="varop">/-elim</span> (<span class="varid">truncate</span> <span class="varid">x</span> <span class="varid">y</span> <span class="varid">r</span> <span class="varid">s</span> <span class="varop">^</span> <span class="varid">i</span> <span class="varop">^</span> <span class="varid">j</span>) ⟹ <span class="varid">t</span> (<span class="varop">/-elim</span> <span class="varid">x</span>) (<span class="varop">/-elim</span> <span class="varid">y</span>) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="varop">/-elim</span> (<span class="varid">r</span> <span class="varop">^</span> <span class="varid">k</span>)) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="varop">/-elim</span> (<span class="varid">s</span> <span class="varop">^</span> <span class="varid">k</span>)) <span class="varop">^</span> <span class="varid">i</span> <span class="varop">^</span> <span class="varid">j</span> </pre><h3><a name="indexed-types"></a>Indexed types</h3> <p>One caveat to the support of inductive types are indexed types. These are the types with parameters whose value can depend on the constructor, written after the colon in Agda. An obvious example is the standard inductive equality type as it is defined in the standard library, </p><pre class="agda"><span class="keyword">data</span> <span class="keyglyph">_</span><span class="varop">≡</span><span class="keyglyph">_</span> {A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>} (<span class="varid">x</span> <span class="keyglyph">:</span> A) <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="agda-ctor">refl</span> <span class="keyglyph">:</span> <span class="varid">x</span> ⟹ <span class="varid">x</span> </pre><p>Another example are length indexed vectors, </p><pre class="agda"><span class="keyword">data</span> <span class="conid">Vec</span> (A <span class="keyglyph">:</span> <span class="agda-fun">Set</span>) <span class="keyglyph">:</span> <span class="conop">ℕ</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="keyword">where</span> <span class="agda-ctor">[]</span> <span class="keyglyph">:</span> <span class="conid">Vec</span> A <span class="agda-ctor">zero</span> <span class="keyglyph">_</span><span class="agda-ctor">∷</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">n</span>} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> <span class="conid">Vec</span> A <span class="varid">n</span> <span class="keyglyph">→</span> <span class="conid">Vec</span> A (<span class="agda-ctor">suc</span> <span class="varid">n</span>) </pre><p>Such inductive types introduce a new kind of equality, and we can't have that in TTIE. </p><p>Fortunately, outlawing such definitions is not a big limitation, since any indexed type can be rewritten to a normal inductive type by making the equalities explicit. For example </p><pre class="agda"><span class="keyword">data</span> <span class="conid">Vec</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="keyword">where</span> <span class="agda-ctor">[]</span> <span class="keyglyph">:</span> <span class="varid">n</span> <span class="varop">≡</span> <span class="agda-ctor">zero</span> <span class="keyglyph">→</span> <span class="conid">Vec</span> A <span class="varid">n</span> <span class="keyglyph">_</span><span class="agda-ctor">∷</span><span class="keyglyph">_</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">m</span>} <span class="keyglyph">→</span> A <span class="keyglyph">→</span> <span class="conid">Vec</span> A <span class="varid">m</span> <span class="keyglyph">→</span> <span class="varid">n</span> <span class="varop">≡</span> <span class="agda-ctor">suc</span> <span class="varid">m</span> <span class="keyglyph">→</span> <span class="conid">Vec</span> A <span class="varid">n</span> </pre><h2><a name="univalence"></a>Univalence</h2> <p>The final ingredient to turn TTIE into a homotopy type theory is the univalence axiom. A univalence primitive might look like this: </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">univalence</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="comment">-- HIDE a</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="varid">g</span> <span class="keyglyph">:</span> B <span class="keyglyph">→</span> A) <span class="keyglyph">→</span> (<span class="varid">gf</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">g</span> (<span class="varid">f</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">x</span>) <span class="keyglyph">→</span> (<span class="varid">fg</span> <span class="keyglyph">:</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="varop">≡</span> <span class="varid">x</span>) <span class="keyglyph">→</span> (<span class="varid">fgf</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">cong</span>′ <span class="varid">f</span> (<span class="varid">gf</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">fg</span> (<span class="varid">f</span> <span class="varid">x</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">Set</span> <span class="varid">a</span>) A B <span class="comment">-- HIDE a</span> </pre><p>By using an equality constructed with univalence in a transport, you can recover the forward and backward functions, </p><pre class="agda"><span class="varid">fw</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="varop">≡</span> B <span class="keyglyph">→</span> A <span class="keyglyph">→</span> B <span class="comment">-- HIDE a</span> <span class="varid">fw</span> <span class="conid">A≡B</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="conid">A≡B</span>) <div class='empty-line'></div> <span class="varid">bw</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="varop">≡</span> B <span class="keyglyph">→</span> B <span class="keyglyph">→</span> A <span class="comment">-- HIDE a</span> <span class="varid">bw</span> <span class="conid">A≡B</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="conid">A≡B</span> <span class="varop">∘</span> <span class="agda-fun">inot</span>) </pre><p>as well as the proofs of left and right-inverse, </p><pre class="agda"><span class="varid">bw∘fw</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">A≡B</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">bw</span> <span class="conid">A≡B</span> (<span class="varid">fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="varid">bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">j</span>) <span class="agda-ctor">i₀</span> <span class="varid">i</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> (<span class="agda-fun">inot</span> <span class="varid">j</span>) <span class="varid">i</span>) <span class="varid">x</span>) <div class='empty-line'></div> <span class="varid">fw∘bw</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">A≡B</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="varid">fw</span> <span class="conid">A≡B</span> (<span class="varid">bw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="varid">fw∘bw</span> <span class="conid">A≡B</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">j</span> <span class="agda-ctor">i₁</span> <span class="varid">i</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="varid">j</span> <span class="varid">i</span>) <span class="varid">x</span>) </pre><p>Here the trick is that when <tt class='complex'><span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-ctor">i₁</span></tt>, the transports become the identity, while otherwise they become <tt><span class="varid">fw</span></tt> and <tt><span class="varid">bw</span></tt>. </p><p>Getting out the adjunction <tt><span class="varid">fgf</span></tt> is a bit harder. You need to come up with an expression that reduces to <tt class='complex'><span class="varid">f</span> (<span class="varid">gf</span> <span class="varid">x</span> <span class="varop">^</span> <span class="varid">k</span>)</tt> when <tt class='complex'><span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-ctor">i₀</span></tt> and that reduces to <tt class='complex'>(<span class="varid">fg</span> (<span class="varid">f</span> <span class="varid">x</span>) <span class="varop">^</span> <span class="varid">k</span>)</tt> when <tt class='complex'><span class="varid">j</span> <span class="keyglyph">=</span> <span class="agda-ctor">i₁</span></tt>. The following does the trick </p><pre class="agda"><span class="varid">not-quite-fw∘bw∘fw</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">A≡B</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="keyglyph">→</span> <span class="agda-fun">cong</span>′ (<span class="varid">fw</span> <span class="conid">A≡B</span>) (<span class="varid">bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">fw∘bw</span> <span class="conid">A≡B</span> (<span class="varid">fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varid">not-quite-fw∘bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">k</span> <span class="varid">j</span>) <span class="agda-ctor">i₁</span> <span class="varid">i</span>) <span class="varop">$</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">k</span>) <span class="agda-ctor">i₁</span> <span class="varid">j</span>) (<span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">k</span> <span class="varid">j</span>) <span class="varid">i</span>) <span class="varop">$</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">k</span>) <span class="agda-ctor">i₁</span> <span class="varid">j</span>) <span class="varid">i</span>) <span class="varid">x</span>) </pre><p>but the type is not right. We want an equality between two equalities, both of type <tt class='complex'><span class="varid">fw</span> (<span class="varid">bw</span> (<span class="varid">fw</span> <span class="varid">x</span>)) <span class="varop">≡</span> <span class="varid">x</span></tt>. But instead we get a dependent equality type that mirrors the body of the definition. </p><p>To resolve this, we need to add another reduction rule to the language, which states that if you transport from <tt class='complex'><span class="agda-ctor">i₀</span></tt> to <tt><span class="varid">i</span></tt> and then to <tt class='complex'><span class="agda-ctor">i₁</span></tt>, this is the same as going directly from <tt class='complex'><span class="agda-ctor">i₀</span></tt> to <tt class='complex'><span class="agda-ctor">i₁</span></tt>. This should hold regardless of what <tt><span class="varid">i</span></tt> is. </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-tr</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) <span class="varid">i</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (A <span class="varop">∘</span> <span class="agda-fun">icase</span> <span class="varid">i</span> <span class="agda-ctor">i₁</span>) (<span class="agda-fun">tr</span> (A <span class="varop">∘</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">i</span>) <span class="varid">x</span>) ⟹ <span class="agda-fun">tr</span> A <span class="varid">x</span> <span class="comment">-- HIDE a</span> <span class="keyword">postulate</span> <span class="agda-fun">tr-tr-i₀</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr-tr</span> {<span class="varid">a</span>} A <span class="agda-ctor">i₀</span> <span class="varid">x</span> ⟹ □ <span class="comment">-- HIDE a</span> <span class="keyword">postulate</span> <span class="agda-fun">tr-tr-i₁</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} A <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr-tr</span> {<span class="varid">a</span>} A <span class="agda-ctor">i₁</span> <span class="varid">x</span> ⟹ □ <span class="comment">-- HIDE a</span> <span class="pragma">{-# REWRITE tr-tr-i₀ tr-tr-i₁ #-}</span> </pre><pre class="agda"><span class="varid">fw∘bw∘fw</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">A≡B</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B) <span class="keyglyph">→</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">cong</span>′ (<span class="varid">fw</span> <span class="conid">A≡B</span>) (<span class="varid">bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">fw∘bw</span> <span class="conid">A≡B</span> (<span class="varid">fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>) <span class="varid">fw∘bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span> <span class="keyglyph">=</span> <details><summary class="comment">-- same as above, with ugly rewriting details...</summary> <span class="varid">Meta.subst</span> <span class="varid">id</span> (<span class="agda-fun">cong-</span><span class="agda-fun">Eq</span> (<span class="agda-fun">ext</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">cong-</span><span class="agda-fun">Eq</span> □ □ (<span class="agda-fun">tr-tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="varid">i</span>) (<span class="varid">j</span>) <span class="varid">x</span>)) □ □) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="varid">k</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">k</span> <span class="varid">j</span>) <span class="agda-ctor">i₁</span> <span class="varid">i</span>) <span class="varop">$</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">k</span>) <span class="agda-ctor">i₁</span> <span class="varid">j</span>) (<span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">k</span> <span class="varid">j</span>) <span class="varid">i</span>) <span class="varop">$</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">A≡B</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">k</span>) <span class="agda-ctor">i₁</span> <span class="varid">j</span>) <span class="varid">i</span>) <span class="varid">x</span>) </details></pre><h3><a name="computation-rules"></a>Computation rules</h3> <p>The computation rules are now obvious: when <tt><span class="varid">fw</span></tt>, <tt><span class="varid">bw</span></tt>, etc. are applied to a univalence primitive, return the appropriate field. </p><pre class="agda"><span class="keyword">module</span> <span class="keyglyph">_</span> {<span class="varid">a</span>} {A B} <span class="varid">f</span> <span class="varid">g</span> <span class="varid">gf</span> <span class="varid">fg</span> <span class="varid">fgf</span> (<span class="keyword">let</span> <span class="conid">AB</span> <span class="keyglyph">=</span> <span class="agda-fun">univalence</span> {<span class="varid">a</span>} {A} {B} <span class="varid">f</span> <span class="varid">g</span> <span class="varid">gf</span> <span class="varid">fg</span> <span class="varid">fgf</span>) <span class="keyword">where</span> <span class="comment">-- HIDE a</span> <span class="keyword">postulate</span> <span class="agda-fun">tr-univalence-f</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="varid">i</span>) <span class="varid">x</span> ⟹ <span class="varid">f</span> <span class="varid">x</span> <span class="keyword">postulate</span> <span class="agda-fun">tr-univalence-g</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varid">x</span> ⟹ <span class="varid">g</span> <span class="varid">x</span> <span class="pragma">{-# REWRITE tr-univalence-f #-}</span> <span class="pragma">{-# REWRITE tr-univalence-g #-}</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="agda-fun">tr-univalence-gf</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">j</span> <span class="agda-ctor">i₀</span> <span class="varid">i</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">j</span> <span class="varid">i</span>) <span class="varid">x</span>) ⟹ <span class="varid">gf</span> <span class="varid">x</span> <span class="varop">^</span> <span class="agda-fun">inot</span> <span class="varid">j</span> <span class="keyword">postulate</span> <span class="agda-fun">tr-univalence-fg</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">j</span> <span class="agda-ctor">i₁</span> <span class="varid">i</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₁</span> <span class="varid">j</span> <span class="varid">i</span>) <span class="varid">x</span>) ⟹ <span class="varid">fg</span> <span class="varid">x</span> <span class="varop">^</span> <span class="varid">j</span> <span class="pragma">{-# REWRITE tr-univalence-gf #-}</span> <span class="pragma">{-# REWRITE tr-univalence-fg #-}</span> <span class="comment">-- tr-univalence-fgf ommitted</span> </pre><p>Ideally, we would be able to compute <tt><span class="agda-fun">tr</span></tt> for <tt class='complex'><span class="conid">AB</span> <span class="varop">^</span> <span class="varid">f</span> <span class="varid">i</span></tt> for any function <tt><span class="varid">f</span></tt>, and even </p><pre class="agda"><span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="varid">f<sub>1</sub></span> <span class="varid">i</span>) <span class="varop">∘</span> ⋯ <span class="varop">∘</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="varid">f<sub>n</sub></span> <span class="varid">i</span>) </pre><p>But we quickly run into problems. Consider </p><pre class="agda"> <span class="varid">problem</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span> <span class="keyglyph">→</span> A <span class="keyglyph">→</span> B <span class="varid">problem</span> <span class="varid">j</span> <span class="varid">k</span> <span class="keyglyph">=</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">k</span> <span class="agda-ctor">i₁</span> <span class="varid">i</span>) <span class="varop">∘</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">j</span> <span class="varid">k</span> <span class="varid">i</span>) <span class="varop">∘</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">j</span> <span class="varid">i</span>) </pre><p>When <tt class='complex'><span class="varid">j=i₁</span></tt>, this reduces to </p><pre class="agda"><span class="varid">problem</span> <span class="agda-ctor">i₁</span> <span class="varid">k</span> <span class="keyglyph">=</span> <span class="varid">fg</span> <span class="varop">^</span> <span class="varid">k</span> <span class="varop">∘</span> <span class="varid">f</span> </pre><p>and when <tt class='complex'><span class="varid">k=i₀</span></tt>, it reduces to </p><pre class="agda"><span class="varid">problem</span> <span class="varid">j</span> <span class="agda-ctor">i₀</span> <span class="keyglyph">=</span> <span class="varid">f</span> <span class="varop">∘</span> <span class="varid">gf</span> <span class="varop">^</span> <span class="varid">j</span> </pre><p>These two types look a lot like the adjunction <tt><span class="varid">fgf</span></tt>, but there are two differences: 1. For the two reductions of <tt><span class="varid">problem</span></tt> to be confluent, the two right hand sides should be equal in the meta language (judgementally equal). But an adjunction inside the theory doesn't guarantee this. </p><p>2. Even when using <tt><span class="varid">fgf</span></tt>, we can not get an expression for <tt><span class="varid">problem</span></tt> with the right reductions. The issue is that depending on <tt><span class="varid">j</span></tt> and <tt><span class="varid">k</span></tt>, <tt><span class="varid">problem</span></tt> can represent any of the following compositions </p><pre class="agda"><span class="varid">problem</span> <span class="agda-ctor">i₀</span> <span class="agda-ctor">i₀</span> <span class="keyglyph">=</span> <span class="varid">f</span> <span class="varop">∘</span> <span class="varid">id</span> <span class="varop">∘</span> <span class="varid">id</span> <span class="varid">problem</span> <span class="agda-ctor">i₀</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">=</span> <span class="varid">id</span> <span class="varop">∘</span> <span class="varid">f</span> <span class="varop">∘</span> <span class="varid">id</span> <span class="varid">problem</span> <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₀</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">f</span> <span class="varid">problem</span> <span class="agda-ctor">i₁</span> <span class="agda-ctor">i₁</span> <span class="keyglyph">=</span> <span class="varid">id</span> <span class="varop">∘</span> <span class="varid">id</span> <span class="varop">∘</span> <span class="varid">f</span> </pre><h3><a name="transporting-univalent-paths"></a>Transporting univalent paths</h3> <p>Finally, we also need to decide how to transport along equality types involving univalence. As I showed previously, transporting along equalities can be defined in terms of transitivity. So that is what we will do here. The idea is that to transport along <tt class='complex'><span class="agda-fun">trans</span> <span class="conid">AB</span> <span class="conid">BC</span></tt>, you first transport along <tt><span class="conid">AB</span></tt>, and then along <tt><span class="conid">BC</span></tt>. The same goes for other directions of using this transitive path (<tt><span class="varid">bw</span></tt>, <tt class='complex'><span class="varid">fw∘bw</span></tt>, etc.) </p><pre class="agda"><span class="keyword">module</span> <span class="keyglyph">_</span> {<span class="varid">a</span>} {A B C <span class="keyglyph">:</span> <span class="agda-fun">Set</span> <span class="varid">a</span>} (<span class="conid">A≡B</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B) (<span class="conid">B≡C</span> <span class="keyglyph">:</span> B <span class="varop">≡</span> C) <span class="keyword">where</span> <span class="agda-fun">trans-f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> C <span class="agda-fun">trans-f</span> <span class="keyglyph">=</span> <span class="varid">fw</span> <span class="conid">B≡C</span> <span class="varop">∘</span> <span class="varid">fw</span> <span class="conid">A≡B</span> <div class='empty-line'></div> <span class="agda-fun">trans-g</span> <span class="keyglyph">:</span> C <span class="keyglyph">→</span> A <span class="agda-fun">trans-g</span> <span class="keyglyph">=</span> <span class="varid">bw</span> <span class="conid">A≡B</span> <span class="varop">∘</span> <span class="varid">bw</span> <span class="conid">B≡C</span> <div class='empty-line'></div> <span class="agda-fun">trans-gf</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">trans-g</span> (<span class="agda-fun">trans-f</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">x</span> <span class="agda-fun">trans-gf</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="agda-fun">cong</span>′ (<span class="varid">bw</span> <span class="conid">A≡B</span>) (<span class="varid">bw∘fw</span> <span class="conid">B≡C</span> (<span class="varid">fw</span> <span class="conid">A≡B</span> <span class="varid">x</span>)) <span class="varop">⟨</span> <span class="agda-fun">trans</span>′ <span class="varop">⟩</span> <span class="varid">bw∘fw</span> <span class="conid">A≡B</span> <span class="varid">x</span> <div class='empty-line'></div> <span class="agda-fun">trans-fg</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">trans-f</span> (<span class="agda-fun">trans-g</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="varid">x</span> <span class="agda-fun">trans-fg</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="agda-fun">cong</span>′ (<span class="varid">fw</span> <span class="conid">B≡C</span>) (<span class="varid">fw∘bw</span> <span class="conid">A≡B</span> (<span class="varid">bw</span> <span class="conid">B≡C</span> <span class="varid">x</span>)) <span class="varop">⟨</span> <span class="agda-fun">trans</span>′ <span class="varop">⟩</span> <span class="varid">fw∘bw</span> <span class="conid">B≡C</span> <span class="varid">x</span> <div class='empty-line'></div> <span class="keyword">postulate</span> <span class="agda-fun">trans-fgf</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">cong</span>′ <span class="agda-fun">trans-f</span> (<span class="agda-fun">trans-gf</span> <span class="varid">x</span>) <span class="varop">≡</span> <span class="agda-fun">trans-fg</span> (<span class="agda-fun">trans-f</span> <span class="varid">x</span>) <span class="comment">-- trans-fgf should be provable, but proof is omitted here</span> <div class='empty-line'></div> <span class="agda-fun">trans-equivalence</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> C <span class="agda-fun">trans-equivalence</span> <span class="keyglyph">=</span> <span class="agda-fun">univalence</span> <span class="agda-fun">trans-f</span> <span class="agda-fun">trans-g</span> <span class="agda-fun">trans-gf</span> <span class="agda-fun">trans-fg</span> <span class="agda-fun">trans-fgf</span> </pre><p>And we use this transitivity to define transport, </p><pre class="agda"><span class="keyword">postulate</span> <span class="agda-fun">tr-eq-</span><span class="agda-fun">Set</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A B <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) (<span class="conid">A₀≡B₀</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₀</span> <span class="varop">≡</span> B <span class="agda-ctor">i₀</span>) <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</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">Set</span> <span class="varid">a</span>) (A <span class="varid">i</span>) (B <span class="varid">i</span>)) <span class="conid">A₀≡B₀</span> ⟹ <span class="agda-fun">trans-equivalence</span> (<span class="agda-ctor">refl</span> (A <span class="varop">∘</span> <span class="agda-fun">inot</span>)) (<span class="agda-fun">trans-equivalence</span> <span class="conid">A₀≡B₀</span> (<span class="agda-ctor">refl</span> B)) <div class='empty-line'></div> <span class="comment">-- spacial case for fw</span> <span class="agda-fun">tr-tr-eq-</span><span class="agda-fun">Set</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span>} (A B <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">a</span>) (<span class="conid">A₀≡B₀</span> <span class="keyglyph">:</span> A <span class="agda-ctor">i₀</span> <span class="varop">≡</span> B <span class="agda-ctor">i₀</span>) <span class="varid">x</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</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">Set</span> <span class="varid">a</span>) (A <span class="varid">i</span>) (B <span class="varid">i</span>)) <span class="conid">A₀≡B₀</span> <span class="varop">^</span> <span class="varid">j</span>) <span class="varid">x</span> ⟹ <span class="agda-fun">tr</span> B (<span class="agda-fun">tr</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="conid">A₀≡B₀</span>) (<span class="agda-fun">tr</span> (A <span class="varop">∘</span> <span class="agda-fun">inot</span>) <span class="varid">x</span>)) <span class="agda-fun">tr-tr-eq-</span><span class="agda-fun">Set</span> A B <span class="conid">A₀≡B₀</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">Meta.cong</span> (<span class="keyglyph">\</span><span class="conid">A₁≡B₁</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="conid">A₁≡B₁</span>) <span class="varid">x</span>) (<span class="agda-fun">tr-eq-</span><span class="agda-fun">Set</span> A B <span class="conid">A₀≡B₀</span>) </pre><p>Note that <tt class='complex'><span class="agda-fun">tr-eq-</span><span class="agda-fun">Set</span></tt> cannot be used as a rewrite rule. Agda incorrectly complains about universe levels, and when removing those the rule is accepted, but the file takes more than 10 minutes to type check. </p><h3><a name="reduction-rules-spoiled-by-univalence"></a>Reduction rules spoiled by univalence</h3> <p>While we are at it, it would be nice if we could add some additional judgemental equalities to the type system. For instance, <tt class='complex'><span class="agda-fun">trans</span> <span class="varid">xy</span> (<span class="agda-fun">sym</span> <span class="varid">xy</span>) <span class="keyglyph">=</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">x</span></tt> should hold for all <tt><span class="varid">xy</span></tt>. </p><p>However, we can not add this as a reduction. The reason is that for paths build with univalence, transporting along the left hand side reduces to <tt class='complex'><span class="varid">bw∘fw</span></tt>, and this is not necessarily the same as reflexivity. Here is an example </p><pre class="agda"><span class="comment">-- A path that flips the interval in one direction, but not in the other</span> <span class="comment">-- so fw ∘ bw ≠ refl</span> <span class="varid">flip-I</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="varop">≡</span> <span class="conid">I</span> <span class="varid">flip-I</span> <span class="keyglyph">=</span> <span class="agda-fun">univalence</span> <span class="varid">id</span> <span class="agda-fun">inot</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varid">i</span>)) (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varid">i</span>)) (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="agda-ctor">refl</span> (<span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varid">i</span>)) <div class='empty-line'></div> <span class="keyword">module</span> <span class="keyglyph">_</span> (<span class="agda-fun">trans-sym</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">x</span> <span class="varid">y</span>} <span class="varid">xy</span> <span class="keyglyph">→</span> <span class="agda-fun">trans</span>′ {<span class="varid">a</span>} {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> (<span class="agda-fun">sym</span> <span class="varid">xy</span>) <span class="comment">-- hide {a}</span> ⟹ (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">x</span>)) <span class="keyword">where</span> <span class="varid">problem2</span> <span class="keyglyph">:</span> <span class="agda-ctor">i₀</span> ⟹ <span class="agda-ctor">i₁</span> <span class="varid">problem2</span> <span class="keyglyph">=</span> <span class="varid">Meta.begin</span> <span class="agda-ctor">i₀</span> ⟸<span class="varop">⟨</span> <span class="agda-fun">tr-tr-eq-</span><span class="agda-fun">Set</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="varid">flip-I</span> <span class="varop">∘</span> <span class="agda-fun">inot</span>) (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="varid">flip-I</span> <span class="varop">∘</span> <span class="agda-fun">inot</span>) (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="conid">I</span>) <span class="agda-ctor">i₁</span> <span class="varop">⟩</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">trans</span>′ <span class="varid">flip-I</span> (<span class="agda-fun">sym</span> <span class="varid">flip-I</span>) <span class="varop">^</span> <span class="varid">i</span>) <span class="agda-ctor">i₁</span> ⟹<span class="varop">⟨</span> <span class="varid">Meta.cong</span> (<span class="keyglyph">\</span><span class="conid">AB</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="varid">i</span>) <span class="agda-ctor">i₁</span>) (<span class="agda-fun">trans-sym</span> <span class="varid">flip-I</span>) <span class="varop">⟩</span> <span class="agda-ctor">i₁</span> ∎ </pre><p><tt class='complex'><span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="agda-fun">trans</span> <span class="varid">flip-I</span> (<span class="agda-fun">sym</span> <span class="varid">flip-I</span>) <span class="varop">^</span> <span class="varid">i</span>) <span class="agda-ctor">i₁</span></tt> evaluates to <tt class='complex'><span class="agda-ctor">i₁</span></tt> with <tt class='complex'><span class="agda-fun">tr-eq-</span><span class="agda-fun">Set</span></tt>, since we follow the equivalence backward and then forward. But according to <tt class='complex'><span class="agda-fun">trans-sym</span></tt> it is an identity path, and so this expression evaluates to <tt class='complex'><span class="agda-ctor">i₀</span></tt>. So, we have a term that can evaluate to either <tt class='complex'><span class="agda-ctor">i₀</span></tt> or to <tt class='complex'><span class="agda-ctor">i₁</span></tt>, depending on the evaluation order. In other words, reduction is no longer confluent. </p><p>This might not seem too bad, since <tt class='complex'><span class="agda-ctor">i₀</span> <span class="varop">≡</span> <span class="agda-ctor">i₁</span></tt> inside the theory. But note that the reduction relation <tt class='complex'>⟹</tt> is not a homotopy equality. And it might even be untyped if we were using an untyped meta-theory, like the Haskell TTIE implementation. With a non-confluent reduction relation, it is easy to break the type system, </p><pre class="agda"><span class="varid">flip-Bool</span> <span class="keyglyph">:</span> <span class="conid">Bool</span> <span class="varop">≡</span> <span class="conid">Bool</span> <span class="varid">flip-Bool</span> <span class="keyglyph">=</span> <span class="agda-fun">univalence</span> <span class="varid">not</span> <span class="varid">not</span> <span class="varid">not-not</span> <span class="varid">not-not</span> <span class="varid">not-not-not</span> <div class='empty-line'></div> <span class="varid">bad</span> <span class="keyglyph">:</span> <span class="agda-ctor">i₀</span> ⟹ <span class="agda-ctor">i₁</span> <span class="keyglyph">→</span> (<span class="conid">Bool</span> , <span class="varid">false</span>) ⟹ (<span class="keyglyph">_</span>,<span class="keyglyph">_</span> {B <span class="keyglyph">=</span> <span class="varid">id</span>} <span class="conid">Bool</span> <span class="varid">true</span>) <span class="varid">bad</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">Meta.cong</span> {B <span class="keyglyph">=</span> <span class="agda-fun">Σ</span> <span class="agda-fun">Set</span> <span class="varid">id</span>} (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">flip-Bool</span> <span class="varop">^</span> <span class="varid">i</span> , <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="varid">flip-Bool</span> <span class="varop">^</span> <span class="varid">i</span> <span class="varop">&amp;&amp;</span> <span class="varid">j</span>) <span class="varid">false</span>) <span class="varid">x</span> <div class='empty-line'></div> <span class="varid">worse</span> <span class="keyglyph">:</span> <span class="agda-ctor">i₀</span> ⟹ <span class="agda-ctor">i₁</span> <span class="keyglyph">→</span> ⊥ <span class="varid">worse</span> <span class="varid">x</span> <span class="keyword">with</span> <span class="varid">bad</span> <span class="varid">x</span> <span class="varop">...</span> <span class="keyglyph">|</span> () </pre><p>So, <tt class='complex'><span class="agda-fun">trans-sym</span></tt> is out. </p><p>Another seemingly sensible reduction is that <tt class='complex'><span class="agda-fun">cong</span> <span class="varid">f</span> (<span class="agda-fun">trans</span> <span class="varid">xy</span> <span class="varid">yz</span>) <span class="varop">≡</span> <span class="agda-fun">trans</span> (<span class="agda-fun">cong</span> <span class="varid">f</span> <span class="varid">xy</span>) (<span class="agda-fun">cong</span> <span class="varid">f</span> <span class="varid">yz</span>)</tt>. But, if we also postulate that all paths over the interval can be defined in terms of <tt><span class="agda-fun">icase</span></tt>, we end up in the same problematic situation. </p><pre class="agda"><span class="keyword">module</span> <span class="keyglyph">_</span> (<span class="agda-fun">trans-cong</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> <span class="varid">b</span> A B <span class="varid">x</span> <span class="varid">y</span> <span class="varid">z</span>} (<span class="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> B) <span class="varid">xy</span> <span class="varid">yz</span> <span class="comment">-- HIDE a|b</span> <span class="keyglyph">→</span> <span class="agda-fun">cong</span>′ <span class="varid">f</span> (<span class="agda-fun">trans</span>′ {<span class="varid">a</span>} {A} {<span class="varid">x</span>} {<span class="varid">y</span>} {<span class="varid">z</span>} <span class="varid">xy</span> <span class="varid">yz</span>) <span class="comment">-- HIDE a</span> ⟹ <span class="agda-fun">trans</span>′ {<span class="varid">b</span>} (<span class="agda-fun">cong</span>′ <span class="varid">f</span> <span class="varid">xy</span>) (<span class="agda-fun">cong</span>′ <span class="varid">f</span> <span class="varid">yz</span>)) <span class="comment">-- HIDE b</span> (<span class="agda-fun">tr-eq-</span><span class="conid">I</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> (<span class="varid">j</span> <span class="varid">k</span> <span class="keyglyph">:</span> <span class="conid">I</span> <span class="keyglyph">→</span> <span class="conid">I</span>) <span class="varid">jk₀</span> <span class="keyglyph">→</span> <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</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="conid">I</span>) (<span class="varid">j</span> <span class="varid">i</span>) (<span class="varid">k</span> <span class="varid">i</span>)) <span class="varid">jk₀</span> ⟹ <span class="agda-ctor">refl</span> (<span class="agda-fun">icase</span> (<span class="varid">j</span> <span class="agda-ctor">i₁</span>) (<span class="varid">k</span> <span class="agda-ctor">i₁</span>))) <span class="keyword">where</span> <span class="agda-fun">trans-sym</span> <span class="keyglyph">:</span> <span class="keyglyph">∀</span> {<span class="varid">a</span> A <span class="varid">x</span> <span class="varid">y</span>} <span class="varid">xy</span> <span class="keyglyph">→</span> <span class="agda-fun">trans</span>′ {<span class="varid">a</span>} {A} {<span class="varid">x</span>} {<span class="varid">y</span>} <span class="varid">xy</span> (<span class="agda-fun">sym</span> <span class="varid">xy</span>) ⟹ (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">x</span>) <span class="comment">-- HIDE a</span> <span class="agda-fun">trans-sym</span> {<span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">x</span>} <span class="varid">xy</span> <span class="keyglyph">=</span> <span class="varid">Meta.begin</span> <span class="agda-fun">trans</span>′ <span class="varid">xy</span> (<span class="agda-fun">sym</span> <span class="varid">xy</span>) ⟸<span class="varop">⟨</span> <span class="agda-fun">trans-cong</span> (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="varid">xy</span>) (<span class="agda-ctor">refl</span> <span class="varid">id</span>) (<span class="agda-ctor">refl</span> <span class="agda-fun">inot</span>) <span class="varop">⟩</span> <span class="agda-fun">cong</span>′ (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">xy</span> <span class="varop">^</span> <span class="varid">i</span>) (<span class="agda-fun">trans</span>′ (<span class="agda-ctor">refl</span> <span class="varid">id</span>) (<span class="agda-ctor">refl</span> <span class="agda-fun">inot</span>)) ⟹<span class="varop">⟨</span> <span class="varid">Meta.cong</span> (<span class="agda-fun">cong</span>′ (<span class="keyglyph">_</span><span class="varop">^</span><span class="keyglyph">_</span> <span class="varid">xy</span>)) (<span class="agda-fun">tr-eq-</span><span class="conid">I</span> <span class="agda-fun">inot</span> <span class="agda-fun">inot</span> (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="agda-ctor">i₁</span>)) <span class="varop">⟩</span> <span class="agda-ctor">refl</span> (<span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">x</span>) ∎ <div class='empty-line'></div> <span class="varid">problem3</span> <span class="keyglyph">:</span> <span class="agda-ctor">i₀</span> ⟹ <span class="agda-ctor">i₁</span> <span class="varid">problem3</span> <span class="keyglyph">=</span> <span class="varid">problem2</span> <span class="agda-fun">trans-sym</span> </pre><p>I don't have any solution to these problems, aside from not adding the problematic reductions. </p><p>Reductions that do seem fine are those involving only a single path. For instance, things like <tt class='complex'><span class="agda-fun">trans</span> <span class="varid">xy</span> (<span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="varid">y</span>) ⟹ <span class="varid">xy</span></tt>. </p><h2><a name="conclusion"></a>Conclusion</h2> <p>What I have presented is the type theory with indexed equality. As mentioned before, there is also a <a href="https://github.com/twanvl/ttie">prototype implementation in Haskell</a>. </p><p>The theory is quite similar to the cubical system, but it is developed mostly independently. </p><p>Some area's I haven't discussed or investigated yet, and some issues with the theory are: </p><p>1. Transitive paths involving HIT path constructors are not reduced, so <tt class='complex'><span class="agda-fun">trans</span> <span class="agda-ctor">loop</span> (<span class="agda-fun">sym</span> <span class="agda-ctor">loop</span>)</tt> is not the same as <tt class='complex'><span class="agda-ctor">refl</span> <span class="keyglyph">\</span><span class="keyglyph">_</span> <span class="keyglyph">→</span> <span class="agda-ctor">point</span></tt>, however, the two are provably equal inside the theory. As with a general <tt class='complex'><span class="agda-fun">trans-sym</span></tt> rule, adding such a reduction would break confluence. </p><p>2. I have defined a function <tt><span class="varid">treq</span></tt> that generalizes <tt class='complex'><span class="agda-fun">tr</span> (<span class="agda-fun">Eq</span> <span class="varop">..</span>)</tt>. This could be taken as a primitive instead of <tt><span class="agda-fun">tr</span></tt>. In that case we should further generalize it to take <tt><span class="conid">Sides</span></tt>, so that it also works for higher paths. </p><p>3. It is possible to combine transports to write terms that do not reduce, for example </p><pre class="agda"><span class="varid">x</span> <span class="keyglyph">:</span> A <span class="conid">AB</span> <span class="keyglyph">:</span> A <span class="varop">≡</span> B <span class="varid">f</span> <span class="keyglyph">:</span> A <span class="keyglyph">→</span> <span class="agda-fun">Set</span> <span class="varid">y</span> <span class="keyglyph">:</span> <span class="varid">f</span> (<span class="varid">bw</span> <span class="conid">AB</span> (<span class="varid">fw</span> <span class="conid">AB</span> <span class="varid">x</span>)) <span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">i</span> <span class="keyglyph">→</span> <span class="varid">f</span> (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="agda-ctor">i₀</span> <span class="varid">j</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="varid">i</span> (<span class="agda-fun">inot</span> <span class="varid">i</span>) <span class="varid">j</span>) (<span class="agda-fun">tr</span> (<span class="keyglyph">\</span><span class="varid">j</span> <span class="keyglyph">→</span> <span class="conid">AB</span> <span class="varop">^</span> <span class="agda-fun">icase</span> <span class="agda-ctor">i₀</span> <span class="varid">i</span> <span class="varid">j</span>) <span class="varid">x</span>)))) <span class="varid">y</span> </pre><p>the <tt class='complex'><span class="agda-fun">tr-tr</span></tt> rule handles one such case, but more are possible. For well-behaved equalities flatting all this out is not a problem, but with univalence the intermediate steps become important. </p><p>4. I am not entirely happy with univalence breaking confluence in combination with <tt class='complex'><span class="agda-fun">trans-sym</span></tt>. It means that you have to be really careful about what, seemingly benign, reductions are allowed. </p> Traversing syntax trees http://twanvl.nl/blog/haskell/traversing-syntax-trees 2017-08-23T00:26:00Z <p>When working with syntax trees (such as in <a href="https://www.twanvl.nl/blog/hott/indexed-equality-implementation">a type theory interpreter</a>) you often want to apply some operation to all subtrees of a node, or to all nodes of a certain type. Of course you can do this easily by writing a recursive function. But then you would need to have a case for every constructor, and there can be many constructors. </p><p>Instead of writing a big recursive function for each operation, it is often easier to use a traversal function. Which is what this post is about. In particular, I will describe my favorite way to handle such traversal, in the hope that it is useful to others as well. </p><p>As a running example we will use the following data type, which represents expressions in a simple lambda calculus </p><pre class="haskell"><span class="comment">-- Lambda calculus with de Bruijn indices</span> <span class="keyword">data</span> <span class="conid">Exp</span> <span class="keyglyph">=</span> <span class="conid">Var</span> <span class="varop">!</span><span class="conid">Int</span> <span class="keyglyph">|</span> <span class="conid">Lam</span> <span class="conid">Exp</span> <span class="keyglyph">|</span> <span class="conid">App</span> <span class="conid">Exp</span> <span class="conid">Exp</span> <span class="keyglyph">|</span> <span class="conid">Global</span> <span class="conid">String</span> <span class="keyword">deriving</span> <span class="conid">Show</span> <div class='empty-line'></div> <span class="varid">example<sub>1</sub></span> <span class="keyglyph">::</span> <span class="conid">Exp</span> <span class="varid">example<sub>1</sub></span> <span class="keyglyph">=</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">Var</span> <span class="num">0</span> <span class="comment">-- The identity function</span> <div class='empty-line'></div> <span class="varid">example<sub>2</sub></span> <span class="keyglyph">::</span> <span class="conid">Exp</span> <span class="varid">example<sub>2</sub></span> <span class="keyglyph">=</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">Var</span> <span class="num">1</span> <span class="comment">-- The const function</span> <div class='empty-line'></div> <span class="varid">example<sub>3</sub></span> <span class="keyglyph">::</span> <span class="conid">Exp</span> <span class="varid">example<sub>3</sub></span> <span class="keyglyph">=</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">Lam</span> <span class="varop">$</span> <span class="conid">App</span> (<span class="conid">Var</span> <span class="num">2</span>) (<span class="conid">App</span> (<span class="conid">Var</span> <span class="num">1</span>) (<span class="conid">Var</span> <span class="num">0</span>)) <span class="comment">-- Function composition</span> </pre><p>Now, what do I mean by a traversal function? The base library comes with the <tt><span class="conid">Traversable</span></tt> class, but that doesn't quite fit our purposes, because that class is designed for containers that can contain any type a. But expressions can only contain other sub-expressions. Instead we need a monomorphic variant of <tt><span class="varid">traverse</span></tt> for our expression type: </p><pre class="haskell"><span class="varid">traverseExp</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) </pre><p>The idea is that <tt><span class="varid">traverseExp</span></tt> applies a given function to all direct children of an expression. </p><p>The <a href="http://hackage.haskell.org/package/uniplate">uniplate</a> package defines a similar function, <a href="http://hackage.haskell.org/package/uniplate-1.6.12/docs/Data-Generics-Uniplate-Operations.html#v:descendM"><tt><span class="varid">descendM</span></tt></a>. But it has two problems: 1) <tt><span class="varid">descendM</span></tt> has a <tt><span class="conid">Monad</span></tt> constraint instead of <tt><span class="conid">Applicative</span></tt>, and 2) the class actually requires you to implement a <tt><span class="varid">uniplate</span></tt> method, which is more annoying to do. </p><p>The ever intimidating <a href="http://hackage.haskell.org/package/lens">lens</a> package has a closer match in <a href="http://hackage.haskell.org/package/lens-4.15.4/docs/Control-Lens-Plated.html"><tt><span class="varid">plate</span></tt></a>. But aside from the terrible name, that function also lacks a way to keep track of bound variables. </p><p>For a language with binders, like the lambda calculus, many operations need to know which variables are bound. In particular, when working with de Bruijn indices, it is necessary to keep track of the number of bound variables. To do that we define </p><pre class="haskell"><span class="keyword">type</span> <span class="conid">Depth</span> <span class="keyglyph">=</span> <span class="conid">Int</span> <span class="comment">-- Traverse over immediate children, with depth</span> <span class="varid">traverseExpD</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="varid">traverseExpD</span> <span class="varid">_</span> <span class="varid">_</span> (<span class="conid">Var</span> <span class="varid">i</span>) <span class="keyglyph">=</span> <span class="varid">pure</span> (<span class="conid">Var</span> <span class="varid">i</span>) <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> (<span class="conid">Lam</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="conid">Lam</span> <span class="varop">&lt;$&gt;</span> <span class="varid">f</span> (<span class="varid">d</span><span class="varop">+</span><span class="num">1</span>) <span class="varid">x</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> (<span class="conid">App</span> <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">=</span> <span class="conid">App</span> <span class="varop">&lt;$&gt;</span> <span class="varid">f</span> <span class="varid">d</span> <span class="varid">x</span> <span class="varop">&lt;*&gt;</span> <span class="varid">f</span> <span class="varid">d</span> <span class="varid">y</span> <span class="varid">traverseExpD</span> <span class="varid">_</span> <span class="varid">_</span> (<span class="conid">Global</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="varid">pure</span> (<span class="conid">Global</span> <span class="varid">x</span>) </pre><p>Once we have written this function, other traversals can be defined in terms of <tt><span class="varid">traverseExpD</span></tt> </p><pre class="haskell"><span class="comment">-- Traverse over immediate children</span> <span class="varid">traverseExp</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="varid">traverseExp</span> <span class="varid">f</span> <span class="keyglyph">=</span> <span class="varid">traverseExpD</span> (<span class="varid">const</span> <span class="varid">f</span>) <span class="num">0</span> </pre><p>And map and fold are just traversals with a specific applicative functor, <tt><span class="conid">Identity</span></tt> and <tt class='complex'><span class="conid">Const</span> <span class="varid">a</span></tt> respectively. Recent versions of GHC are smart enough to know that it is safe to <tt><span class="varid">coerce</span></tt> from a traversal function to a mapping or folding one. </p><pre class="haskell"><span class="comment">-- Map over immediate children, with depth</span> <span class="varid">mapExpD</span> <span class="keyglyph">::</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span>) <span class="varid">mapExpD</span> <span class="keyglyph">=</span> <span class="varid">coerce</span> (<span class="varid">traverseExpD</span> <span class="keyglyph">::</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Identity</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Identity</span> <span class="conid">Exp</span>)) <div class='empty-line'></div> <span class="comment">-- Map over immediate children</span> <span class="varid">mapExp</span> <span class="keyglyph">::</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span>) <span class="varid">mapExp</span> <span class="keyglyph">=</span> <span class="varid">coerce</span> (<span class="varid">traverseExp</span> <span class="keyglyph">::</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Identity</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Identity</span> <span class="conid">Exp</span>)) <div class='empty-line'></div> <span class="comment">-- Fold over immediate children, with depth</span> <span class="varid">foldExpD</span> <span class="keyglyph">::</span> <span class="keyword">forall</span> <span class="varid">a</span><span class="varop">.</span> <span class="conid">Monoid</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="varid">foldExpD</span> <span class="keyglyph">=</span> <span class="varid">coerce</span> (<span class="varid">traverseExpD</span> <span class="keyglyph">::</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Const</span> <span class="varid">a</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Const</span> <span class="varid">a</span> <span class="conid">Exp</span>)) <div class='empty-line'></div> <span class="comment">-- Fold over immediate children</span> <span class="varid">foldExp</span> <span class="keyglyph">::</span> <span class="keyword">forall</span> <span class="varid">a</span><span class="varop">.</span> <span class="conid">Monoid</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">a</span>) <span class="varid">foldExp</span> <span class="keyglyph">=</span> <span class="varid">coerce</span> (<span class="varid">traverseExp</span> <span class="keyglyph">::</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Const</span> <span class="varid">a</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Const</span> <span class="varid">a</span> <span class="conid">Exp</span>)) </pre><p>After doing all this work, it is easy to answer questions like "how often is a variable used?" </p><pre class="haskell"><span class="varid">varCount</span> <span class="keyglyph">::</span> <span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Sum</span> <span class="conid">Int</span> <span class="varid">varCount</span> <span class="varid">i</span> (<span class="conid">Var</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="keyglyph">=</span> <span class="conid">Sum</span> <span class="num">1</span> <span class="varid">varCount</span> <span class="varid">i</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">foldExpD</span> <span class="varid">varCount</span> <span class="varid">i</span> <span class="varid">x</span> </pre><p>or "what is the set of all free variables?" </p><pre class="haskell"><span class="varid">freeVars</span> <span class="keyglyph">::</span> <span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Set</span> <span class="conid">Int</span> <span class="varid">freeVars</span> <span class="varid">d</span> (<span class="conid">Var</span> <span class="varid">i</span>) <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&lt;</span> <span class="varid">d</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">empty</span> <span class="comment">-- bound variable</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="conid">Set</span><span class="varop">.</span><span class="varid">singleton</span> (<span class="varid">i</span> <span class="varop">-</span> <span class="varid">d</span>) <span class="comment">-- free variable</span> <span class="varid">freeVars</span> <span class="varid">d</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">foldExpD</span> <span class="varid">freeVars</span> <span class="varid">d</span> <span class="varid">x</span> </pre><p>Or to perform (silly) operations like changing all globals to lower case </p><pre class="haskell"><span class="varid">lowerCase</span> <span class="keyglyph">::</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="varid">lowerCase</span> (<span class="conid">Global</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="conid">Global</span> (<span class="varid">map</span> <span class="varid">toLower</span> <span class="varid">x</span>) <span class="varid">lowerCase</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">mapExp</span> <span class="varid">lowerCase</span> <span class="varid">x</span> </pre><p>These functions follows a common pattern of specifying how a particular constructor, in this case <tt><span class="conid">Var</span></tt> or <tt><span class="conid">Global</span></tt>, is handled, while for all other constructors traversing over the child expressions. </p><p>As another example, consider substitution, a very important operation on syntax trees. In its most general form, we can combine substitution with raising expressions to a larger context (also called weakening). And we should also consider leaving the innermost, bound, variables alone. This means that there are three possibilities for what to do with a variable. </p><pre class="haskell"><span class="varid">substRaiseByAt</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Exp</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="varid">substRaiseByAt</span> <span class="varid">ss</span> <span class="varid">r</span> <span class="varid">d</span> (<span class="conid">Var</span> <span class="varid">i</span>) <span class="keyglyph">|</span> <span class="varid">i</span> <span class="varop">&lt;</span> <span class="varid">d</span> <span class="keyglyph">=</span> <span class="conid">Var</span> <span class="varid">i</span> <span class="comment">-- A bound variable, leave it alone</span> <span class="keyglyph">|</span> <span class="varid">i</span><span class="varop">-</span><span class="varid">d</span> <span class="varop">&lt;</span> <span class="varid">length</span> <span class="varid">ss</span> <span class="keyglyph">=</span> <span class="varid">raiseBy</span> <span class="varid">d</span> (<span class="varid">ss</span> <span class="varop">!!</span> (<span class="varid">i</span><span class="varop">-</span><span class="varid">d</span>)) <span class="comment">-- substitution</span> <span class="keyglyph">|</span> <span class="varid">otherwise</span> <span class="keyglyph">=</span> <span class="conid">Var</span> (<span class="varid">i</span> <span class="varop">-</span> <span class="varid">length</span> <span class="varid">ss</span> <span class="varop">+</span> <span class="varid">r</span>) <span class="comment">-- free variable, raising</span> <span class="varid">substRaiseByAt</span> <span class="varid">ss</span> <span class="varid">r</span> <span class="varid">d</span> <span class="varid">x</span> <span class="keyglyph">=</span> <span class="varid">mapExpD</span> (<span class="varid">substRaiseByAt</span> <span class="varid">ss</span> <span class="varid">r</span>) <span class="varid">d</span> <span class="varid">x</span> </pre><p>Similarly to <tt><span class="varid">varCount</span></tt>, we use <tt><span class="varid">mapExpD</span></tt> to handle all constructors besides variables. Plain substitution and raising are just special cases. </p><pre class="haskell"><span class="comment">-- Substitute the first few free variables, weaken the rest</span> <span class="varid">substRaiseBy</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Exp</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="varid">substRaiseBy</span> <span class="varid">ss</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">substRaiseByAt</span> <span class="varid">ss</span> <span class="varid">r</span> <span class="num">0</span> <div class='empty-line'></div> <span class="varid">raiseBy</span> <span class="keyglyph">::</span> <span class="conid">Int</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="varid">raiseBy</span> <span class="varid">r</span> <span class="keyglyph">=</span> <span class="varid">substRaiseBy</span> <span class="listcon">[</span><span class="listcon">]</span> <span class="varid">r</span> <div class='empty-line'></div> <span class="varid">subst</span> <span class="keyglyph">::</span> <span class="listcon">[</span><span class="conid">Exp</span><span class="listcon">]</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="varid">subst</span> <span class="varid">ss</span> <span class="keyglyph">=</span> <span class="varid">substRaiseBy</span> <span class="varid">ss</span> <span class="num">0</span> </pre><pre class="ghci"><span class="input">λ&gt;</span> <span class="varid">raiseBy</span> <span class="num">2</span> (<span class="conid">App</span> (<span class="conid">Var</span> <span class="num">1</span>) (<span class="conid">Var</span> <span class="num">2</span>)) <span class="conid">App</span> (<span class="conid">Var</span> <span class="num">3</span>) (<span class="conid">Var</span> <span class="num">4</span>) <div class='empty-line'></div> <span class="input">λ&gt;</span> <span class="varid">subst</span> <span class="listcon">[</span><span class="conid">Global</span> <span class="str">&quot;x&quot;</span><span class="listcon">]</span> (<span class="conid">App</span> (<span class="conid">Var</span> <span class="num">0</span>) (<span class="conid">Lam</span> (<span class="conid">Var</span> <span class="num">0</span>))) <span class="conid">App</span> (<span class="conid">Global</span> <span class="str">&quot;x&quot;</span>) (<span class="conid">Lam</span> (<span class="conid">Var</span> <span class="num">0</span>)) <div class='empty-line'></div> <span class="input">λ&gt;</span> <span class="varid">substRaiseBy</span> <span class="listcon">[</span><span class="conid">App</span> (<span class="conid">Global</span> <span class="str">&quot;x&quot;</span>) (<span class="conid">Var</span> <span class="num">0</span>)<span class="listcon">]</span> <span class="num">2</span> <span class="varop">$</span> <span class="conid">App</span> (<span class="conid">Lam</span> (<span class="conid">App</span> (<span class="conid">Var</span> <span class="num">1</span>) (<span class="conid">Var</span> <span class="num">0</span>))) (<span class="conid">Var</span> <span class="num">2</span>) <span class="conid">App</span> (<span class="conid">Lam</span> (<span class="conid">App</span> (<span class="conid">App</span> (<span class="conid">Global</span> <span class="str">&quot;x&quot;</span>) (<span class="conid">Var</span> <span class="num">1</span>)) (<span class="conid">Var</span> <span class="num">0</span>))) (<span class="conid">Var</span> <span class="num">3</span>) </pre><p>As a slight generalization, it can also make sense to put <tt><span class="varid">traverseExpD</span></tt> into a type class. That way we can traverse over the subexpressions inside other data types. For instance, if the language uses a separate data type for case alternatives, we might write </p><pre class="haskell"><span class="keyword">data</span> <span class="conid">Exp</span> <span class="keyglyph">=</span> <span class="varop">...</span> <span class="keyglyph">|</span> <span class="conid">Case</span> <span class="listcon">[</span><span class="conid">Alt</span><span class="listcon">]</span> <div class='empty-line'></div> <span class="keyword">data</span> <span class="conid">Alt</span> <span class="keyglyph">=</span> <span class="conid">Alt</span> <span class="conid">Pat</span> <span class="conid">Exp</span> <div class='empty-line'></div> <span class="keyword">class</span> <span class="conid">TraverseExp</span> <span class="varid">a</span> <span class="keyword">where</span> <span class="varid">traverseExpD</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="conid">Depth</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="conid">Depth</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>) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">TraverseExp</span> <span class="varid">a</span> <span class="keyglyph">=&gt;</span> <span class="conid">TraverseExp</span> <span class="listcon">[</span><span class="varid">a</span><span class="listcon">]</span> <span class="keyword">where</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> <span class="keyglyph">=</span> <span class="varid">traverse</span> (<span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span>) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">TraverseExp</span> <span class="conid">Exp</span> <span class="keyword">where</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> <span class="varop">...</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> (<span class="conid">Case</span> <span class="varid">xs</span>) <span class="keyglyph">=</span> <span class="conid">Case</span> <span class="varop">&lt;$&gt;</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> <span class="varid">xs</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">TraverseExp</span> <span class="conid">Alt</span> <span class="keyword">where</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> <span class="varid">d</span> (<span class="conid">Alt</span> <span class="varid">x</span> <span class="varid">y</span>) <span class="keyglyph">=</span> <span class="conid">Alt</span> <span class="varid">x</span> <span class="varop">&lt;$&gt;</span> <span class="varid">traverseExpD</span> <span class="varid">f</span> (<span class="varid">d</span> <span class="varop">+</span> <span class="varid">varsBoundByPat</span> <span class="varid">x</span>) <span class="varid">y</span> </pre><p>Another variation is to track other things besides the number of bound variables. For example we might track the names and types of bound variables for better error messages. And with a type class it is possible to track different aspects of bindings as needed, </p><pre class="haskell"><span class="keyword">class</span> <span class="conid">Env</span> <span class="varid">env</span> <span class="keyword">where</span> <span class="varid">extend</span> <span class="keyglyph">::</span> <span class="conid">VarBinding</span> <span class="keyglyph">-&gt;</span> <span class="varid">env</span> <span class="keyglyph">-&gt;</span> <span class="varid">env</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Env</span> <span class="conid">Depth</span> <span class="keyword">where</span> <span class="varid">extend</span> <span class="varid">_</span> <span class="keyglyph">=</span> (<span class="varop">+</span><span class="num">1</span>) <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Env</span> <span class="listcon">[</span><span class="conid">VarBinding</span><span class="listcon">]</span> <span class="keyword">where</span> <span class="varid">extend</span> <span class="keyglyph">=</span> <span class="listcon">(:)</span> <div class='empty-line'></div> <span class="keyword">instance</span> <span class="conid">Env</span> () <span class="keyword">where</span> <span class="varid">extend</span> <span class="varid">_</span> <span class="varid">_</span> <span class="keyglyph">=</span> () <div class='empty-line'></div> <span class="varid">traverseExpEnv</span> <span class="keyglyph">::</span> <span class="conid">Applicative</span> <span class="varid">f</span> <span class="keyglyph">=&gt;</span> (<span class="varid">env</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="keyglyph">-&gt;</span> (<span class="varid">env</span> <span class="keyglyph">-&gt;</span> <span class="conid">Exp</span> <span class="keyglyph">-&gt;</span> <span class="varid">f</span> <span class="conid">Exp</span>) <span class="varid">traverseExpEnv</span> <span class="varid">f</span> <span class="varid">env</span> (<span class="conid">Lam</span> <span class="varid">name</span> <span class="varid">x</span>) <span class="keyglyph">=</span> <span class="conid">Lam</span> <span class="varop">&lt;$&gt;</span> <span class="varid">f</span> (<span class="varid">extend</span> <span class="varid">name</span> <span class="varid">env</span>) <span class="varid">x</span> <span class="varid">traverseExpEnv</span> <span class="varid">f</span> <span class="varid">env</span> <span class="varop">...</span> </pre><p>Overall, I have found that after writing <tt><span class="varid">traverseExpD</span></tt> once, I rarely have to look at all constructors again. I can just handle the default cases by traversing the children. </p><p>A nice thing about this pattern is that it is very efficient. The <tt><span class="varid">traverseExpD</span></tt> function is not recursive, which means that the compiler can inline it. So after optimization, a function like <tt><span class="varid">lowerCase</span></tt> or <tt><span class="varid">varCount</span></tt> is exactly what you would have written by hand. </p> 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="haskell"><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="haskell"><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="haskell"><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> <div class='empty-line'></div> <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="haskell"><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="haskell"><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="haskell"><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="haskell"> <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="haskell"> <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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"><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="haskell"> <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="haskell"> <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="haskell"> <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