Frames-map-reduce 0.2.0.0 → 0.3.0.0
raw patch · 12 files changed
+675/−51 lines, 12 filesdep +vectordep ~basedep ~map-reduce-foldsdep ~vinylPVP ok
version bump matches the API change (PVP)
Dependencies added: vector
Dependency ranges changed: base, map-reduce-folds, vinyl
API changes (from Hackage documentation)
+ Frames.Aggregation: aggregateAllFold :: forall ak ak' d. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (Record ak'), Ord (Record ak), RecVec (ak' ++ d)) => RecordKeyMap ak ak' -> Fold (Record d) (Record d) -> Fold (Record (ak ++ d)) (FrameRec (ak' ++ d))
+ Frames.Aggregation: aggregateFold :: forall k ak ak' d. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (Record ak'), RecVec (ak' ++ d), Ord (Record ak), (k ++ (ak' ++ d)) ~ ((k ++ ak') ++ d), Ord (Record k), k ⊆ ((k ++ ak') ++ d), k ⊆ ((k ++ ak) ++ d), (ak ++ d) ⊆ ((k ++ ak) ++ d), RecVec ((k ++ ak') ++ d)) => RecordKeyMap ak ak' -> Fold (Record d) (Record d) -> Fold (Record ((k ++ ak) ++ d)) (FrameRec ((k ++ ak') ++ d))
+ Frames.Aggregation: combineKeyAggregations :: (a ⊆ (a ++ b), b ⊆ (a ++ b), Disjoint a' b' ~ 'True) => RecordKeyMap a a' -> RecordKeyMap b b' -> RecordKeyMap (a ++ b) (a' ++ b')
+ Frames.Aggregation: keyMap :: forall a b. (KnownField a, KnownField b) => (Snd a -> Snd b) -> RecordKeyMap '[a] '[b]
+ Frames.Aggregation: mergeDataFolds :: Fold (Record d) (Record '[a]) -> Fold (Record d) (Record '[b]) -> Fold (Record d) (Record '[a, b])
+ Frames.Aggregation: type RecordKeyMap k k' = Record k -> Record k'
+ Frames.Aggregation.General: aggregateAllFold :: forall (ak :: [(Symbol, Type)]) ak' d record f. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (record (f :. ElField) ak'), Ord (record (f :. ElField) ak), RCastC (ak' ++ d) ((ak ++ d) ++ ak') record f, RCastC ak (ak ++ d) record f, RCastC ak' (ak' ++ d) record f, RCastC d (ak' ++ d) record f, IsoRec d record f, IsoRec (ak ++ d) record f, IsoRec (ak' ++ d) record f, IsoRec ak' record f, IsoRec ((ak ++ d) ++ ak') record f) => RecordKeyMap record f ak ak' -> Fold (record (f :. ElField) d) (record (f :. ElField) d) -> Fold (record (f :. ElField) (ak ++ d)) [record (f :. ElField) (ak' ++ d)]
+ Frames.Aggregation.General: aggregateFold :: forall (k :: [(Symbol, Type)]) ak ak' d record f. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (record (f :. ElField) ak'), Ord (record (f :. ElField) ak), (k ++ (ak' ++ d)) ~ ((k ++ ak') ++ d), Ord (record (f :. ElField) k), k ⊆ ((k ++ ak') ++ d), k ⊆ ((k ++ ak) ++ d), (ak ++ d) ⊆ ((k ++ ak) ++ d), RCastC ak (ak ++ d) record f, RCastC ak' (ak' ++ d) record f, RCastC d (ak' ++ d) record f, RCastC k ((k ++ ak) ++ d) record f, RCastC (ak ++ d) ((k ++ ak) ++ d) record f, RCastC (ak' ++ d) ((ak ++ d) ++ ak') record f, IsoRec k record f, IsoRec d record f, IsoRec ((k ++ ak') ++ d) record f, IsoRec (ak ++ d) record f, IsoRec (ak' ++ d) record f, IsoRec ak' record f, IsoRec ((ak ++ d) ++ ak') record f) => RecordKeyMap record f ak ak' -> Fold (record (f :. ElField) d) (record (f :. ElField) d) -> Fold (record (f :. ElField) ((k ++ ak) ++ d)) [record (f :. ElField) ((k ++ ak') ++ d)]
+ Frames.Aggregation.General: combineKeyAggregations :: forall (a :: [(Symbol, Type)]) b a' b' record f. (a ⊆ (a ++ b), b ⊆ (a ++ b), Disjoint a' b' ~ 'True, RCastC a (a ++ b) record f, RCastC b (a ++ b) record f, IsoRec a' record f, IsoRec b' record f, IsoRec (a' ++ b') record f) => RecordKeyMap record f a a' -> RecordKeyMap record f b b' -> RecordKeyMap record f (a ++ b) (a' ++ b')
+ Frames.Aggregation.General: keyMap :: forall a b record f. (KnownField a, KnownField b, RecGetFieldC a record f '[a], IsoRec '[b] record f, Applicative f) => (Snd a -> Snd b) -> RecordKeyMap record f '[a] '[b]
+ Frames.Aggregation.General: mergeDataFolds :: forall (a :: (Symbol, Type)) b d record f. (IsoRec '[b] record f, IsoRec '[a] record f, IsoRec '[a, b] record f) => Fold (record (f :. ElField) d) (record (f :. ElField) '[a]) -> Fold (record (f :. ElField) d) (record (f :. ElField) '[b]) -> Fold (record (f :. ElField) d) (record (f :. ElField) '[a, b])
+ Frames.Aggregation.General: type RecordKeyMap record f k k' = record (f :. ElField) k -> record (f :. ElField) k'
+ Frames.Aggregation.Maybe: aggregateAllFold :: forall (ak :: [(Symbol, Type)]) ak' d record. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (record (Maybe :. ElField) ak'), Ord (record (Maybe :. ElField) ak), RCastC (ak' ++ d) ((ak ++ d) ++ ak') record Maybe, RCastC ak (ak ++ d) record Maybe, RCastC ak' (ak' ++ d) record Maybe, RCastC d (ak' ++ d) record Maybe, IsoRec d record Maybe, IsoRec (ak ++ d) record Maybe, IsoRec (ak' ++ d) record Maybe, IsoRec ak' record Maybe, IsoRec ((ak ++ d) ++ ak') record Maybe) => RecordKeyMap record Maybe ak ak' -> Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) d) -> Fold (record (Maybe :. ElField) (ak ++ d)) [record (Maybe :. ElField) (ak' ++ d)]
+ Frames.Aggregation.Maybe: aggregateFold :: forall (k :: [(Symbol, Type)]) ak ak' d record. ((ak' ++ d) ⊆ ((ak ++ d) ++ ak'), ak ⊆ (ak ++ d), ak' ⊆ (ak' ++ d), d ⊆ (ak' ++ d), Ord (record (Maybe :. ElField) ak'), Ord (record (Maybe :. ElField) ak), (k ++ (ak' ++ d)) ~ ((k ++ ak') ++ d), Ord (record (Maybe :. ElField) k), k ⊆ ((k ++ ak') ++ d), k ⊆ ((k ++ ak) ++ d), (ak ++ d) ⊆ ((k ++ ak) ++ d), RCastC ak (ak ++ d) record Maybe, RCastC ak' (ak' ++ d) record Maybe, RCastC d (ak' ++ d) record Maybe, RCastC k ((k ++ ak) ++ d) record Maybe, RCastC (ak ++ d) ((k ++ ak) ++ d) record Maybe, RCastC (ak' ++ d) ((ak ++ d) ++ ak') record Maybe, IsoRec k record Maybe, IsoRec d record Maybe, IsoRec ((k ++ ak') ++ d) record Maybe, IsoRec (ak ++ d) record Maybe, IsoRec (ak' ++ d) record Maybe, IsoRec ak' record Maybe, IsoRec ((ak ++ d) ++ ak') record Maybe) => RecordKeyMap record Maybe ak ak' -> Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) d) -> Fold (record (Maybe :. ElField) ((k ++ ak) ++ d)) [record (Maybe :. ElField) ((k ++ ak') ++ d)]
+ Frames.Aggregation.Maybe: combineKeyAggregations :: forall (a :: [(Symbol, Type)]) b a' b' record. (a ⊆ (a ++ b), b ⊆ (a ++ b), Disjoint a' b' ~ 'True, RCastC a (a ++ b) record Maybe, RCastC b (a ++ b) record Maybe, IsoRec a' record Maybe, IsoRec b' record Maybe, IsoRec (a' ++ b') record Maybe) => RecordKeyMap record Maybe a a' -> RecordKeyMap record Maybe b b' -> RecordKeyMap record Maybe (a ++ b) (a' ++ b')
+ Frames.Aggregation.Maybe: keyMap :: forall a b record. (KnownField a, KnownField b, RecGetFieldC a record Maybe '[a], IsoRec '[b] record Maybe, Applicative Maybe) => (Snd a -> Snd b) -> RecordKeyMap record Maybe '[a] '[b]
+ Frames.Aggregation.Maybe: mergeDataFolds :: forall (a :: (Symbol, Type)) b d record. (IsoRec '[b] record Maybe, IsoRec '[a] record Maybe, IsoRec '[a, b] record Maybe) => Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) '[a]) -> Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) '[b]) -> Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) '[a, b])
+ Frames.Aggregation.Maybe: type RecordKeyMap record f k k' = record (f :. ElField) k -> record (f :. ElField) k'
+ Frames.Folds: toFoldRecord :: KnownField t => Fold (Record rs) (Snd t) -> FoldRecord ElField rs t
+ Frames.Folds.General: toFoldRecord :: (a -> g b) -> Fold (record (f :. ElField) rs) a -> FoldRecord record f g rs b
+ Frames.Folds.Maybe: toFoldRecord :: (a -> g b) -> Fold (record (Maybe :. ElField) rs) a -> FoldRecord record Maybe g rs b
+ Frames.MapReduce.General: isoRecAppend :: forall f record (as :: [(Symbol, Type)]) bs. (IsoRec as record f, IsoRec bs record f, IsoRec (as ++ bs) record f) => record (f :. ElField) as -> record (f :. ElField) bs -> record (f :. ElField) (as ++ bs)
- Frames.MapReduce.Maybe: unpackGoodRecRows :: forall cs rs record. RCastC cs rs Rec Maybe => Unpack (Rec (Maybe :. ElField) rs) (Rec (Maybe :. ElField) rs)
+ Frames.MapReduce.Maybe: unpackGoodRecRows :: forall cs rs. RCastC cs rs Rec Maybe => Unpack (Rec (Maybe :. ElField) rs) (Rec (Maybe :. ElField) rs)
Files
- CHANGELOG.md +12/−0
- Frames-map-reduce.cabal +9/−5
- examples/AddRowsByLabel.hs +39/−1
- src/Frames/Aggregation.hs +151/−0
- src/Frames/Aggregation/General.hs +205/−0
- src/Frames/Aggregation/Maybe.hs +190/−0
- src/Frames/Folds.hs +20/−7
- src/Frames/Folds/General.hs +17/−3
- src/Frames/Folds/Maybe.hs +13/−7
- src/Frames/MapReduce.hs +1/−5
- src/Frames/MapReduce/General.hs +14/−10
- src/Frames/MapReduce/Maybe.hs +4/−13
CHANGELOG.md view
@@ -1,3 +1,15 @@+v 0.3.0.0+* Added Combinator for aggregation in Frames.Aggregation along with helpers to create folds over data cols, promote simple functions to+record functions to be used in aggregations, combine key aggregations.+* Added ```toRecordFold``` to the Folds modules to simplify making record to record folds from record to Type folds. See examples.+* Added an example of its use in the example.+* Added the full record/functor generalization in Frames.Aggregation.General+* Added the specialization to ```Maybe``` in Frames.Aggregation.Maybe+* Cleanup of unneccesary imports+* Suppressed Orphan Instance warnings about Hashable instances for ```Record``` and general record types. These+instances should properly be in Vinyl.+* Bumped some upper bounds for GHC 8.8. Still can't compile with 8.8+ until discrimination is updated.+ v 0.2.0.0 * Added Combinators for ```record (Maybe :. ElField) rs``` (Much thanks to Tim Pierson, @o1lo01ol1o, for the idea and the work!). * Added Combinators polymorphic in record type (```Rec```, ```ARec``` or ```SRec``` are supported) and composed interpretation functor ```f :. ElField```
Frames-map-reduce.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: Frames-map-reduce-version: 0.2.0.0+version: 0.3.0.0 synopsis: Frames wrapper for map-reduce-folds and some extra folds helpers. description: Frames-map-reduce provides some helpers for using the map-reduce-folds library with vinyl records and Frames. These include functions for filtering Frames, splitting records into key columns and data columns and@@ -31,14 +31,17 @@ , Frames.MapReduce , Frames.MapReduce.Maybe , Frames.MapReduce.General+ , Frames.Aggregation+ , Frames.Aggregation.General+ , Frames.Aggregation.Maybe build-depends: Frames >= 0.6.1 && < 0.7,- base >= 4.12.0 && < 4.13,+ base >= 4.12.0 && < 4.14, containers >= 0.5.0 && < 0.7, hashable >= 1.2.7 && < 1.4,- map-reduce-folds >= 0.1.0.0, + map-reduce-folds >= 0.1.0.0 && < 0.1.0.5, profunctors >= 5.3 && < 5.6,- vinyl >= 0.11.0 && < 0.12,+ vinyl >= 0.11.0 && < 0.13, foldl >= 1.4.5 && < 1.5, newtype >= 0.2 && < 0.3 hs-source-dirs: src@@ -54,7 +57,8 @@ foldl, Frames, Frames-map-reduce,- text >= 1.2.3 && < 1.3, + text >= 1.2.3 && < 1.3,+ vector, vinyl, random >= 1.1 && < 1.2, default-language: Haskell2010
examples/AddRowsByLabel.hs view
@@ -1,28 +1,40 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE InstanceSigs #-}+ module Main where import qualified Control.Foldl as FL import qualified Data.List as L import qualified Data.Text as T+import qualified Data.Vector as Vec import qualified Data.Vinyl as V import Data.Vinyl.Functor ( Compose(..) , (:.) ) import qualified Frames as F import qualified Frames.CSV as F+import qualified Frames.InCore as FI import qualified Frames.Folds as FF import qualified Frames.Folds.Maybe as FFM import qualified Frames.MapReduce as FMR import qualified Frames.MapReduce.Maybe as FMRM+import qualified Frames.Aggregation as FA import System.Random ( newStdGen , randomRs ) +import Data.Kind ( Type )+import GHC.TypeLits ( KnownSymbol+ , Symbol+ )+ -- Create types for the cols type Label = "label" F.:-> T.Text type Y = "y" F.:-> Double@@ -44,7 +56,28 @@ mrFold = FMR.concatFold $ FMR.mapReduceFold unpack assign reduce +-- This looks more awkward than it will be in practice since you will usually+-- have these folds already+aggDataFold :: FL.Fold (F.Record '[Y, X]) (F.Record '[Y, X])+aggDataFold =+ let sumYF = FL.premap (F.rgetField @Y) FL.sum+ sumProdXYF = FL.premap (\r -> F.rgetField @X r * F.rgetField @Y r) FL.sum+ wgtdSumXF = (\sXY sY -> sXY / sY) <$> sumProdXYF <*> sumYF+ in FF.sequenceRecFold+ $ FF.toFoldRecord sumYF+ V.:& FF.toFoldRecord wgtdSumXF+ V.:& V.RNil +data AggKey = AorB | Other deriving (Eq, Ord, Show)+type instance FI.VectorFor AggKey = Vec.Vector++type AggKeyCol = "AggKey" F.:-> AggKey++groupLabels :: FA.RecordKeyMap '[Label] '[AggKeyCol]+groupLabels = FA.keyMap $ \l -> if (l `elem` ["A", "B"]) then AorB else Other++aggFold = FA.aggregateFold @'[] groupLabels aggDataFold+ -- Bleh, this should go in Frames. instance (Eq (F.ElField a)) => Eq (Compose Maybe F.ElField a) where (==) (Compose fga) (Compose fga') = fga == fga'@@ -83,6 +116,8 @@ putStrLn $ (L.intercalate "\n" $ fmap show $ FL.fold FL.list result) let result' = FMR.fold mrFold' createHolyRows putStrLn . unlines . fmap show $ FL.fold FL.list result'+ let aggregatedResult = FMR.fold aggFold f+ putStrLn $ (L.intercalate "\n" $ fmap show $ FL.fold FL.list aggregatedResult) {- Output {label :-> "A", y :-> 1577.3965303339942, x :-> 1507.286289962377}@@ -90,6 +125,9 @@ {label :-> "C", y :-> 1528.6898777108415, x :-> 1810.5096765228654} {Just label :-> "A", Just x :-> 5.0, Just y :-> 2.0} {Just label :-> "Z", Just x :-> 5.0, Just y :-> 9.0}++{AggKey :-> AorB, y :-> 3857.3338804158475, x :-> 48.675203593420946}+{AggKey :-> Other, y :-> 45655.25138686513, x :-> 47.24947893453326} -} --- create the Frame
+ src/Frames/Aggregation.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+{-|+Module : Frames.Aggregation+Description : A specialised Map/Reduce for aggregating one set of keys to a smaller one given some operation to merge data. +Copyright : (c) Adam Conner-Sax 2019+License : BSD+Maintainer : adam_conner_sax@yahoo.com+Stability : experimental++Frames.Aggregation.General contains types and functions to support a specific map/reduce operation. Frequently, data is given+with more specificity than required for downstream operations. Perhaps an age is given in years and we only need to know the+age-band. Assuming we know how to aggregagte data columns, we want to perform that aggregation on all the subsets required to+build the data-set with the simpler key, while perhaps leaving some other columns alone. @aggregateFold@ does this.+-}+module Frames.Aggregation+ (+ -- * Type-alias for maps from one record key to another+ RecordKeyMap+ -- * Aggregation Function combinators+ , combineKeyAggregations+ , keyMap+ -- * aggregationFolds+ , aggregateAllFold+ , aggregateFold+ , mergeDataFolds+ )+where++import qualified Control.MapReduce as MR+import qualified Frames.MapReduce as FMR++import qualified Control.Foldl as FL++import qualified Frames as F+import qualified Frames.Melt as F+import qualified Frames.InCore as FI+import qualified Data.Vinyl as V+import qualified Data.Vinyl.TypeLevel as V++-- | Type-alias for key aggregation functions.+type RecordKeyMap k k' = F.Record k -> F.Record k'++-- | Combine 2 key aggregation functions over disjoint columns.+combineKeyAggregations+ :: (a F.⊆ (a V.++ b), b F.⊆ (a V.++ b), F.Disjoint a' b' ~ 'True)+ => RecordKeyMap a a'+ -> RecordKeyMap b b'+ -> RecordKeyMap (a V.++ b) (a' V.++ b')+combineKeyAggregations aToa' bTob' r =+ aToa' (F.rcast r) `V.rappend` bTob' (F.rcast r)++-- | Promote an ordinary function @a -> b@ to a @RecordKeyMap aCol bCol@ where+-- @aCol@ holds values of type @a@ and @bCol@ holds values of type @b@.+keyMap+ :: forall a b+ . (V.KnownField a, V.KnownField b)+ => (V.Snd a -> V.Snd b)+ -> RecordKeyMap '[a] '[b]+keyMap f r = f (F.rgetField @a r) F.&: V.RNil++-- | Given some group keys in columns k,+-- some keys to aggregate over in columns ak,+-- some keys to aggregate into in (new) columns ak',+-- a (hopefully surjective) map from records of ak to records of ak',+-- and a fold over the data, in columns d, aggregating over the rows+-- where ak was distinct but ak' is not,+-- produce a fold to transform data keyed by k and ak to data keyed+-- by k and ak' with appropriate aggregations done in the d.+-- E.g., suppose you have voter turnout data for all 50 states in the US,+-- keyed by state and age of voter in years. The data is two columns:+-- total votes cast and turnout as a percentage.+-- You want to aggregate the ages into two bands, over and under some age.+-- So your k is the state column, ak is the age column, ak' is a new column with+-- data type to indicate over/under. The Fold has to sum over the total votes and+-- perform a weighted-sum over the percentages.+aggregateAllFold+ :: forall ak ak' d+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (F.Record ak')+ , Ord (F.Record ak)+ , FI.RecVec (ak' V.++ d)+ )+ => RecordKeyMap ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (F.Record d) (F.Record d)) -- ^ aggregate data+ -> FL.Fold (F.Record (ak V.++ d)) (F.FrameRec (ak' V.++ d))+aggregateAllFold toAggKey aggDataF =+ let aggUnpack =+ MR.Unpack+ (\r -> [F.rcast @(ak' V.++ d) $ r `V.rappend` (toAggKey (F.rcast r))]) -- add new keys, lose old+ aggAssign = FMR.assignKeysAndData @ak' @d+ in FMR.concatFold+ $ FMR.mapReduceFold aggUnpack aggAssign (FMR.foldAndAddKey aggDataF)++-- | Aggregate key columns @ak@ into @ak'@ while leaving key columns @k@ along.+-- Allows aggregation over only some fields. Will often require a typeapplication+-- to specify what @k@ is.+aggregateFold+ :: forall k ak ak' d+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (F.Record ak')+ , FI.RecVec (ak' V.++ d)+ , Ord (F.Record ak)+ , (k V.++ (ak' V.++ d)) ~ ((k V.++ ak') V.++ d)+ , Ord (F.Record k)+ , k F.⊆ ((k V.++ ak') V.++ d)+ , k F.⊆ ((k V.++ ak) V.++ d)+ , (ak V.++ d) F.⊆ ((k V.++ ak) V.++ d)+ , FI.RecVec ((k V.++ ak') V.++ d)+ )+ => RecordKeyMap ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (F.Record d) (F.Record d)) -- ^ aggregate data+ -> FL.Fold+ (F.Record (k V.++ ak V.++ d))+ (F.FrameRec (k V.++ ak' V.++ d))+aggregateFold keyAgg aggDataF = FMR.concatFold $ FMR.mapReduceFold+ MR.noUnpack+ (FMR.assignKeysAndData @k @(ak V.++ d))+ ( FMR.makeRecsWithKey id+ $ MR.ReduceFold (const $ aggregateAllFold keyAgg aggDataF)+ )+++mergeDataFolds+ :: FL.Fold (F.Record d) (F.Record '[a])+ -> FL.Fold (F.Record d) (F.Record '[b])+ -> FL.Fold (F.Record d) (F.Record '[a, b])+mergeDataFolds aF bF = V.rappend <$> aF <*> bF
+ src/Frames/Aggregation/General.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+ {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+{-|+Module : Frames.Aggregation.General+Description : A specialised Map/Reduce for aggregating one set of keys to a smaller one given some operation to merge data. +Copyright : (c) Adam Conner-Sax 2019+License : BSD+Maintainer : adam_conner_sax@yahoo.com+Stability : experimental++Frames.Aggregation.General contains types and functions to support a specific map/reduce operation. Frequently, data is given+with more specificity than required for downstream operations. Perhaps an age is given in years and we only need to know the+age-band. Assuming we know how to aggregagte data columns, we want to perform that aggregation on all the subsets required to+build the data-set with the simpler key, while perhaps leaving some other columns alone. @aggregateFold@ does this.+-}+module Frames.Aggregation.General+ (+ -- * Type-alias for maps from one record key to another+ RecordKeyMap+ -- * Aggregation Function combinators+ , combineKeyAggregations+ , keyMap+ -- * aggregationFolds+ , aggregateAllFold+ , aggregateFold+ , mergeDataFolds+ )+where++import Frames.MapReduce.General ( RecGetFieldC(..)+ , RCastC(..)+ , IsoRec(..)+ , isoRecAppend+ )++import qualified Control.MapReduce as MR+import qualified Frames.MapReduce.General as FMR++import qualified Control.Foldl as FL++import qualified Frames as F+import qualified Frames.Melt as F+import qualified Data.Vinyl as V+import qualified Data.Vinyl.TypeLevel as V++import Data.Vinyl ( ElField )+import qualified Data.Vinyl.Functor as V+import Frames ( (:.) )++import GHC.TypeLits ( Symbol )+import Data.Kind ( Type )++-- | Type-alias for key aggregation functions.+type RecordKeyMap record f k k' = record (f :. ElField) k -> record (f :. ElField) k'++-- | Combine 2 key aggregation functions over disjoint columns.+combineKeyAggregations+ :: forall (a :: [(Symbol, Type)]) b a' b' record f+ . ( a F.⊆ (a V.++ b)+ , b F.⊆ (a V.++ b)+ , F.Disjoint a' b' ~ 'True+ , RCastC a (a V.++ b) record f+ , RCastC b (a V.++ b) record f+ , IsoRec a' record f+ , IsoRec b' record f+ , IsoRec (a' V.++ b') record f+ )+ => RecordKeyMap record f a a'+ -> RecordKeyMap record f b b'+ -> RecordKeyMap record f (a V.++ b) (a' V.++ b')+combineKeyAggregations aToa' bTob' r =+ aToa' (rcastF r) `isoRecAppend` bTob' (rcastF r)++-- | Promote an ordinary function @a -> b@ to a @RecordKeyMap aCol bCol@ where+-- @aCol@ holds values of type @a@ and @bCol@ holds values of type @b@.+keyMap+ :: forall a b record f+ . ( V.KnownField a+ , V.KnownField b+ , RecGetFieldC a record f '[a]+ , IsoRec '[b] record f+ , Applicative f+ )+ => (V.Snd a -> V.Snd b)+ -> RecordKeyMap record f '[a] '[b]+keyMap g r =+ fromRec+ $ (V.Compose . fmap (V.Field . g . V.getField) . V.getCompose) (rgetF @a r)+ V.:& V.RNil++-- | Given some group keys in columns k,+-- some keys to aggregate over in columns ak,+-- some keys to aggregate into in (new) columns ak',+-- a (hopefully surjective) map from records of ak to records of ak',+-- and a fold over the data, in columns d, aggregating over the rows+-- where ak was distinct but ak' is not,+-- produce a fold to transform data keyed by k and ak to data keyed+-- by k and ak' with appropriate aggregations done in the d.+-- E.g., suppose you have voter turnout data for all 50 states in the US,+-- keyed by state and age of voter in years. The data is two columns:+-- total votes cast and turnout as a percentage.+-- You want to aggregate the ages into two bands, over and under some age.+-- So your k is the state column, ak is the age column, ak' is a new column with+-- data type to indicate over/under. The Fold has to sum over the total votes and+-- perform a weighted-sum over the percentages.+aggregateAllFold+ :: forall (ak :: [(Symbol, Type)]) ak' d record f+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (record (f :. ElField) ak')+ , Ord (record (f :. ElField) ak)+ , RCastC (ak' V.++ d) ((ak V.++ d) V.++ ak') record f+ , RCastC ak (ak V.++ d) record f+ , RCastC ak' (ak' V.++ d) record f+ , RCastC d (ak' V.++ d) record f+ , IsoRec d record f+ , IsoRec (ak V.++ d) record f+ , IsoRec (ak' V.++ d) record f+ , IsoRec ak' record f+ , IsoRec ((ak V.++ d) V.++ ak') record f+ )+ => RecordKeyMap record f ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (record (f :. ElField) d) (record (f :. ElField) d)) -- ^ aggregate data+ -> FL.Fold+ (record (f :. ElField) (ak V.++ d))+ [(record (f :. ElField) (ak' V.++ d))]+aggregateAllFold toAggKey aggDataF =+ let aggUnpack+ :: MR.Unpack+ (record (f :. ElField) (ak V.++ d))+ (record (f :. ElField) (ak' V.++ d))+ aggUnpack =+ MR.Unpack (\r -> [rcastF $ r `isoRecAppend` toAggKey (rcastF r)]) -- add new keys, lose old+ aggAssign = FMR.assignKeysAndData @ak' @d+ in MR.mapReduceFold aggUnpack aggAssign (FMR.foldAndAddKey aggDataF)++-- | Aggregate key columns @ak@ into @ak'@ while leaving key columns @k@ along.+-- Allows aggregation over only some fields. Will often require a typeapplication+-- to specify what @k@ is.+aggregateFold+ :: forall (k :: [(Symbol, Type)]) ak ak' d record f+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (record (f :. ElField) ak')+ , Ord (record (f :. ElField) ak)+ , (k V.++ (ak' V.++ d)) ~ ((k V.++ ak') V.++ d)+ , Ord (record (f :. ElField) k)+ , k F.⊆ ((k V.++ ak') V.++ d)+ , k F.⊆ ((k V.++ ak) V.++ d)+ , (ak V.++ d) F.⊆ ((k V.++ ak) V.++ d)+ , RCastC ak (ak V.++ d) record f+ , RCastC ak' (ak' V.++ d) record f+ , RCastC d (ak' V.++ d) record f+ , RCastC k ((k V.++ ak) V.++ d) record f+ , RCastC (ak V.++ d) ((k V.++ ak) V.++ d) record f+ , RCastC (ak' V.++ d) ((ak V.++ d) V.++ ak') record f+ , IsoRec k record f+ , IsoRec d record f+ , IsoRec ((k V.++ ak') V.++ d) record f+ , IsoRec (ak V.++ d) record f+ , IsoRec (ak' V.++ d) record f+ , IsoRec ak' record f+ , IsoRec ((ak V.++ d) V.++ ak') record f+ )+ => RecordKeyMap record f ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (record (f :. ElField) d) (record (f :. ElField) d)) -- ^ aggregate data+ -> FL.Fold+ (record (f :. ElField) (k V.++ ak V.++ d))+ [record (f :. ElField) (k V.++ ak' V.++ d)]+aggregateFold keyAgg aggDataF = MR.concatFold $ MR.mapReduceFold+ MR.noUnpack+ (FMR.assignKeysAndData @k @(ak V.++ d))+ ( FMR.makeRecsWithKey id+ $ MR.ReduceFold (const $ aggregateAllFold keyAgg aggDataF)+ )+++mergeDataFolds+ :: forall (a :: (Symbol, Type)) b d record f+ . (IsoRec '[b] record f, IsoRec '[a] record f, IsoRec '[a, b] record f)+ => FL.Fold (record (f :. ElField) d) (record (f :. ElField) '[a])+ -> FL.Fold (record (f :. ElField) d) (record (f :. ElField) '[b])+ -> FL.Fold (record (f :. ElField) d) (record (f :. ElField) '[a, b])+mergeDataFolds aF bF = isoRecAppend <$> aF <*> bF
+ src/Frames/Aggregation/Maybe.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+ {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+{-|+Module : Frames.Aggregation.Maybe+Description : A specialised Map/Reduce for aggregating one set of keys to a smaller one given some operation to merge data. +Copyright : (c) Adam Conner-Sax 2019+License : BSD+Maintainer : adam_conner_sax@yahoo.com+Stability : experimental++Frames.Aggregation.Maybe contains types and functions to support a specific but common map/reduce operation.+Frequently, data is given with more specificity than required for downstream operations.+Perhaps an age is given in years and we only need to know the+age-band. Assuming we know how to aggregagte data columns, we want to perform that aggregation on all the subsets required to+build the data-set with the simpler key, while perhaps leaving some other columns alone. @aggregateFold@ does this.++This module specializes the general versions to the (Maybe :. ElField) intepretation functor since that is a frequent use case.+-}+module Frames.Aggregation.Maybe+ (+ -- * Type-alias for maps from one record key to another+ RecordKeyMap+ -- * Aggregation Function combinators+ , combineKeyAggregations+ , keyMap+ -- * aggregationFolds+ , aggregateAllFold+ , aggregateFold+ , mergeDataFolds+ )+where++import Frames.MapReduce.General ( RecGetFieldC(..)+ , RCastC(..)+ , IsoRec(..)+ )++import qualified Frames.Aggregation.General as FA+import Frames.Aggregation.General ( RecordKeyMap )+import qualified Frames as F+import Frames ( (:.) )+import qualified Frames.Melt as F+import qualified Data.Vinyl as V+import Data.Vinyl ( ElField )+import qualified Data.Vinyl.TypeLevel as V+import qualified Control.Foldl as FL++import GHC.TypeLits ( Symbol )+import Data.Kind ( Type )+++-- | Combine 2 key aggregation functions over disjoint columns.+combineKeyAggregations+ :: forall (a :: [(Symbol, Type)]) b a' b' record+ . ( a F.⊆ (a V.++ b)+ , b F.⊆ (a V.++ b)+ , F.Disjoint a' b' ~ 'True+ , RCastC a (a V.++ b) record Maybe+ , RCastC b (a V.++ b) record Maybe+ , IsoRec a' record Maybe+ , IsoRec b' record Maybe+ , IsoRec (a' V.++ b') record Maybe+ )+ => RecordKeyMap record Maybe a a'+ -> RecordKeyMap record Maybe b b'+ -> RecordKeyMap record Maybe (a V.++ b) (a' V.++ b')+combineKeyAggregations = FA.combineKeyAggregations++-- | Promote an ordinary function @a -> b@ to a @RecordKeyMap aCol bCol@ where+-- @aCol@ holds values of type @a@ and @bCol@ holds values of type @b@.+keyMap+ :: forall a b record+ . ( V.KnownField a+ , V.KnownField b+ , RecGetFieldC a record Maybe '[a]+ , IsoRec '[b] record Maybe+ , Applicative Maybe+ )+ => (V.Snd a -> V.Snd b)+ -> RecordKeyMap record Maybe '[a] '[b]+keyMap = FA.keyMap++-- | Given some group keys in columns k,+-- some keys to aggregate over in columns ak,+-- some keys to aggregate into in (new) columns ak',+-- a (hopefully surjective) map from records of ak to records of ak',+-- and a fold over the data, in columns d, aggregating over the rows+-- where ak was distinct but ak' is not,+-- produce a fold to transform data keyed by k and ak to data keyed+-- by k and ak' with appropriate aggregations done in the d.+-- E.g., suppose you have voter turnout data for all 50 states in the US,+-- keyed by state and age of voter in years. The data is two columns:+-- total votes cast and turnout as a percentage.+-- You want to aggregate the ages into two bands, over and under some age.+-- So your k is the state column, ak is the age column, ak' is a new column with+-- data type to indicate over/under. The Fold has to sum over the total votes and+-- perform a weighted-sum over the percentages.+aggregateAllFold+ :: forall (ak :: [(Symbol, Type)]) ak' d record+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (record (Maybe :. ElField) ak')+ , Ord (record (Maybe :. ElField) ak)+ , RCastC (ak' V.++ d) ((ak V.++ d) V.++ ak') record Maybe+ , RCastC ak (ak V.++ d) record Maybe+ , RCastC ak' (ak' V.++ d) record Maybe+ , RCastC d (ak' V.++ d) record Maybe+ , IsoRec d record Maybe+ , IsoRec (ak V.++ d) record Maybe+ , IsoRec (ak' V.++ d) record Maybe+ , IsoRec ak' record Maybe+ , IsoRec ((ak V.++ d) V.++ ak') record Maybe+ )+ => RecordKeyMap record Maybe ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) d)) -- ^ aggregate data+ -> FL.Fold+ (record (Maybe :. ElField) (ak V.++ d))+ [(record (Maybe :. ElField) (ak' V.++ d))]+aggregateAllFold = FA.aggregateAllFold++-- | Aggregate key columns @ak@ into @ak'@ while leaving key columns @k@ along.+-- Allows aggregation over only some fields. Will often require a typeapplication+-- to specify what @k@ is.+aggregateFold+ :: forall (k :: [(Symbol, Type)]) ak ak' d record+ . ( (ak' V.++ d) F.⊆ ((ak V.++ d) V.++ ak')+ , ak F.⊆ (ak V.++ d)+ , ak' F.⊆ (ak' V.++ d)+ , d F.⊆ (ak' V.++ d)+ , Ord (record (Maybe :. ElField) ak')+ , Ord (record (Maybe :. ElField) ak)+ , (k V.++ (ak' V.++ d)) ~ ((k V.++ ak') V.++ d)+ , Ord (record (Maybe :. ElField) k)+ , k F.⊆ ((k V.++ ak') V.++ d)+ , k F.⊆ ((k V.++ ak) V.++ d)+ , (ak V.++ d) F.⊆ ((k V.++ ak) V.++ d)+ , RCastC ak (ak V.++ d) record Maybe+ , RCastC ak' (ak' V.++ d) record Maybe+ , RCastC d (ak' V.++ d) record Maybe+ , RCastC k ((k V.++ ak) V.++ d) record Maybe+ , RCastC (ak V.++ d) ((k V.++ ak) V.++ d) record Maybe+ , RCastC (ak' V.++ d) ((ak V.++ d) V.++ ak') record Maybe+ , IsoRec k record Maybe+ , IsoRec d record Maybe+ , IsoRec ((k V.++ ak') V.++ d) record Maybe+ , IsoRec (ak V.++ d) record Maybe+ , IsoRec (ak' V.++ d) record Maybe+ , IsoRec ak' record Maybe+ , IsoRec ((ak V.++ d) V.++ ak') record Maybe+ )+ => RecordKeyMap record Maybe ak ak' -- ^ get aggregated key from key+ -> (FL.Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) d)) -- ^ aggregate data+ -> FL.Fold+ (record (Maybe :. ElField) (k V.++ ak V.++ d))+ [record (Maybe :. ElField) (k V.++ ak' V.++ d)]+aggregateFold = FA.aggregateFold @k++mergeDataFolds+ :: forall (a :: (Symbol, Type)) b d record+ . ( IsoRec '[b] record Maybe+ , IsoRec '[a] record Maybe+ , IsoRec '[a, b] record Maybe+ )+ => FL.Fold (record (Maybe :. ElField) d) (record (Maybe :. ElField) '[a])+ -> FL.Fold+ (record (Maybe :. ElField) d)+ (record (Maybe :. ElField) '[b])+ -> FL.Fold+ (record (Maybe :. ElField) d)+ (record (Maybe :. ElField) '[a, b])+mergeDataFolds = FA.mergeDataFolds
src/Frames/Folds.hs view
@@ -1,20 +1,20 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-} {-|@@ -38,6 +38,7 @@ , FoldRecord(..) -- * functions for building records of folds+ , toFoldRecord , recFieldF , fieldToFieldFold @@ -87,6 +88,16 @@ -- | Wrapper for folds from a record to an interpreted field. Usually f ~ ElField newtype FoldRecord f rs a = FoldRecord { unFoldRecord :: FL.Fold (F.Record rs) (f a) } +-- | Create a @FoldRecord@ from a @Fold@ from a record to a specific type.+-- This is helpful when creating folds from a record to another record (or the same record)+-- by building it one field at a time. See examples for details.+toFoldRecord+ :: V.KnownField t+ => FL.Fold (F.Record rs) (V.Snd t)+ -> FoldRecord F.ElField rs t+toFoldRecord = FoldRecord . fmap V.Field+{-# INLINABLE toFoldRecord #-}+ -- | Helper for building a 'FoldRecord' from a given fold and function of the record recFieldF :: forall t rs a@@ -146,10 +157,12 @@ sequenceFieldEndoFolds = sequenceRecFold . endoFieldFoldsToRecordFolds {-# INLINABLE sequenceFieldEndoFolds #-} +{- liftFold :: V.KnownField t => FL.Fold (V.Snd t) (V.Snd t) -> FoldFieldEndo F.ElField t liftFold = FoldFieldEndo . fieldFold {-# INLINABLE liftFold #-}+-} -- This is not a natural transformation, FoldEndoT ~> FoldEndo F.EField, because of the constraint liftFoldEndo :: V.KnownField t => FoldEndo t -> FoldFieldEndo F.ElField t
src/Frames/Folds/General.hs view
@@ -7,10 +7,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -41,6 +41,7 @@ , ConstrainedField -- * functions for building records of folds+ , toFoldRecord , recFieldF , fieldToFieldFold @@ -87,12 +88,24 @@ P.dimap (fmap (\(V.Field x) -> x) . V.getCompose) (V.Compose . fmap V.Field) {-# INLINABLE fieldFold #-} ++ -- | Wrapper for Endo-folds of the field types of ElFields newtype FoldEndo f t = FoldEndo { unFoldEndo :: EndoFold (f (V.Snd t)) } -- | Wrapper for folds from a record to an interpreted field. Usually g ~ ElField newtype FoldRecord record f g rs a = FoldRecord { unFoldRecord :: FL.Fold (record (f :. ElField) rs) (g a) } +-- | Create a @FoldRecord@ from a @Fold@ from a record to a specific type.+-- This is helpful when creating folds from a record to another record (or the same record)+-- by building it one field at a time. See examples for details.+toFoldRecord+ :: (a -> g b)+ -> FL.Fold (record (f :. ElField) rs) a+ -> FoldRecord record f g rs b+toFoldRecord wrap = FoldRecord . fmap wrap+{-# INLINABLE toFoldRecord #-}+ -- | Control.Foldl helper for filtering filteredFold :: (f a -> Maybe a) -> FL.Fold a b -> FL.Fold (f a) b filteredFold toMaybe (FL.Fold step begin done) = FL.Fold step' begin done@@ -171,13 +184,14 @@ sequenceFieldEndoFolds = sequenceRecFold . endoFieldFoldsToRecordFolds {-# INLINABLE sequenceFieldEndoFolds #-} +{- liftFold :: (V.KnownField t, Functor f) => FL.Fold (f (V.Snd t)) (f (V.Snd t)) -> FoldFieldEndo (f :. ElField) t liftFold = FoldFieldEndo . fieldFold {-# INLINABLE liftFold #-}-+-} -- This is not a natural transformation, FoldEndoT ~> FoldEndo F.EField, because of the constraint liftFoldEndo :: (V.KnownField t, Functor f)
src/Frames/Folds/Maybe.hs view
@@ -36,15 +36,16 @@ , FoldEndo(..) , FoldRecord(..) - -- * functions for building records of folds+ -- * functions for building records of folds+ , toFoldRecord , recFieldF , fieldToFieldFold - -- * functions for turning records of folds into folds of records+ -- * functions for turning records of folds into folds of records , sequenceRecFold , sequenceEndoFolds - -- * functions using constraints to extend an endo-fold across a record+ -- * functions using constraints to extend an endo-fold across a record , foldAll , foldAllConstrained , maybeFoldAllConstrained@@ -59,21 +60,26 @@ ) import Frames.Folds ( EndoFold- , FoldFieldEndo(..)- , monoidWrapperToFold , MonoidalField ) import qualified Control.Foldl as FL -import qualified Data.Profunctor as P import qualified Data.Vinyl as V import Data.Vinyl ( ElField ) import qualified Data.Vinyl.TypeLevel as V-import qualified Data.Vinyl.Functor as V import qualified Frames as F import Frames ( (:.) ) import qualified Frames.Melt as F++-- | Create a @FoldRecord@ from a @Fold@ from a record to a specific type.+-- This is helpful when creating folds from a record to another record (or the same record)+-- by building it one field at a time. See examples for details.+toFoldRecord+ :: (a -> g b)+ -> FL.Fold (record (Maybe :. ElField) rs) a+ -> FoldRecord record Maybe g rs b+toFoldRecord = FG.toFoldRecord --FoldRecord . fmap wrap -- | Helper for building a 'FoldRecord' from a given fold and function of the record recFieldF
src/Frames/MapReduce.hs view
@@ -17,6 +17,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE InstanceSigs #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module : Frames.Monomorphic.MapReduce Description : Helpers for using the map-reduce-folds package with Frames. Monomorphic in record and interpretation functor.@@ -57,10 +58,7 @@ import Control.MapReduce -- for re-export import qualified Control.Foldl as FL-import qualified Data.Foldable as F import qualified Data.Hashable as Hash-import qualified Data.List as L-import Data.Monoid ( Monoid(..) ) import Data.Hashable ( Hashable ) import qualified Frames as F@@ -68,8 +66,6 @@ import qualified Frames.InCore as FI import qualified Data.Vinyl as V import qualified Data.Vinyl.TypeLevel as V-import qualified Data.Vinyl.Functor as V-import Data.Coerce ( coerce ) -- | This is only here so we can use hash maps for the grouping step. This should properly be in Frames itself. instance Hash.Hashable (F.Record '[]) where
src/Frames/MapReduce/General.hs view
@@ -17,25 +17,18 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Frames.MapReduce.General where import qualified Control.MapReduce as MR-import Control.MapReduce -- for re-export import qualified Control.Foldl as FL-import qualified Data.Foldable as F import qualified Data.Hashable as Hash-import qualified Data.List as L-import Data.Maybe ( isJust )-import Data.Monoid ( Monoid(..) )-import Data.Hashable ( Hashable ) import Data.Kind ( Type ) import GHC.TypeLits ( Symbol ) -import qualified Frames as F import Frames ( (:.) ) import qualified Frames.Melt as F-import qualified Frames.InCore as FI import qualified Data.Vinyl as V import Data.Vinyl ( ElField ) import qualified Data.Vinyl.Functor as V@@ -99,6 +92,17 @@ toRec = V.fromARec fromRec = V.toARec +isoRecAppend+ :: forall f record (as :: [(Symbol, Type)]) bs+ . (IsoRec as record f, IsoRec bs record f, IsoRec (as V.++ bs) record f)+ => record (f :. ElField) as+ -> record (f :. ElField) bs+ -> record (f :. ElField) (as V.++ bs)+isoRecAppend lhs rhs =+ fromRec @(as V.++ bs) @record @f+ $ (toRec @as @record @f lhs)+ `V.rappend` (toRec @bs @record @f rhs)+ -- | This is only here so we can use hash maps for the grouping step. This should properly be in Frames itself. instance Hash.Hashable (record (f :. ElField) '[]) where hash = const 0@@ -214,7 +218,7 @@ {-# INLINABLE foldAndAddKey #-} -- | Transform a reduce which produces a container of results, with a function from each result to a record,--- into a reduce which produces a FrameRec of the result records with the key re-attached.+-- into a reduce which produces a foldable (based on the original reduce) of the result records with the key re-attached. makeRecsWithKey :: ( Functor g , Foldable g@@ -234,7 +238,7 @@ {-# INLINABLE makeRecsWithKey #-} -- | Transform an effectful reduce which produces a container of results, with a function from each result to a record,--- into a reduce which produces a FrameRec of the result records with the key re-attached.+-- into a reduce which produces a foldable (based on the original reduce) of the result records with the key re-attached. makeRecsWithKeyM :: ( Monad m , Functor g
src/Frames/MapReduce/Maybe.hs view
@@ -17,22 +17,13 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns #-}-module Frames.MapReduce.Maybe- ( module Frames.MapReduce.Maybe--- , module Frames.MapReduce.General- )-where+module Frames.MapReduce.Maybe where+ import qualified Control.MapReduce as MR-import Control.MapReduce -- for re-export import qualified Frames.MapReduce.General as MG import qualified Control.Foldl as FL-import qualified Data.Foldable as F-import qualified Data.Hashable as Hash-import qualified Data.List as L import Data.Maybe ( isJust )-import Data.Monoid ( Monoid(..) )-import Data.Hashable ( Hashable ) import qualified Frames as F import Frames ( (:.) )@@ -40,7 +31,7 @@ import qualified Frames.InCore as FI import qualified Data.Vinyl as V import Data.Vinyl ( ElField )-import qualified Data.Vinyl.Functor as V+--import qualified Data.Vinyl.Functor as V import qualified Data.Vinyl.TypeLevel as V -- | Don't do anything @@ -77,7 +68,7 @@ unpackGoodRows = MG.unpackGoodRows --unpackFilterRow (isJust . F.recMaybe . F.rcast @cs) unpackGoodRecRows- :: forall cs rs record+ :: forall cs rs . (MG.RCastC cs rs V.Rec Maybe) => MR.Unpack (V.Rec (Maybe :. ElField) rs) (V.Rec (Maybe :. ElField) rs) unpackGoodRecRows = MG.unpackGoodRows @cs (isJust . F.recMaybe)