Skip to content

Instantly share code, notes, and snippets.

@purcell
Last active November 18, 2019 09:52
Show Gist options
  • Save purcell/d5d9de9101a738b7f1fc97c511b1fb22 to your computer and use it in GitHub Desktop.
Save purcell/d5d9de9101a738b7f1fc97c511b1fb22 to your computer and use it in GitHub Desktop.
Multiple aggregates in a single pass, using Purescript
-- This is based on ideas from the excellent article "Beautiful Aggregations
-- with Haskell" by Evan Borden: https://tech.freckle.com/2017/09/22/aggregations/
module Aggregation where
import Prelude
import Data.Foldable (foldMap)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (un)
type Person = { name :: String, occupation :: String, age :: Int }
rows :: Array Person
rows = [ { name: "Bob", occupation: "Dentist", age: 34 }
, { name: "Tim", occupation: "Nurse", age: 25 }
, { name: "Ann", occupation: "Programmer", age: 47 }
, { name: "Mae", occupation: "Astronaut", age: 38 }
, { name: "Ann", occupation: "Truck driver", age: 55 }
]
-- | Produce some summary information from a given list of people in a single pass.
-- |
-- | > summary rows
-- | { annCount: 2, occupations: ["Dentist","Nurse","Programmer","Astronaut","Truck driver"], sumOfAges: 199 }
-- |
-- | Note that this could be written more concisely/generally, but I'm trying to be explicit.
summary :: Array Person -> { occupations :: Array String, sumOfAges :: Int, annCount :: Int }
summary people =
-- foldMap works like a map/reduce, where each value in a collection is put into a
-- monoidal value, and those "wrapped" values are combined together into a single
-- value by the particular monoid that is in use.
unpack (foldMap step people)
where
-- Return a monoidal result for each folded item. It just so happens
-- that a record whose fields are all monoids is also a monoid, so this function
-- just returns a record. These records get combined together into a single record
-- by having their corresponding field values successively combined monoidally.
step { name, occupation, age } =
{ occupations: pure occupation
, sumOfAges: pure age
, annCount: if name == "Ann" then pure 1 else mempty }
-- Unpack the combined monoidal accumulator, which just involves unpacking
-- individual fields
unpack { occupations, sumOfAges, annCount } =
{ occupations, sumOfAges: un Additive sumOfAges, annCount: un Additive annCount }
@purcell
Copy link
Author

purcell commented Mar 10, 2019

This can be written more succinctly, though with a bit more magic, using the Control.Fold library:

module Aggregation where

import Prelude

import Control.Fold as F
import Data.Profunctor (lcmap)

type Person = { name :: String, occupation :: String, age :: Int }

rows :: Array Person
rows = [ { name: "Bob", occupation: "Dentist", age: 34 }
       , { name: "Tim", occupation: "Nurse", age: 25 }
       , { name: "Ann", occupation: "Programmer", age: 47 }
       , { name: "Mae", occupation: "Astronaut", age: 38 }
       , { name: "Ann", occupation: "Truck driver", age: 55 }
       ]

type Summary = { occupations :: Array String, sumOfAges :: Int, annCount :: Int }

-- | Produce some summary information from a given list of people in a single pass.
-- |
-- | > summary rows
-- | { annCount: 2, occupations: ["Dentist","Nurse","Programmer","Astronaut","Truck driver"], sumOfAges: 199 }
summary :: Array Person -> Summary
summary people = F.foldl summF people

summF :: F.Fold Person Summary
summF = toRec
        <$> (pure <<< _.occupation) `lcmap` F.mconcat
        <*> _.age `lcmap` F.sum
        <*> (\p -> if p.name == "Ann" then 1 else 0) `lcmap` F.sum
  where
    toRec occupations sumOfAges annCount = { occupations, sumOfAges, annCount }

@purcell
Copy link
Author

purcell commented Mar 14, 2019

Here are some extra little fold combinators I wrote:

import Control.Comonad as CoM
import Control.Fold
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex)
import Data.Map (Map, alter)
import Data.Maybe (fromMaybe)

groupBy :: forall a r g . Ord g => (a -> g) -> Fold a r -> Fold a (Map g r)
groupBy grouper f1 = unfoldFold mempty combine (map CoM.extract)
  where
    combine :: Map g (Fold a r) -> a -> Map g (Fold a r)
    combine m x = alter (\mf -> pure (stepFold x (fromMaybe f1 mf))) (grouper x) m

flattenWithIndex :: forall a g r b fi . FoldableWithIndex g fi => Monoid b => (g -> r -> b) -> Fold a (fi r) -> Fold a b
flattenWithIndex f = map (foldMapWithIndex f)

@sergeyklay
Copy link

👍

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment