packages feed

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 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)