<div dir="ltr">I didn't say arbitrary.<div><br></div><div>At the risk of an overly complicated example, just because I have it handy:<br><div><p class="">In the following type: <font face="monospace, monospace">rep 1000 "a"</font> folds in logarithmic time, lots of operations actually get to exploit the obliviousness of (*>) and (<*) and (>>) to one argument or the other's values to exploit replication heavily for parts of the result as well. This is needed to match the asymptotics of Fritz Henglein's linear time table joins in a final encoding for instance.</p><div>
<p class=""><font face="monospace, monospace"><span class="">data</span><span class=""> Table a </span><span class="">=</span><span class=""> Table</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> { count </span><span class="">::</span><span class=""> </span><span class="">{-# UNPACK #-}</span><span class=""> </span><span class="">!</span><span class="">Int</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> , runTable </span><span class="">::</span><span class=""> forall r</span><span class="">.</span><span class=""> Monoid r </span><span class="">=></span><span class=""> (a </span><span class="">-></span><span class=""> r) </span><span class="">-></span><span class=""> r</span></font></p>
<p class=""><span class=""><font face="monospace, monospace"> }</font></span></p><p class=""><span class=""><font face="monospace, monospace"><br></font></span></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> IsList (Table a) </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">type</span><span class=""> Item (Table a) </span><span class="">=</span><span class=""> a</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> fromList </span><span class="">=</span><span class=""> foldMap pure</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> toList </span><span class="">=</span><span class=""> Foldable.toList</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> fromListN n xs </span><span class="">=</span><span class=""> Table n (</span><span class="">`foldMap`</span><span class=""> xs)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Functor Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> fmap f (Table i m) </span><span class="">=</span><span class=""> Table i </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> m (k</span><span class="">.</span><span class="">f)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Foldable Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> foldMap f (Table _ m) </span><span class="">=</span><span class=""> m f</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> foldr f z (Table _ m) </span><span class="">=</span><span class=""> m (Endo </span><span class="">.</span><span class=""> f) </span><span class="">`appEndo`</span><span class=""> z</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Monoid (Table a) </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mempty </span><span class="">=</span><span class=""> Table </span><span class="">0</span><span class=""> </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">_ </span><span class="">-></span><span class=""> mempty</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mappend (Table i m) (Table j n) </span><span class="">=</span><span class=""> Table (i </span><span class="">+</span><span class=""> j) </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> m k </span><span class="">`mappend`</span><span class=""> n k</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">newtype</span><span class=""> Ap f a </span><span class="">=</span><span class=""> Ap { runAp </span><span class="">::</span><span class=""> f a }</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> (Applicative f, Monoid a) </span><span class="">=></span><span class=""> Monoid (Ap f a) </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mempty </span><span class="">=</span><span class=""> Ap (pure mempty)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mappend (Ap m) (Ap n) </span><span class="">=</span><span class=""> Ap (liftA2 mappend m n)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Traversable Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">-- this reassembles the result with sharing!</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> traverse f </span><span class="">=</span><span class=""> runAp </span><span class="">.</span><span class=""> foldMap (Ap </span><span class="">.</span><span class=""> fmap pure </span><span class="">.</span><span class=""> f)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Applicative Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> pure a </span><span class="">=</span><span class=""> Table </span><span class="">1</span><span class=""> </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> k a</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> Table n as </span><span class=""><*></span><span class=""> Table m bs </span><span class="">=</span><span class=""> Table (n </span><span class="">*</span><span class=""> m) </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> as </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">f </span><span class="">-></span><span class=""> bs (k </span><span class="">.</span><span class=""> f)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> Table n as </span><span class=""><*</span><span class=""> Table m _ </span><span class="">=</span><span class=""> Table (n </span><span class="">*</span><span class=""> m) </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> as (rep m </span><span class="">.</span><span class=""> k)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> Table n _ </span><span class="">*></span><span class=""> Table m bs </span><span class="">=</span><span class=""> Table (n </span><span class="">*</span><span class=""> m) </span><span class="">$</span><span class=""> rep n </span><span class="">.</span><span class=""> bs</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><span class=""><font face="monospace, monospace">-- peasant multiplication</font></span></p>
<p class=""><font face="monospace, monospace"><span class="">rep </span><span class="">::</span><span class=""> Monoid m </span><span class="">=></span><span class=""> Int </span><span class="">-></span><span class=""> m </span><span class="">-></span><span class=""> m</span></font></p>
<p class=""><span class=""><font face="monospace, monospace">rep y0 x0</font></span></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> y0 </span><span class=""><=</span><span class=""> </span><span class="">0</span><span class=""> </span><span class="">=</span><span class=""> mempty</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> otherwise </span><span class="">=</span><span class=""> f x0 y0</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">where</span></font></p>
<p class=""><span class=""><font face="monospace, monospace"> f x y</font></span></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> even y </span><span class="">=</span><span class=""> f (mappend x x) (quot y </span><span class="">2</span><span class="">)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> y </span><span class="">==</span><span class=""> </span><span class="">1</span><span class=""> </span><span class="">=</span><span class=""> x</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> otherwise </span><span class="">=</span><span class=""> g (mappend x x) (quot (y </span><span class="">-</span><span class=""> </span><span class="">1</span><span class="">) </span><span class="">2</span><span class="">) x</span></font></p>
<p class=""><span class=""><font face="monospace, monospace"> g x y z</font></span></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> even y </span><span class="">=</span><span class=""> g (mappend x x) (quot y </span><span class="">2</span><span class="">) z</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> y </span><span class="">==</span><span class=""> </span><span class="">1</span><span class=""> </span><span class="">=</span><span class=""> mappend x z</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">|</span><span class=""> otherwise </span><span class="">=</span><span class=""> g (mappend x x) (quot (y </span><span class="">-</span><span class=""> </span><span class="">1</span><span class="">) </span><span class="">2</span><span class="">) (mappend x z)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">bag </span><span class="">::</span><span class=""> (forall m</span><span class="">.</span><span class=""> Monoid m </span><span class="">=></span><span class=""> (a </span><span class="">-></span><span class=""> m) </span><span class="">-></span><span class=""> m) </span><span class="">-></span><span class=""> Table a</span></font></p>
<p class=""><font face="monospace, monospace"><span class="">bag k </span><span class="">=</span><span class=""> Table (getSum </span><span class="">$</span><span class=""> k </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">_ </span><span class="">-></span><span class=""> Sum </span><span class="">1</span><span class="">) k</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Monad Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> return a </span><span class="">=</span><span class=""> Table </span><span class="">1</span><span class=""> </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> k a</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> as </span><span class="">>>=</span><span class=""> f </span><span class="">=</span><span class=""> bag </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> runTable as </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">a </span><span class="">-></span><span class=""> runTable (f a) k</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> (</span><span class="">>></span><span class="">) </span><span class="">=</span><span class=""> (</span><span class="">*></span><span class="">)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> fail _ </span><span class="">=</span><span class=""> empty</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> MonadZip Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> </span><span class="">-- we can handle this in a smarter fashion now</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mzipWith k m n </span><span class="">=</span><span class=""> foldMap pure </span><span class="">$</span><span class=""> mzipWith k (Foldable.toList m) (Foldable.toList n)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> munzip m </span><span class="">=</span><span class=""> (fmap fst m, fmap snd m)</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> Alternative Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> empty </span><span class="">=</span><span class=""> Table </span><span class="">0</span><span class=""> </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">_ </span><span class="">-></span><span class=""> mempty</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> Table m as </span><span class=""><|></span><span class=""> Table n bs </span><span class="">=</span><span class=""> Table (m </span><span class="">+</span><span class=""> n) </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> as k </span><span class="">`mappend`</span><span class=""> bs k</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> MonadPlus Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mzero </span><span class="">=</span><span class=""> Table </span><span class="">0</span><span class=""> </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">_ </span><span class="">-></span><span class=""> mempty</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> Table m as </span><span class="">`mplus`</span><span class=""> Table n bs </span><span class="">=</span><span class=""> Table (m </span><span class="">+</span><span class=""> n) </span><span class="">$</span><span class=""> </span><span class="">\</span><span class="">k </span><span class="">-></span><span class=""> as k </span><span class="">`mappend`</span><span class=""> bs k</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""></span><br></font></p>
<p class=""><font face="monospace, monospace"><span class="">instance</span><span class=""> MonadFix Table </span><span class="">where</span></font></p>
<p class=""><font face="monospace, monospace"><span class=""> mfix a2ba </span><span class="">=</span><span class=""> foldMap pure </span><span class="">$</span><span class=""> mfix (Foldable.toList </span><span class="">.</span><span class=""> a2ba)</span></font></p>
<p class=""><br><span class=""></span></p><p class="">etc.</p></div></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Sun, Feb 1, 2015 at 4:17 PM, Roman Cheplyaka <span dir="ltr"><<a href="mailto:roma@ro-che.info" target="_blank">roma@ro-che.info</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">On 01/02/15 22:56, Edward Kmett wrote:<br>
> sum = getSum . foldMap sum<br>
><br>
> is the implementation that ensures that it doesn't destroy the<br>
> asymptotics of the number of uses of 'mappend' in foldMap.<br>
><br>
> The right container can readily fold 2^20th a's with 20 mappends.<br>
<br>
</span>Fold 2^20 *arbitrary* a's? What kind of container is that?<br>
<span class="HOEnZb"><font color="#888888"><br>
Roman<br>
</font></span></blockquote></div><br></div>