[Haskell-beginners] A better way to "integrate"

David McBride toad3k at gmail.com
Wed May 21 03:07:46 UTC 2014


Though I'm late to the party I might as well post what I have.  Anyways
yeah foldr/foldl is the answer when you find yourself iterating over a list
with an accumulator.

aggregate :: [(Price,Volume)] -> [(Price, Volume)]
aggregate = reverse . snd . foldl' proc ((0,0),[])
  where
    proc  ((!totalp,!totalv),sofar) (Price !p,Volume !v) =
      let adjustedprice = round (fromIntegral p * v)
      in ((adjustedprice+totalp,v+totalv), ((Price $ adjustedprice +
totalp, Volume $ v+totalv) : sofar))

Just make sure you use foldl' instead of foldl for performance reasons.
And also try to prepend to lists whenever possible and then reverse if you
need to.


On Tue, May 20, 2014 at 10:12 PM, Dimitri DeFigueiredo <
defigueiredo at ucdavis.edu> wrote:

> Awesome haskellers,
>
> I am coding up a little function that aggregates "ask orders" in a
> currency exchange.
> Another way to look at it, is that the function takes as input a histogram
> or fdf (in list format) and outputs the cumulative distribution cdf (also
> in list format). So we are kind of "integrating" the input list.
>
> When given a list of asks in order of increasing price, the function
> returns a list of points in the graph of the total supply curve.
>
> Here's an example:
>
> asks:                           returned list:
>
> [ (Price 42, Volume 0.5),      [ (Price 21,         Volume 0.5),
>   (Price 50, Volume  1 ),        (Price 21+50=71,   Volume 1.5),
>   (Price 55, Volume 0.2)]        (Price 21+50+11=82,Volume 1.7)]
>
> the returned list gives us the total supply curve (price = y-axis,
> quantity/volume = x-axis, so the order is flipped)
>
> Summarizing
>
> * We're adding up the volumes. The last volume on the list is the total
> volume available for sale.
> * We calculate the total amount to be paid to buy the current volume (for
> each item in the list).
>
> I have written up a simple function to do this:
>
> aggregate :: Num a => [(a,a)] -> [(a,a)]
> aggregate xs = aggregate' 0 0 xs
>
> aggregate' :: Num a => a -> a -> [(a,a)] -> [(a,a)]
> aggregate' _ _ [] = []
> aggregate' accX accY ((x,y):ls) = let accX' = accX + x * y
>                                       accY' = accY +     y
>
>                                       in  (accX',accY') : aggregate' accX'
> accY' ls
>
>
> main = print $ aggregate [(42,0.5),(50,1),(55,0.2)]
>
> However, this does not look very good to me and it feels like I'm
> reinventing the wheel.
>
> Question: Is there a better Haskell way to do this? I'm really anal about
> making it easy to read.
>
> Thanks!
>
> Dimitri
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20140520/1157071a/attachment.html>


More information about the Beginners mailing list