heidi (empty) → 0.0.0
raw patch · 25 files changed
+2903/−0 lines, 25 filesdep +basedep +boxesdep +containerssetup-changed
Dependencies added: base, boxes, containers, criterion, doctest, exceptions, generic-trie, generics-sop, hashable, heidi, microlens, microlens-th, scientific, tasty, tasty-hspec, text, unordered-containers, vector, weigh
Files
- CHANGELOG.md +3/−0
- LICENSE.md +23/−0
- README.md +93/−0
- Setup.hs +7/−0
- app/Main.hs +167/−0
- bench/Space.hs +16/−0
- bench/Time.hs +7/−0
- heidi.cabal +139/−0
- src/Core/Data/Frame.hs +234/−0
- src/Core/Data/Frame/Generic.hs +122/−0
- src/Core/Data/Frame/List.hs +110/−0
- src/Core/Data/Frame/PrettyPrint.hs +175/−0
- src/Core/Data/Row/Internal.hs +28/−0
- src/Data/Generics/Codec.hs +133/−0
- src/Data/Generics/Decode.hs +100/−0
- src/Data/Generics/Encode/Internal.hs +454/−0
- src/Data/Generics/Encode/OneHot.hs +79/−0
- src/Heidi.hs +100/−0
- src/Heidi/Data/Frame/Algorithms/GenericTrie.hs +273/−0
- src/Heidi/Data/Frame/Algorithms/GenericTrie/Generic.hs +40/−0
- src/Heidi/Data/Row/GenericTrie.hs +466/−0
- stack.yaml +37/−0
- test/DocTest.hs +12/−0
- test/Main.hs +23/−0
- test/Unit/GenericTrie.hs +62/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Change log++0.0.0 release candidate (Oct 7, 2020)
+ LICENSE.md view
@@ -0,0 +1,23 @@+[The MIT License (MIT)][]++Copyright (c) 2019-2020 Marco Zocca++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++[The MIT License (MIT)]: https://opensource.org/licenses/MIT
+ README.md view
@@ -0,0 +1,93 @@+# [heidi][]++[](https://travis-ci.com/ocramz/heidi?branch=master)+++[heidi]: https://github.com/ocramz/heidi+++++`heidi` : tidy data in Haskell++This library aims to bridge the gap between Haskell's precise but inflexible type discipline and the dynamic world of dataframes.++If this sounds interesting to you, read on!+++## Introduction++A "dataframe" is conceptually a table of data that can be manipulated with a computer program; it potentially contains numbers, text and anything else that can be rendered as a string of text.++In scientific practice, a "tidy" dataframe is a specific way of arranging the data in which each row represents a distinct observation ("data point") and each column a "feature" (i.e. some observable aspect) of the data. ++Nowadays, data science is a very established practice and many software libraries offer excellent functionality for working with such dataframes. `R` has `tidyverse` , Python has `pandas`, and so on.++What about Haskell?++## TL;DR++```+{-# language DeriveGenerics, DeriveAnyClass #-}+module MyDataScienceTask where++import Heidi++data Sales = Row String Int deriving (Eq, Show, Generic, Heidi)+```++and off you go.++## Rationale+++Out of the box, Haskell offers record types, e.g.++```+data Row a = MkRow { column1 :: Int, column2 :: String } deriving (Eq, Show)+```++which is handy because in one declaration you get a constructor method `MkRow` and accessors `column1`, `column2`, so a simple "data table" could be constructed as a list of such records, simply enough.++One thing that the language doesn't natively support is lookup by accessor name. For example `column1 :: Row -> Int` can only access a value of type `Row`, since the `column1` name is globally unique (for a discussion on modern techniques to deal with this, see the Advanced section below).++In addition to lookup, many data tasks require relational operations across pairs of data tables; algorithmically, these require lookups both across rows and columns, and there's nothing in Haskell's implementation of records that supports this.++There are a number of additional tasks that are routine in data analysis but not so+++## Advanced+++Haskell offers a number of advanced workarounds for manipulating types, such as generic traversals, lookups, etc. A brief list of keywords is given in the following, for those inclined to dive into the rabbit hole.++### Row polymorphism++Elm, Purescript etc.++### OverloadedRecordFields++[1]++### Row types++As you might know, the "row types" problem is well understood and has been explored in practice; discussing the various tradeoffs between approaches would be lengthy and quite technical (and your humble author is not too qualified to do full justice to the topic either).++In Haskell , the Frames [2] library and related ecosystem stands out as a full-featured dataframe implementation that does not compromise on type safety. ++Heidi instead offers generic transformations from the source datatypes to uni-typed values (conceptually, each row is a `Map String T` where `data T = TInt Int | TChar Char` etc.), a domain in which it's convenient to perform lookups and similar operations.++Exploring further : vinyl [3], heterogeneous lists, sums-of-products ...+++++## References++[1] OverloadedRecordFields : https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#record-field-selector-polymorphism++[2] Frames : https://hackage.haskell.org/package/Frames++[3] vinyl : https://hackage.haskell.org/package/vinyl ++[4] generics-sop : https://hackage.haskell.org/package/generics-sop
+ Setup.hs view
@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain
+ app/Main.hs view
@@ -0,0 +1,167 @@+{-# language DeriveAnyClass #-}+{-# language DeriveGeneric #-}+{-# language OverloadedStrings #-}+{-# options_ghc -Wno-unused-imports #-}+module Main where++import Control.Applicative (Alternative)+import GHC.Generics (Generic)+import Data.Typeable+import Control.Monad.Catch++-- import Data.Hashable (Hashable)+-- import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T++-- import Core.Data.Frame+-- import Core.Data.Frame.Generic+-- import qualified Heidi.Data.Row.GenericTrie as GTR+-- import Data.Generics.Encode.Internal (HasGE, TC, VP)+import Heidi -- (Heidi, Frame, TC, VP, gToFrameGT, filterDecode, mkTyN, mkTyCon)+import Heidi.Data.Frame.Algorithms.GenericTrie (innerJoin)++-- import Lens.Micro ((^.), (%~), to, has)++import Prelude hiding (filter, lookup)++-- | Item+data Item a = Itm String a deriving (Eq, Show, Generic, Heidi)++-- | Purchase+data Purchase a = Pur {+ date :: Int+ , pers :: String+ , item :: String+ , qty :: a+ } deriving (Eq, Show, Generic, Heidi)++items :: [Item Double]+items = [i1, i2, i3] where+ i1 = Itm "computer" 1000+ i2 = Itm "car" 5000+ i3 = Itm "legal" 400++purchases :: [Purchase Double]+purchases = [p1, p2, p3, p4, p5] where+ p1 = Pur 7 "bob" "car" 1+ p2 = Pur 5 "alice" "car" 1+ p3 = Pur 4 "bob" "legal" 20+ p4 = Pur 3 "alice" "computer" 2+ p5 = Pur 1 "bob" "computer" 1+++gItems, gPurchases :: Frame (Row [TC] VP)+gItems = encode items+gPurchases = encode purchases++++-- FIXME now we use Traversal' rather than Decode++-- noLegal :: (MonadThrow f, Alternative f) =>+-- String+-- -> Frame (GTR.Row [TC] VP)+-- -> f (Frame (GTR.Row [TC] VP))+-- noLegal k = filterDecode dec where+-- dec r = r ^. GTR.text (keyN k) == "legal"++noLegal :: String -> Frame (Row [TC] VP) -> Frame (Row [TC] VP)+noLegal k = filter look+ where+ look = keep (text (keyN k)) (== "legal")++keyN, keyTyC :: String -> [TC]+keyN k = [mkTyN k]++keyTyC k = [mkTyCon k]+++-- joinTables = innerJoin k1 k2 where+-- k1 = keyN ""+-- k2 = keyN ""+ ++++-- joinTables :: (Foldable t, Hashable v, Eq v) =>+-- t (Row [TC] v) -> t (Row [TC] v) -> Frame (Row [TC] v)+-- joinTables = innerJoin k1 k2 where+-- k1 = [TC "Itm" "_0"]+-- k2 = itemKey++++++++++++++++++++++++++{-+Averaged across persons, excluding legal fees, how much money had each person spent by time 6?++item , price +----------+computer , 1000 +car , 5000 +legal fees (1 hour) , 400++date , person , item-bought , units-bought +------------------------------------+7 , bob , car , 1 +5 , alice , car , 1 +4 , bob , legal fees (1 hour) , 20 +3 , alice , computer , 2 +1 , bob , computer , 1 ++It would be extra cool if you provided both an in-memory and a streaming solution.++Principles|operations it illustrates++Predicate-based indexing|filtering.+Merging (called "joining" in SQL).+Within- and across-group operations.+Sorting.+Accumulation (what Data.List calls "scanning").+Projection (both the "last row" and the "mean" operations).+Statistics (the "mean" operation).++Solution and proposed algorithm (it's possible you don't want to read this)++The answer is $4000. That's because by time 6, Bob had bought 1 computer ($1000) and 20 hours of legal work (excluded), while Alice had bought a car ($5000) and two computers ($2000). In total they had spent $8000, so the across-persons average is $4000.++One way to compute that would be to:++ Delete any purchase of legal fees.+ Merge price and purchase data.+ Compute a new column, "money-spent" = units-bought price.+ Group by person.+ Within each group: Sort by date in increasing order.+ Compute a new column, "accumulated-spending" = running total of money spent.+ Keep the last row with a date no greater than 6; drop all others.+ Across groups, compute the mean of accumulated spending.++-}++++++main :: IO ()+main = pure ()
+ bench/Space.hs view
@@ -0,0 +1,16 @@+module Main where+++-- -- https://hackage.haskell.org/package/weigh-0.0.14/docs/Weigh.html+-- import Weigh (mainWith, func)++-- import qualified Heidi.Data.Row.GenericTrie as GTR (Row, fromList)+-- import qualified Heidi.Data.Frame.Algorithms.GenericTrie as GTR (innerJoin, leftOuterJoin, groupBy)+-- import qualified Heidi.Data.Row.HashMap as HMR (Row, fromList)+-- import qualified Heidi.Data.Frame.Algorithms.HashMap as HMR (innerJoin, leftOuterJoin, groupBy)+-- import Heidi (Frame, fromList)++++main :: IO ()+main = pure ()
+ bench/Time.hs view
@@ -0,0 +1,7 @@+module Main where++import Criterion.Main++main :: IO ()+main = defaultMain [bench "const" (whnf const ())]+
+ heidi.cabal view
@@ -0,0 +1,139 @@+name: heidi+version: 0.0.0+synopsis: Tidy data in Haskell+description: Tidy data in Haskell, via generics.+homepage: https://github.com/ocramz/heidi#readme+bug-reports: https://github.com/ocramz/heidi/issues+author: Marco Zocca+maintainer: Marco Zocca+license: MIT+copyright: (c) 2019-2020, Marco Zocca+category: Data Science, Data Mining, Generics+build-type: Simple+cabal-version: 1.12+tested-with: GHC == 8.0.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5+license-file: LICENSE.md+extra-source-files:+ CHANGELOG.md+ LICENSE.md+ README.md+ stack.yaml++source-repository head+ type: git+ location: https://github.com/ocramz/heidi++library+ exposed-modules:+ Heidi+ Heidi.Data.Frame.Algorithms.GenericTrie++ other-modules:+ Heidi.Data.Row.GenericTrie+ + Heidi.Data.Frame.Algorithms.GenericTrie.Generic + Data.Generics.Codec+ Data.Generics.Encode.OneHot + Data.Generics.Encode.Internal+ Data.Generics.Decode+ Core.Data.Frame+ Core.Data.Frame.List + Core.Data.Frame.PrettyPrint+ Core.Data.Frame.Generic+ Core.Data.Row.Internal+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base > 4.9 && < 4.13+ , boxes >= 0.1.4+ -- , bytestring >= 0.10.8.1+ , containers >= 0.5.7.1+ , exceptions >= 0.8.3+ , generics-sop > 0.3.0+ , generic-trie >= 0.3.1+ , hashable >= 1.2.6.1+ -- , logging-effect+ , microlens >= 0.4.8+ , microlens-th >= 0.4.1+ -- , primitive+ , scientific >= 0.3.5.1+ , text >= 1.2.2.2+ -- , time >= 1.6.0.1+ -- , transformers+ , unordered-containers > 0.2.8+ , vector >= 0.12.0.1+ -- , vector-algorithms+ default-language: Haskell2010+ default-extensions: OverloadedStrings++-- unit tests+test-suite unit+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Unit.GenericTrie+ hs-source-dirs:+ test+ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ build-depends:+ heidi+ , base+ , tasty+ -- , tasty-hunit+ , tasty-hspec+ -- , hspec-expectations+ default-language: Haskell2010++test-suite doctest+ default-language: Haskell2010 + type: exitcode-stdio-1.0+ main-is: DocTest.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ heidi+ , base + , doctest ++benchmark bench-space+ type: exitcode-stdio-1.0+ main-is: Space.hs+ other-modules:+ hs-source-dirs:+ bench+ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ build-depends:+ heidi+ , base+ , weigh+ default-language: Haskell2010+ +benchmark bench-time+ type: exitcode-stdio-1.0+ main-is: Time.hs+ other-modules:+ hs-source-dirs:+ bench+ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ build-depends:+ heidi+ , base+ , criterion+ default-language: Haskell2010+++executable app+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+ build-depends:+ heidi+ , base+ , exceptions+ , hashable+ , text+ , unordered-containers+ default-language: Haskell2010
+ src/Core/Data/Frame.hs view
@@ -0,0 +1,234 @@+{-# language OverloadedStrings #-}+{-# language FlexibleInstances #-}+{-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, GeneralizedNewtypeDeriving #-}+{-# language ConstraintKinds #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+-- {-# OPTIONS_HADDOCK show-extensions #-}+-----------------------------------------------------------------------------+-- |+-- Module : Core.Data.Frame+-- Description : A sparse dataframe+-- Copyright : (c) Marco Zocca (2018-2019)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- A general-purpose, row-oriented data frame.+--+-- As it is common in the sciences, the dataframe should be taken to contain+-- experimental datapoints as its rows, each being defined by a number of /features/.+--+-----------------------------------------------------------------------------+module Core.Data.Frame (+ -- * Frame+ Frame,+ -- ** Construction+ fromNEList, fromList,+ -- ** Access+ head, take, drop, zipWith, numRows, + -- ** Filtering + filter, + -- *** 'D.Decode'-based filtering+ filterDecode, + -- **+ groupWith, + -- ** Scans (row-wise cumulative operations)+ scanl, scanr,++ -- -- * Row+ -- Row,+ -- -- ** Construction+ -- fromKVs,+ -- -- *** (unsafe)+ -- mkRow, + -- -- ** Update+ -- insert, insertRowFun, insertRowFunM, + -- -- ** Access+ -- toList, keys, elems,+ -- -- *** Decoders+ -- D.Decode, D.mkDecode, D.runDecode, + -- real, scientific, text, oneHot, + -- -- ** Lookup+ -- HMR.lookup, lookupThrowM, lookupDefault, (!:), elemSatisfies, + -- -- ** Set operations+ -- union, unionWith,+ -- -- ** Traversals+ -- traverseWithKey,+ -- -- * One-Hot+ -- OneHot, + -- -- * Key constraint+ -- HMR.Key+ -- ** Vector-related+ toVector, fromVector,+ -- *** Sorting+ ) where++import qualified Control.Monad as CM (filterM)+import Data.Maybe (fromMaybe)+-- import Control.Applicative (Alternative(..))+-- import qualified Data.Foldable as F+-- import Data.Foldable (foldl, foldr, foldlM, foldrM)+import qualified Data.Vector as V+-- import qualified Data.Vector.Generic.Mutable as VGM+-- import qualified Data.Vector.Algorithms.Merge as V (sort, sortBy, Comparison)+-- import qualified Data.Text as T (pack)+-- import Data.Text (Text)+-- import qualified Data.Map as M+-- import qualified Data.HashMap.Strict as HM+import qualified Data.List.NonEmpty as NE++-- import Control.Monad.Catch(Exception(..), MonadThrow(..))+-- import Data.Scientific (Scientific, toRealFloat)+-- import Data.Typeable (Typeable)++import qualified Data.Generics.Decode as D (Decode, runDecode)+-- import Data.Generics.Decode ((>>>))+-- import qualified Data.GenericTrie as GT+-- import Data.Generics.Encode.Internal (VP, getIntM, getFloatM, getDoubleM, getScientificM, getStringM, getTextM, getOneHotM)+-- import Data.Generics.Encode.OneHot (OneHot)+++import Prelude hiding (filter, zipWith, lookup, foldl, foldr, scanl, scanr, head, take, drop)++-- $setup+-- >>> import qualified Heidi.Data.Row.HashMap as HMR+-- >>> let row0 = HMR.fromList [(0, 'a'), (3, 'b')] :: HMR.Row Int Char+-- >>> let row1 = HMR.fromList [(0, 'x'), (1, 'b'), (666, 'z')] :: HMR.Row Int Char+-- >>> let book1 = HMR.fromList [("item", "book"), ("id.0", "129"), ("qty", "1")]+-- >>> let book2 = HMR.fromList [("item", "book"), ("id.0", "129"), ("qty", "5")]+-- >>> let ball = HMR.fromList [("item", "ball"), ("id.0", "234"), ("qty", "1")]+-- >>> let bike = HMR.fromList [("item", "bike"), ("id.0", "410"), ("qty", "1")]+-- >>> let t0 = fromList [ book1, ball, bike, book2 ] :: Frame (HMR.Row String String)+-- >>> let r1 = HMR.fromList [("id.1", "129"), ("price", "100")]+-- >>> let r2 = HMR.fromList [("id.1", "234"), ("price", "50")]+-- >>> let r3 = HMR.fromList [("id.1", "3"), ("price", "150")]+-- >>> let r4 = HMR.fromList [("id.1", "99"), ("price", "30")]+-- >>> let t1 = fromList [ r1, r2, r3, r4 ] :: Frame (HMR.Row String String)++++-- [NOTE : table Alternative instance] +-- +-- https://github.com/Gabriel439/Haskell-Bears-Library/blob/master/src/Bears.hs+--+-- 'Table' has Applicative and Alternative instances+-- -- * for Alternative, we need the possibility of an empty table (to implement `empty`). Currently this is impossible due to the 'NonEmpty' list implementation.++-- [NOTE : column universe and table pretty printing]+--+-- Currently this 'Table' implementation doesn't know anything of its row type, including the type of its keys and values.+-- To pretty-print our tables, we'd like instead to know the "universe of columns", i.e. all possible columns used in every row (or at least in the first N rows)+++-- | A 'Frame' is a non-empty list of rows.+newtype Frame row = Frame {+ -- nFrameRows :: Maybe Int -- ^ Nothing means unknown+ tableRows :: NE.NonEmpty row } deriving (Show, Functor, Foldable, Traversable)++-- | Take the first row of a 'Frame'+--+-- >>> head (fromList [row0, row1]) == row0+-- True+head :: Frame row -> row+head = NE.head . tableRows++-- | Take the first @n@ rows of a Frame+take :: Int -> Frame r -> [r]+take n = NE.take n . tableRows++-- | Drop the first @n@ rows of a Frame+drop :: Int -> Frame r -> [r]+drop n = NE.drop n . tableRows++-- | Construct a table given a non-empty list of rows+--+-- >>> (head <$> fromNEList [row0, row1]) == Just row0+-- True+-- >>> fromNEList []+-- Nothing+fromNEList :: [row] -> Maybe (Frame row)+fromNEList l = Frame <$> NE.nonEmpty l++-- | Construct a table given a list of rows. Crashes if the input list is empty+fromList :: [row] -> Frame row+fromList = Frame . NE.fromList++toList :: Frame a -> [a]+toList = NE.toList . tableRows++-- | Zip two frames with a row combining function+zipWith :: (a -> b -> row)+ -> Frame a -> Frame b -> Frame row+zipWith f tt1 tt2 = Frame $ NE.zipWith f (tableRows tt1) (tableRows tt2)++++-- | Filters a 'Frame' according to a predicate. Returns Nothing only if the resulting table is empty (i.e. if no rows satisfy the predicate).+--+filter :: (row -> Bool) -> Frame row -> Maybe (Frame row)+filter ff = fromNEList . NE.filter ff . tableRows++-- | This generalizes the list-based 'filter' function.+filterA :: Applicative f =>+ (row -> f Bool) -> Frame row -> f (Maybe (Frame row))+filterA fm t = fromNEList <$> CM.filterM fm (toList t)++++-- | Filter a 'Frame' by decoding row values.+--+-- This is an intermediate function that doesn't require fixing the row type within the 'Frame'.+--+-- NB: a 'D.Decode' returning 'Bool' can be declared via its Functor, Applicative and Alternative instances.+filterDecode :: Applicative f =>+ D.Decode f row Bool -- ^ Row decoder+ -> Frame row+ -> f (Maybe (Frame row))+filterDecode dec = filterA (D.runDecode dec)+++-- filterInt2 k1 k2 =+-- filterDecode ((>=) <$> HMR.scientific k1 <*> HMR.scientific k2)++++-- | Left-associative scan+scanl :: (b -> a -> b) -> b -> Frame a -> Frame b+scanl f z tt = Frame $ NE.scanl f z (tableRows tt)++-- | Right-associative scan+scanr :: (a -> b -> b) -> b -> Frame a -> Frame b+scanr f z tt = Frame $ NE.scanr f z (tableRows tt)++-- | 'groupWith' takes row comparison function and a list and returns a list of lists such that the concatenation of the result is equal to the argument. Moreover, each sublist in the result contains only elements that satisfy the comparison. +groupWith :: (row -> row -> Bool) -> Frame row -> [Frame row]+groupWith f t = Frame <$> NE.groupBy f (tableRows t)++-- | 'groupWithM' uses a comparison function that Maybe returns a Bool. This is useful when used in conjuction with lookup-based logic.+groupWithM :: (row -> row -> Maybe Bool) -> Frame row -> [Frame row]+groupWithM fm = groupWith f' where+ f' r1 r2 = fromMaybe False (fm r1 r2)++-- | /O(n)/ Count the number of rows in the table+--+-- >>> numRows t0+-- 4+numRows :: Frame row -> Int +numRows = length++++-- | Produce a 'Vector' of rows+toVector :: Frame row -> V.Vector row+toVector = V.fromList . NE.toList . tableRows++-- | Produce a Frame from a 'Vector' of rows+fromVector :: V.Vector row -> Maybe (Frame row)+fromVector = fromNEList . V.toList+++++
+ src/Core/Data/Frame/Generic.hs view
@@ -0,0 +1,122 @@+{-# language DeriveGeneric #-}+{-# language LambdaCase #-}++-- {-# OPTIONS_GHC -Wall #-}+{-# options_ghc -Wno-unused-imports #-}+-----------------------------------------------------------------------------+-- |+-- Module : Core.Data.Frame.Generic+-- Description : Populate dataframes with generically-encoded data+-- Copyright : (c) Marco Zocca (2019)+-- License : MIT+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Generic encoding of algebraic datatypes, using 'generics-sop'+--+-----------------------------------------------------------------------------+module Core.Data.Frame.Generic (+ -- * GenericTrie-based rows+ gToRowGT, encode,+ -- -- * Exceptions+ -- DataException(..)+ ) where++import qualified Data.Foldable as F (toList)+import Data.Typeable (Typeable)+import Control.Exception (Exception(..))+import GHC.Generics (Generic(..))+-- exceptions+import Control.Monad.Catch (MonadThrow(..))+-- microlens+import Lens.Micro (toListOf)++import qualified Core.Data.Frame.List as FL (Frame, frameFromList)+import qualified Heidi.Data.Row.GenericTrie as GTR (Row, mkRow)+import Data.Generics.Encode.Internal (gflattenHM, gflattenGT, Heidi, TC(..), VP)+++-- $setup+-- >>> :set -XDeriveGeneric+-- >>> import qualified GHC.Generics as G+-- >>> import qualified Data.Generics.Encode.Internal as GE+-- >>> data P1 = P1 Int Char deriving (Eq, Show, G.Generic)+-- >>> instance GE.Heidi P1+-- >>> data P2 = P2 { p2i :: Int, p2c :: Char } deriving (Eq, Show, G.Generic)+-- >>> instance GE.Heidi P2+-- >>> data Q = Q (Maybe Int) (Either Double Char) deriving (Eq, Show, G.Generic)+-- >>> instance GE.Heidi Q+++-- | Populate a 'Frame' with the generic encoding of the row data+--+-- For example, a list of records having two fields each will produce a dataframe with two columns, having the record field names as column labels.+--+-- @+-- data P1 = P1 Int Char deriving (Eq, Show, 'G.Generic')+-- instance 'Heidi' P1+--+-- data P2 = P2 { p2i :: Int, p2c :: Char } deriving (Eq, Show, Generic)+-- instance Heidi P2+--+-- data Q = Q (Maybe Int) (Either Double Char) deriving (Eq, Show, Generic)+-- instance Heidi Q+-- @+--+-- >>> encode [P1 42 'z']+-- Frame {tableRows = [([TC "P1" "_0"],VPInt 42),([TC "P1" "_1"],VPChar 'z')] :| []}+--+-- >>> encode [P2 42 'z']+-- Frame {tableRows = [([TC "P2" "p2c"],VPChar 'z'),([TC "P2" "p2i"],VPInt 42)] :| []}+--+-- Test using 'Maybe' and 'Either' record fields :+--+-- >>> encode [Q (Just 42) (Left 1.2), Q Nothing (Right 'b')]+-- Frame {tableRows = [([TC "Q" "_0",TC "Maybe" "Just"],VPInt 42),([TC "Q" "_1",TC "Either" "Left"],VPDouble 1.2)] :| [[([TC "Q" "_1",TC "Either" "Right"],VPChar 'b')]]}+--+-- NB: as the last example above demonstrates, 'Nothing' values are not inserted in the rows, which can be used to encode missing data features.+encode :: (Foldable t, Heidi a) =>+ t a+ -> FL.Frame (GTR.Row [TC] VP)+encode ds = gToFrameWith gToRowGT ds++-- | Populate a 'Row' with a generic encoding of the input value (generic-trie backend)+gToRowGT :: Heidi a => a -> GTR.Row [TC] VP+gToRowGT = GTR.mkRow . gflattenGT++gToFrameWith :: Foldable t => (a -> row) -> t a -> FL.Frame row+gToFrameWith f = FL.frameFromList . map f . F.toList++-- -- | Exceptions related to the input data+-- data DataException =+-- NoDataE -- ^ Dataset has 0 rows+-- deriving (Eq, Typeable)+-- instance Show DataException where+-- show = \case+-- NoDataE -> "The dataset has 0 rows"+-- instance Exception DataException+++++++-- example data++{-+λ> gToRowGT $ B (A 42 'z') "moo"+[+ ([TC "B" "b1" ,TC "A" "a1" ], 42)+,([TC "B" "b1" ,TC "A" "a2"], z)+,([TC "B" "b2"], moo)+]+-}++++data A = A { a1 :: Int, a2 :: Char } deriving (Eq, Show, Generic)+instance Heidi A++data B = B { b1 :: A, b2 :: String } deriving (Eq, Show, Generic)+instance Heidi B
+ src/Core/Data/Frame/List.hs view
@@ -0,0 +1,110 @@+{-# language OverloadedStrings #-}+{-# language FlexibleInstances #-}+{-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, GeneralizedNewtypeDeriving #-}+{-# language ConstraintKinds #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+-----------------------------------------------------------------------------+-- |+-- Module : Core.Data.Frame.List+-- Description : List-based dataframe+-- Copyright : (c) Marco Zocca (2018-2019)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- A general-purpose, row-oriented data frame, encoded as a list of rows+--+-----------------------------------------------------------------------------+module Core.Data.Frame.List (+ -- * Frame+ Frame,+ -- ** Construction+ frameFromList,+ -- ** Access+ Core.Data.Frame.List.head,+ Core.Data.Frame.List.take,+ Core.Data.Frame.List.drop, Core.Data.Frame.List.zipWith, numRows, + -- ** Filtering + Core.Data.Frame.List.filter, + -- *** 'D.Decode'-based filtering helpers+ filterA, + -- **+ groupWith, + -- ** Scans (row-wise cumulative operations)+ Core.Data.Frame.List.scanl, Core.Data.Frame.List.scanr,+ -- ** Vector-related+ toVector, fromVector,+ -- *** Sorting+ ) where++import qualified Control.Monad as CM (filterM)+import Data.List (groupBy)++import qualified Data.Vector as V+++-- | A 'Frame' is a list of rows.+newtype Frame row = Frame {+ tableRows :: [row] } deriving (Show, Functor, Foldable, Traversable)++head :: Frame row -> row+head = Prelude.head . tableRows++-- | Retain n rows+take :: Int -> Frame row -> Frame row+take n = Frame . Prelude.take n . tableRows++-- | Drop n rows+drop :: Int -> Frame row -> Frame row+drop n = Frame . Prelude.drop n . tableRows++zipWith :: (a -> b -> c) -> Frame a -> Frame b -> Frame c+zipWith f x y = frameFromList $ Prelude.zipWith f (tableRows x) (tableRows y)++frameFromList :: [row] -> Frame row+frameFromList = Frame++toList :: Frame row -> [row]+toList = tableRows++numRows :: Frame row -> Int+numRows = length . tableRows++filter :: (row -> Bool) -> Frame row -> Frame row+filter p = Frame . Prelude.filter p . tableRows+++-- | This generalizes the list-based 'filter' function.+filterA :: Applicative f =>+ (row -> f Bool) -> Frame row -> f (Frame row)+filterA fm t = frameFromList <$> CM.filterM fm (toList t)+++++++-- | Left-associative scan+scanl :: (b -> a -> b) -> b -> Frame a -> Frame b+scanl f z tt = Frame $ Prelude.scanl f z (tableRows tt)++-- | Right-associative scan+scanr :: (a -> b -> b) -> b -> Frame a -> Frame b+scanr f z tt = Frame $ Prelude.scanr f z (tableRows tt)++-- | 'groupWith' takes row comparison function and a list and returns a list of lists such that the concatenation of the result is equal to the argument. Moreover, each sublist in the result contains only elements that satisfy the comparison. +groupWith :: (row -> row -> Bool) -> Frame row -> [Frame row]+groupWith f t = Frame <$> groupBy f (tableRows t)+++++-- | Produce a 'Vector' of rows+toVector :: Frame row -> V.Vector row+toVector = V.fromList . tableRows++-- | Produce a Frame from a 'Vector' of rows+fromVector :: V.Vector row -> Frame row+fromVector = frameFromList . V.toList
+ src/Core/Data/Frame/PrettyPrint.hs view
@@ -0,0 +1,175 @@+{-# language DeriveFunctor #-}+{-# language DeriveFoldable #-}+{-# language DeriveGeneric #-}+{-# language DeriveTraversable #-}+{-# language LambdaCase #-}+{-# options_ghc -Wno-unused-imports #-}+module Core.Data.Frame.PrettyPrint where++import GHC.Generics (Generic(..))+import qualified Data.Foldable as F (foldl', foldlM)+-- import Data.+import Data.Function (on)+import Data.List (filter, sortBy, groupBy)++-- boxes+import Text.PrettyPrint.Boxes (Box, Alignment, emptyBox, nullBox, vcat, hcat, vsep, hsep, text, para, punctuateH, render, printBox, (<>), (<+>), (//), (/+/), top, left, right)++-- import qualified Data.Text as T+import qualified Data.Map as M+import qualified Data.GenericTrie as GT++import qualified Core.Data.Frame as CDF+import qualified Core.Data.Frame.Generic as CDF (encode, gToRowGT)+import qualified Heidi.Data.Row.GenericTrie as GTR++import Prelude hiding ((<>))++{-++what's the best data structure for representing this kind of table display?++a trie with strings as keys and lists as values ?+++-------------+-----------------++| Person | House |++-------+-----+-------+---------++| Name | Age | Color | Price |++-------+-----+-------+---------++| David | 63 | Green | $170000 |+| Ava | 34 | Blue | $115000 |+| Sonic | 12 | Green | $150000 |++-------+-----+-------+---------+++(table example from colonnade : https://hackage.haskell.org/package/colonnade-1.2.0.2/docs/src/Colonnade.html#cap )++-}+++{-++fold over a list of tries to update a PTree++[Trie [k] v] -> PTree v++foldl :: Foldable t => (b -> row -> b) -> b -> t row -> b++foldWithKey :: GT.TrieKey k => (k -> a -> r -> r) -> r -> Row k a -> r++-}++arr0, arr1 :: [Box]+arr0 = [text "moo", text "123123123"]+arr1 = [text "asdfasdfasdfasdf", text "z"]++-- justification is computed per-column by Box+box1 :: Alignment -> Box+box1 aln = hsep 2 top [c0, c1]+ where+ c0 = vsep 1 aln arr0+ c1 = vsep 1 aln arr1+++-- +-------------+-----------------++-- | Person | House |+-- +-------+-----+-------+---------++-- | Name | Age | Color | Price |++box2 :: Box+box2 = l <+> r+ where+ l = text "Person" // (text "Name" <+> text "Age")+ r = text "House" // (text "Color" <+> text "Price")++++++++++data M k v = Ml v+ | Mb (M.Map k (M k v)) deriving (Functor, Foldable)+instance (Show k, Show v) => Show (M k v) where+ show = \case+ Ml x -> show x+ Mb m -> show $ M.toList m++empty :: M k v+empty = Mb M.empty++-- | Copy the contents of a list-indexed Row into a tree-shaped structure (for pretty-printing)+--+-- >>> unfold [("aa", 41), ("ab", 42)]+-- [('a',[('a',[('a',41)]),('b',42)])] -- FIXME why 3 levels and not 2 ?!?+unfold :: (Foldable t, Ord k) =>+ t ([k], v) -- each GTR.Row is isomorphic to this parameter+ -> M k v+unfold kvs = foldl insf empty kvs+ where+ insf (Mb acc) (ks, v) = insert acc ks v+ insf _ _ = undefined -- FIXME++-- | Copy a single list-indexed value into a tree+--+-- >>> insert M.empty "abc" 42+-- [('a',[('b',[('c',42)])])]+insert :: Ord k => M.Map k (M k v) -> [k] -> v -> M k v+insert = go+ where+ go _ [] v = Ml v+ go m (k:ks) v = Mb $ M.insert k (go m ks v) m+++-- data Tree a = Node {+-- rootLabel :: a, -- ^ label value+-- subForest :: [Tree a] -- ^ zero or more child trees++-- unfoldTree :: (b -> (a, [b])) -> b -> Tree a+-- unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs)+-- +-- unfoldForest :: (b -> (a, [b])) -> [b] -> Forest a+-- unfoldForest f = map (unfoldTree f)+++-- boxM (Ml s) = text s+-- boxM (Mb mm) = foldl ins nullBox mm+-- where+-- ins acc x = acc <+> boxM x++++-- >>> groupSort ["aa", "ab", "cab", "xa", "cx"]+-- [["aa","ab"],["cab","cx"],["xa"]]+groupSort :: Ord a => [[a]] -> [[[a]]]+groupSort = groupSortBy head++groupSortBy :: Ord a1 => (a2 -> a1) -> [a2] -> [[a2]]+groupSortBy f = groupBy ((==) `on` f) . sortBy (compare `on` f)++-- render a column of a frame+columnBox :: (Foldable t, Show a, GT.TrieKey k) =>+ t (GTR.Row k a) -- ^ dataframe+ -> k -- ^ column key+ -> Box+columnBox rows k = foldl ins nullBox rows+ where+ ins acc row = acc // maybe (emptyBox 1 0) (text . show) (GTR.lookup k row)+++++++-- | union of the set of keys across all rows+allKeys :: (GT.TrieKey k, Foldable f) => f (GTR.Row k v) -> [k]+allKeys = GTR.keys . GTR.keysOnly+++++-- data Sized a = Sized !Int a++-- annotateWithDepth :: (GT.TrieKey k) => GTR.Row [k] a -> GTR.Row [k] (Sized a)+-- annotateWithDepth = GTR.mapWithKey (\k v -> Sized (length k) v)
+ src/Core/Data/Row/Internal.hs view
@@ -0,0 +1,28 @@+{-# language DeriveFunctor, GeneralizedNewtypeDeriving, DeriveTraversable, DeriveDataTypeable #-}+-- {-# language ConstraintKinds #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+-----------------------------------------------------------------------------+-- |+-- Module : Core.Data.Row.Internal+-- Description : Core.Data.Row internal bits and pieces+-- Copyright : (c) Marco Zocca (2018-2019)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------+module Core.Data.Row.Internal where++import Data.Typeable (Typeable)+-- import Data.Hashable (Hashable(..))+import Control.Monad.Catch(Exception(..))+++-- | Key exceptions +data KeyError k =+ MissingKeyError k+ | AlreadyPresentKeyError k+ deriving (Show, Eq, Typeable)+instance (Show k, Typeable k) => Exception (KeyError k)
+ src/Data/Generics/Codec.hs view
@@ -0,0 +1,133 @@+{-# options_ghc -Wno-unused-imports #-}+{-# options_ghc -Wno-unused-top-binds #-}+{-# options_ghc -Wno-type-defaults #-}+module Data.Generics.Codec (+ realM, scientificM, textM, stringM, oneHotM, int, int8, int16, int32, int64, word, word8, word16, word32, word64, + -- * TC (Type and Constructor annotation)+ TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon+ -- * Exceptions+ , TypeError(..)) where++import Control.Applicative (Alternative(..))++import Control.Monad.Catch (MonadThrow(..))++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)++-- scientific+import Data.Scientific (Scientific, toRealFloat, fromFloatDigits)+-- text+import qualified Data.Text as T+++import Data.Generics.Encode.Internal (VP(..), getIntM, getInt8M, getInt16M, getInt32M, getInt64M, getWordM, getWord8M, getWord16M, getWord32M, getWord64M, getBoolM, getFloatM, getDoubleM, getScientificM, getCharM, getStringM, getTextM, getOneHotM, TypeError(..), TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon)+import Data.Generics.Decode (Decode, mkDecode)+import Data.Generics.Encode.OneHot (OneHot)+++++++-- decInt :: D.Decode Maybe VP Int+-- decInt = D.mkDecode getInt+-- -- decInteger = D.mkDecode getInteger+-- decDouble :: D.Decode Maybe VP Double+-- decDouble = D.mkDecode getDouble+-- -- decChar = D.mkDecode getChar+-- -- decText = D.mkDecode getText++-- | Decode any real numerical value (integer, double, float or 'Scientific') into a Double+realM :: (Alternative m, MonadThrow m) => Decode m VP Double+realM =+ (fromIntegral <$> int) <|>+ double <|>+ (realToFrac <$> float) <|>+ (toRealFloat <$> scientific) ++-- | Decode any real numerical value (integer, double, float or 'Scientific') into a Scientific+scientificM :: (Alternative m, MonadThrow m) => Decode m VP Scientific+scientificM =+ scientific <|>+ (fromFloatDigits . fromIntegral <$> int) <|>+ (fromFloatDigits <$> double) <|>+ (fromFloatDigits <$> float)++-- | Decode a string ('String' or 'Text') into a Text+textM :: (Alternative m, MonadThrow m) => Decode m VP T.Text+textM =+ (T.pack <$> string) <|>+ text++-- | Decode a string ('String' or 'Text') into a String+stringM :: (Alternative m, MonadThrow m) => Decode m VP String+stringM =+ string <|>+ (T.unpack <$> text)++++++-- | Decode a one-hot value+oneHotM :: MonadThrow m => Decode m VP (OneHot Int)+oneHotM = mkDecode getOneHotM++++++int :: MonadThrow m => Decode m VP Int+int = mkDecode getIntM++int8 :: MonadThrow m => Decode m VP Int8+int8 = mkDecode getInt8M++int16 :: MonadThrow m => Decode m VP Int16+int16 = mkDecode getInt16M++int32 :: MonadThrow m => Decode m VP Int32+int32 = mkDecode getInt32M++int64 :: MonadThrow m => Decode m VP Int64+int64 = mkDecode getInt64M++word :: MonadThrow m => Decode m VP Word+word = mkDecode getWordM++word8 :: MonadThrow m => Decode m VP Word8+word8 = mkDecode getWord8M++word16 :: MonadThrow m => Decode m VP Word16+word16 = mkDecode getWord16M++word32 :: MonadThrow m => Decode m VP Word32+word32 = mkDecode getWord32M++word64 :: MonadThrow m => Decode m VP Word64+word64 = mkDecode getWord64M++bool :: MonadThrow m => Decode m VP Bool+bool = mkDecode getBoolM++float :: MonadThrow m => Decode m VP Float+float = mkDecode getFloatM++double :: MonadThrow m => Decode m VP Double+double = mkDecode getDoubleM++scientific :: MonadThrow m => Decode m VP Scientific+scientific = mkDecode getScientificM++char :: MonadThrow m => Decode m VP Char+char = mkDecode getCharM++string :: MonadThrow m => Decode m VP String+string = mkDecode getStringM++text :: MonadThrow m => Decode m VP T.Text+text = mkDecode getTextM+++
+ src/Data/Generics/Decode.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE+ DeriveFunctor,+ GeneralizedNewtypeDeriving+#-}+{-# OPTIONS_GHC -Wall #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Generics.Decode+-- Description : Composable decoding of terms+-- Copyright : (c) Marco Zocca (2019)+-- License : MIT+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Composable decoding of terms+-----------------------------------------------------------------------------+module Data.Generics.Decode (Decode, mkDecode, runDecode, (>>>)) where++import Control.Applicative (Alternative(..))+import Control.Category (Category(..)) +-- import Data.Foldable (Foldable(..), asum)+import Control.Monad ((>=>))+-- import Data.Maybe (fromMaybe)+-- import Control.Monad.Log (MonadLog(..), Handler, WithSeverity(..), Severity, logDebug, logInfo, logWarning, logError, runLoggingT, PureLoggingT(..), runPureLoggingT)+-- import Control.Monad.Trans.State.Strict (StateT(..), runStateT)++import Prelude hiding ((.))+++-- | We can decouple lookup and value conversion and have distinct error behaviour.+-- Multiple value decoding functions can be combined via the Applicative and Alternative instance.+--+-- Note : 'Decode' is called Kleisli in base.Control.Arrow; among other things it has a Profunctor instance.++newtype Decode m i o = Decode { runDecode_ :: i -> m o } deriving (Functor)++-- | Run a decoding function+runDecode :: Decode m i o -> i -> m o+runDecode = runDecode_++-- | Construct a 'Decode' from a monadic arrow.+mkDecode :: (i -> m o) -> Decode m i o+mkDecode = Decode++instance Applicative m => Applicative (Decode m i) where+ pure x = Decode $ \ _ -> pure x+ Decode af <*> Decode aa = Decode $ \ v -> af v <*> aa v++instance Alternative m => Alternative (Decode m i) where+ empty = Decode $ const empty+ Decode p <|> Decode q = Decode $ \v -> p v <|> q v++-- | This instance is copied from @Kleisli@ (defined in Control.Arrow)+instance Monad m => Category (Decode m) where+ id = Decode return+ (Decode f) . (Decode g) = Decode (g >=> f)++-- | Left-to-right composition+--+-- @(>>>) :: Monad m => Decode m a b -> Decode m b c -> Decode m a c@+(>>>) :: Category cat => cat a b -> cat b c -> cat a c+(>>>) = flip (.)+{-# inline (>>>) #-}+++++-- data Spork m a b = Spork (a -> m b) (b -> m a) deriving (Functor)+++++-- | [NOTE Key lookup + value conversion, behaviour of row functions ]+--+-- If the key is not found /or/ the conversion fails, use a default; the first exception thrown by the lookup-and-convert function will be rethrown.+-- We'd like instead to try many different decoders, and only throw if /all/ have failed+-- +-- How should Alternative behave for lookup-and-convert that both might fail?+-- +-- value decoding : try all decoders, return first successful (== Alternative)+-- decoding missing values : should be configurable+-- -- * use default value+-- -- * skip rows that have any missing value+-- +-- row function: decoding behaviour should be defined for all function arguments+--+-- example : +--+-- λ> bool (2 :: Int) (VBool False) <|> bool (2 :: Int) (VBool True)+-- False+-- λ> bool (2 :: Int) (VDouble 32) <|> bool (2 :: Int) (VBool True)+-- *** Exception: ValueTypeError 2 VTypeBool (VDouble 32.0)+--+-- λ> Nothing <|> pure 32.0+-- Just 32.0+-- λ> (bool (2 :: Int) (VDouble 32) <|> bool (2 :: Int) (VBool True)) :: Maybe Bool+-- Just True+--+-- ^ throwM in IO : strict (the first failing decoder throws an exception), Maybe : lazy (keeps trying decoders and returns the first successful one)
+ src/Data/Generics/Encode/Internal.hs view
@@ -0,0 +1,454 @@+{-# language+ DeriveGeneric+ , DeriveDataTypeable+ , FlexibleContexts+ , GADTs+ , OverloadedStrings+ , DefaultSignatures+ , ScopedTypeVariables+ , FlexibleInstances+ , LambdaCase+ , TemplateHaskell+#-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+-- {-# OPTIONS_GHC -Wno-unused-top-binds #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Generics.Encode.Internal+-- Description : Generic encoding of algebraic datatypes+-- Copyright : (c) Marco Zocca (2019)+-- License : MIT+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Generic encoding of algebraic datatypes, using @generics-sop@+--+-- Examples, inspiration and code borrowed from :+-- +-- * @basic-sop@ - generic show function : https://hackage.haskell.org/package/basic-sop-0.2.0.2/docs/src/Generics-SOP-Show.html#gshow+-- +-- * @tree-diff@ - single-typed ADT reconstruction : http://hackage.haskell.org/package/tree-diff-0.0.2/docs/src/Data.TreeDiff.Class.html#sopToExpr+-----------------------------------------------------------------------------+module Data.Generics.Encode.Internal (gflattenHM, gflattenGT,+ -- * VP (Primitive types)+ VP(..),+ -- ** Lenses+ vpInt, vpDouble, vpFloat, vpString, vpText, vpBool, vpScientific, vpChar, vpOneHot,+ -- ** 'MonadThrow' getters+ getIntM, getInt8M, getInt16M, getInt32M, getInt64M, getWordM, getWord8M, getWord16M, getWord32M, getWord64M, getBoolM, getFloatM, getDoubleM, getScientificM, getCharM, getStringM, getTextM, getOneHotM, TypeError(..),+ -- * TC (Type and Constructor annotation)+ TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon, + -- * Heidi (generic ADT encoding)+ Heidi) where++import qualified GHC.Generics as G+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Typeable (Typeable)++-- exceptions+import Control.Monad.Catch(Exception(..), MonadThrow(..))+-- generics-sop+import Generics.SOP (All, DatatypeName, datatypeName, DatatypeInfo, FieldInfo(..), FieldName, ConstructorInfo(..), constructorInfo, All, All2, hcliftA2, hcmap, Proxy(..), SOP(..), NP(..), I(..), K(..), mapIK, hcollapse)+-- import Generics.SOP.NP (cpure_NP)+-- import Generics.SOP.Constraint (SListIN)+import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)+-- generic-trie+import qualified Data.GenericTrie as GT+-- hashable+import Data.Hashable (Hashable(..))+-- microlens-th+import Lens.Micro.TH (makeLenses)+-- scientific+import Data.Scientific (Scientific)+-- text+import Data.Text (Text, unpack)++-- import Data.Time (Day, LocalTime, TimeOfDay)+-- import qualified Data.Vector as V+-- import qualified Data.Map as M+import qualified Data.HashMap.Strict as HM+-- import qualified Data.GenericTrie as GT++import Data.Generics.Encode.OneHot (OneHot, mkOH)+-- import Data.List (unfoldr)+-- import qualified Data.Foldable as F+-- import qualified Data.Sequence as S (Seq(..), empty)+-- import Data.Sequence ((<|), (|>))++import Prelude hiding (getChar)++-- $setup+-- >>> :set -XDeriveGeneric+-- >>> import qualified GHC.Generics as G++-- | Primitive types+--+-- NB : this is just a convenience for unityping the dataframe contents, but it should not be exposed to the library users +data VP =+ VPInt { _vpInt :: Int } -- ^ 'Int'+ | VPInt8 Int8 -- ^ 'Int8'+ | VPInt16 Int16 -- ^ 'Int16'+ | VPInt32 Int32 -- ^ 'Int32'+ | VPInt64 Int64 -- ^ 'Int64'+ | VPWord Word -- ^ 'Word'+ | VPWord8 Word8 -- ^ 'Word8'+ | VPWord16 Word16 -- ^ 'Word16'+ | VPWord32 Word32 -- ^ 'Word32'+ | VPWord64 Word64 -- ^ 'Word64'+ | VPBool { _vpBool :: Bool } -- ^ 'Bool'+ | VPFloat { _vpFloat :: Float } -- ^ 'Float'+ | VPDouble { _vpDouble :: Double } -- ^ 'Double'+ | VPScientific { _vpScientific :: Scientific } -- ^ 'Scientific'+ | VPChar { _vpChar :: Char } -- ^ 'Char'+ | VPString { _vpString :: String } -- ^ 'String'+ | VPText { _vpText :: Text } -- ^ 'Text'+ | VPOH { _vpOneHot :: OneHot Int } -- ^ 1-hot encoding of an enum value+ deriving (Eq, Ord, G.Generic)+instance Hashable VP+makeLenses ''VP++instance Show VP where+ show = \case+ VPInt x -> show x+ VPInt8 x -> show x+ VPInt16 x -> show x+ VPInt32 x -> show x+ VPInt64 x -> show x+ VPWord x -> show x+ VPWord8 x -> show x+ VPWord16 x -> show x+ VPWord32 x -> show x+ VPWord64 x -> show x+ VPBool b -> show b+ VPFloat f -> show f+ VPDouble d -> show d+ VPScientific s -> show s+ VPChar d -> pure d+ VPString s -> s+ VPText t -> unpack t+ VPOH oh -> show oh+++-- | Flatten a value into a 1-layer hashmap, via the value's generic encoding+gflattenHM :: Heidi a => a -> HM.HashMap [TC] VP+gflattenHM = flattenHM . toVal++-- | Flatten a value into a 'GT.Trie', via the value's generic encoding+gflattenGT :: Heidi a => a -> GT.Trie [TC] VP+gflattenGT = flattenGT . toVal+++-- -- | Commands for manipulating lists of TC's+-- data TCAlg = TCAnyTyCon String -- ^ Matches any type constructor name+-- | TCFirstTyCon String -- ^ " first type constructor name+-- | TCAnyTyN String -- ^ " any type name+-- | TCFirstTyN String -- ^ first type name+++-- | A (type, constructor) name pair+data TC = TC String String deriving (Eq, Show, Ord, G.Generic)+instance Hashable TC+instance GT.TrieKey TC++-- | Type name+tcTyN :: TC -> String+tcTyN (TC n _) = n+-- | Type constructor+tcTyCon :: TC -> String+tcTyCon (TC _ c) = c++-- | Create a fake TC with the given string as type constructor+mkTyCon :: String -> TC+mkTyCon x = TC "" x++-- | Create a fake TC with the given string as type name+mkTyN :: String -> TC+mkTyN x = TC x ""++-- | Fold a 'Val' into a 1-layer hashmap indexed by the input value's (type, constructor) metadata+flattenHM :: Val -> HM.HashMap [TC] VP+flattenHM = flatten HM.empty HM.insert++-- | Fold a 'Val' into a 1-layer 'GT.Trie' indexed by the input value's (type, constructor) metadata+flattenGT :: Val -> GT.Trie [TC] VP+flattenGT = flatten GT.empty GT.insert++flatten :: t -> ([TC] -> VP -> t -> t) -> Val -> t+flatten z insf = go ([], z) where+ insRev ks = insf (reverse ks)+ go (ks, hmacc) = \case+ VRec ty hm -> HM.foldlWithKey' (\hm' k t -> go (TC ty k : ks, hm') t) hmacc hm+ VEnum ty cn oh -> insRev (TC ty cn : ks) (VPOH oh) hmacc+ VPrim vp -> insRev ks vp hmacc++++-- flatten' z insf = go ([], z) where+-- insRev ks = insf (reverse ks)+-- go (ks, hmacc) = \case+-- VRec ty hm -> HM.foldlWithKey' (\hm' k t -> go (TC ty k : ks, hm') t) hmacc hm+-- -- VEnum ty cn oh -> insRev (TC ty cn : ks) (VPOH oh) hmacc+-- -- VPrim vp -> insRev ks vp hmacc+++++++++-- | Internal representation of encoded ADTs values+--+-- The first String parameter contains the type name at the given level, the second contains the type constructor name+data Val =+ VRec String (HM.HashMap String Val) -- ^ recursion+ | VEnum String String (OneHot Int) -- ^ 1-hot encoding of an enum+ | VPrim VP -- ^ primitive types+ deriving (Eq, Show)+++-- | Typeclass for types which have a generic encoding.+--+-- NOTE: if your type has a 'G.Generic' instance you just need to declare an empty instance of 'Heidi' for it.+--+-- example:+--+-- @+-- data A = A Int Char deriving ('G.Generic')+-- instance 'Heidi' A+-- @+class Heidi a where+ toVal :: a -> Val+ default toVal ::+ (G.Generic a, All2 Heidi (GCode a), GFrom a, GDatatypeInfo a) => a -> Val+ toVal x = sopHeidi (gdatatypeInfo (Proxy :: Proxy a)) (gfrom x) +++sopHeidi :: All2 Heidi xss => DatatypeInfo xss -> SOP I xss -> Val+sopHeidi di sop@(SOP xss) = hcollapse $ hcliftA2+ (Proxy :: Proxy (All Heidi))+ (\ci xs -> K (mkVal ci xs tyName oneHot))+ (constructorInfo di)+ xss+ where+ tyName = datatypeName di+ oneHot = mkOH di sop++mkVal :: All Heidi xs =>+ ConstructorInfo xs -> NP I xs -> DatatypeName -> OneHot Int -> Val+mkVal cinfo xs tyn oh = case cinfo of+ Infix cn _ _ -> VRec cn $ mkAnonProd xs+ Constructor cn+ | null cns -> VEnum tyn cn oh+ | otherwise -> VRec cn $ mkAnonProd xs+ Record _ fi -> VRec tyn $ mkProd fi xs+ where+ cns :: [Val]+ cns = npHeidis xs++mkProd :: All Heidi xs => NP FieldInfo xs -> NP I xs -> HM.HashMap String Val+mkProd fi xs = HM.fromList $ hcollapse $ hcliftA2 (Proxy :: Proxy Heidi) mk fi xs where+ mk :: Heidi v => FieldInfo v -> I v -> K (FieldName, Val) v+ mk (FieldInfo n) (I x) = K (n, toVal x)++mkAnonProd :: All Heidi xs => NP I xs -> HM.HashMap String Val+mkAnonProd xs = HM.fromList $ zip labels cns where+ cns = npHeidis xs++npHeidis :: All Heidi xs => NP I xs -> [Val]+npHeidis xs = hcollapse $ hcmap (Proxy :: Proxy Heidi) (mapIK toVal) xs++-- | >>> take 3 labels+-- ["_0","_1","_2"]+labels :: [String]+labels = map (('_' :) . show) [0 ..]+++-- instance Heidi () where toVal = VPrim VUnit+instance Heidi Bool where toVal = VPrim . VPBool+instance Heidi Int where toVal = VPrim . VPInt+instance Heidi Int8 where toVal = VPrim . VPInt8+instance Heidi Int16 where toVal = VPrim . VPInt16+instance Heidi Int32 where toVal = VPrim . VPInt32+instance Heidi Int64 where toVal = VPrim . VPInt64+instance Heidi Word8 where toVal = VPrim . VPWord8+instance Heidi Word16 where toVal = VPrim . VPWord16+instance Heidi Word32 where toVal = VPrim . VPWord32+instance Heidi Word64 where toVal = VPrim . VPWord64+instance Heidi Float where toVal = VPrim . VPFloat+instance Heidi Double where toVal = VPrim . VPDouble+instance Heidi Scientific where toVal = VPrim . VPScientific+instance Heidi Char where toVal = VPrim . VPChar+instance Heidi String where toVal = VPrim . VPString+instance Heidi Text where toVal = VPrim . VPText++instance Heidi a => Heidi (Maybe a) where+ toVal = \case+ Nothing -> VRec "Maybe" HM.empty+ Just x -> VRec "Maybe" $ HM.singleton "Just" $ toVal x+ +instance (Heidi a, Heidi b) => Heidi (Either a b) where+ toVal = \case+ Left l -> VRec "Either" $ HM.singleton "Left" $ toVal l+ Right r -> VRec "Either" $ HM.singleton "Right" $ toVal r++instance (Heidi a, Heidi b) => Heidi (a, b) where+ toVal (x, y) = VRec "(,)" $ HM.fromList $ zip labels [toVal x, toVal y]++instance (Heidi a, Heidi b, Heidi c) => Heidi (a, b, c) where+ toVal (x, y, z) = VRec "(,,)" $ HM.fromList $ zip labels [toVal x, toVal y, toVal z] ++++++-- | Extract an Int+getInt :: VP -> Maybe Int+getInt = \case {VPInt i -> Just i; _ -> Nothing}+-- | Extract an Int8+getInt8 :: VP -> Maybe Int8+getInt8 = \case {VPInt8 i -> Just i; _ -> Nothing}+-- | Extract an Int16+getInt16 :: VP -> Maybe Int16+getInt16 = \case {VPInt16 i -> Just i; _ -> Nothing}+-- | Extract an Int32+getInt32 :: VP -> Maybe Int32+getInt32 = \case {VPInt32 i -> Just i; _ -> Nothing}+-- | Extract an Int64+getInt64 :: VP -> Maybe Int64+getInt64 = \case {VPInt64 i -> Just i; _ -> Nothing}+-- | Extract a Word+getWord :: VP -> Maybe Word+getWord = \case {VPWord i -> Just i; _ -> Nothing}+-- | Extract a Word8+getWord8 :: VP -> Maybe Word8+getWord8 = \case {VPWord8 i -> Just i; _ -> Nothing}+-- | Extract a Word16+getWord16 :: VP -> Maybe Word16+getWord16 = \case {VPWord16 i -> Just i; _ -> Nothing}+-- | Extract a Word32+getWord32 :: VP -> Maybe Word32+getWord32 = \case {VPWord32 i -> Just i; _ -> Nothing}+-- | Extract a Word64+getWord64 :: VP -> Maybe Word64+getWord64 = \case {VPWord64 i -> Just i; _ -> Nothing}+-- | Extract a Bool+getBool :: VP -> Maybe Bool+getBool = \case {VPBool i -> Just i; _ -> Nothing}+-- | Extract a Float+getFloat :: VP -> Maybe Float+getFloat = \case {VPFloat i -> Just i; _ -> Nothing}+-- | Extract a Double+getDouble :: VP -> Maybe Double+getDouble = \case {VPDouble i -> Just i; _ -> Nothing}+-- | Extract a Scientific+getScientific :: VP -> Maybe Scientific+getScientific = \case {VPScientific i -> Just i; _ -> Nothing}+-- | Extract a Char+getChar :: VP -> Maybe Char+getChar = \case {VPChar i -> Just i; _ -> Nothing}+-- | Extract a String+getString :: VP -> Maybe String+getString = \case {VPString i -> Just i; _ -> Nothing}+-- | Extract a Text string+getText :: VP -> Maybe Text+getText = \case {VPText i -> Just i; _ -> Nothing}+-- | Extract a OneHot value+getOneHot :: VP -> Maybe (OneHot Int)+getOneHot = \case {VPOH i -> Just i; _ -> Nothing}++-- | Helper function for decoding into a 'MonadThrow'.+decodeM :: (MonadThrow m, Exception e) =>+ e -> (a -> m b) -> Maybe a -> m b+decodeM e = maybe (throwM e)+++getIntM :: MonadThrow m => VP -> m Int+getIntM x = decodeM IntCastE pure (getInt x)+getInt8M :: MonadThrow m => VP -> m Int8+getInt8M x = decodeM Int8CastE pure (getInt8 x)+getInt16M :: MonadThrow m => VP -> m Int16+getInt16M x = decodeM Int16CastE pure (getInt16 x)+getInt32M :: MonadThrow m => VP -> m Int32+getInt32M x = decodeM Int32CastE pure (getInt32 x)+getInt64M :: MonadThrow m => VP -> m Int64+getInt64M x = decodeM Int64CastE pure (getInt64 x)+getWordM :: MonadThrow m => VP -> m Word+getWordM x = decodeM WordCastE pure (getWord x)+getWord8M :: MonadThrow m => VP -> m Word8+getWord8M x = decodeM Word8CastE pure (getWord8 x)+getWord16M :: MonadThrow m => VP -> m Word16+getWord16M x = decodeM Word16CastE pure (getWord16 x)+getWord32M :: MonadThrow m => VP -> m Word32+getWord32M x = decodeM Word32CastE pure (getWord32 x)+getWord64M :: MonadThrow m => VP -> m Word64+getWord64M x = decodeM Word64CastE pure (getWord64 x)+getBoolM :: MonadThrow m => VP -> m Bool+getBoolM x = decodeM BoolCastE pure (getBool x)+getFloatM :: MonadThrow m => VP -> m Float+getFloatM x = decodeM FloatCastE pure (getFloat x)+getDoubleM :: MonadThrow m => VP -> m Double+getDoubleM x = decodeM DoubleCastE pure (getDouble x)+getScientificM :: MonadThrow m => VP -> m Scientific+getScientificM x = decodeM ScientificCastE pure (getScientific x)+getCharM :: MonadThrow m => VP -> m Char+getCharM x = decodeM CharCastE pure (getChar x)+getStringM :: MonadThrow m => VP -> m String+getStringM x = decodeM StringCastE pure (getString x)+getTextM :: MonadThrow m => VP -> m Text+getTextM x = decodeM TextCastE pure (getText x)+getOneHotM :: MonadThrow m => VP -> m (OneHot Int)+getOneHotM x = decodeM OneHotCastE pure (getOneHot x)++-- | Type errors+data TypeError =+ FloatCastE+ | DoubleCastE+ | ScientificCastE+ | IntCastE+ | Int8CastE+ | Int16CastE+ | Int32CastE+ | Int64CastE+ | WordCastE+ | Word8CastE+ | Word16CastE+ | Word32CastE+ | Word64CastE+ | BoolCastE+ | CharCastE+ | StringCastE+ | TextCastE+ | OneHotCastE+ deriving (Show, Eq, Typeable)+instance Exception TypeError+++++++-- -- examples++-- data A0 = A0 deriving (Eq, Show, G.Generic)+-- instance Heidi A0+-- newtype A = A Int deriving (Eq, Show, G.Generic)+-- instance Heidi A+-- newtype A2 = A2 { a2 :: Int } deriving (Eq, Show, G.Generic)+-- instance Heidi A2+-- data B = B Int Char deriving (Eq, Show, G.Generic)+-- instance Heidi B+-- data B2 = B2 { b21 :: Int, b22 :: Char } deriving (Eq, Show, G.Generic)+-- instance Heidi B2+-- data C = C1 | C2 | C3 deriving (Eq, Show, G.Generic)+-- instance Heidi C+-- data D = D (Maybe Int) (Either Int String) deriving (Eq, Show, G.Generic)+-- instance Heidi D+-- data E = E (Maybe Int) (Maybe Char) deriving (Eq, Show, G.Generic)+-- instance Heidi E+-- newtype F = F (Int, Char) deriving (Eq, Show, G.Generic)+-- instance Heidi F+
+ src/Data/Generics/Encode/OneHot.hs view
@@ -0,0 +1,79 @@+{-# language DeriveGeneric, FlexibleContexts, ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Generics.Encode.OneHot+-- Description : Generic 1-hot encoding of enumeration types +-- Copyright : (c) Marco Zocca (2019)+-- License : MIT+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Generic 1-hot encoding of enumeration types+--+-----------------------------------------------------------------------------+module Data.Generics.Encode.OneHot (OneHot, onehotDim, onehotIx, oneHotV+ -- ** Internal+ , mkOH) where++import qualified GHC.Generics as G+import Data.Hashable (Hashable(..))+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as VM+import Generics.SOP (DatatypeInfo, ConstructorInfo(..), constructorInfo, ConstructorName, hindex, hmap, SOP(..), I(..), K(..), hcollapse, SListI)+-- import Generics.SOP.NP (cpure_NP)+-- import Generics.SOP.Constraint (SListIN)+-- import Generics.SOP.GGP (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)++-- $setup+-- >>> :set -XDeriveDataTypeable+-- >>> :set -XDeriveGeneric+-- >>> import Generics.SOP (Generic(..), All, Code, Proxy(..))+-- >>> import Generics.SOP.NP+-- >>> import qualified GHC.Generics as G+-- >>> import Generics.SOP.GGP (gdatatypeInfo, gfrom)+-- >>> data C = C1 | C2 | C3 deriving (Eq, Show, G.Generic)++-- | Construct a 'OneHot' encoding from generic datatype and value information+-- +-- >>> mkOH (gdatatypeInfo (Proxy :: Proxy C)) (gfrom C2)+-- OH {ohDim = 3, ohIx = 1}+mkOH :: SListI xs => DatatypeInfo xs -> SOP I xs -> OneHot Int+mkOH di sop = oneHot where+ oneHot = OH sdim six+ six = hindex sop+ sdim = length $ constructorList di++-- | 1-hot encoded vector.+--+-- This representation is used to encode categorical variables as points in a vector space.+data OneHot i = OH {+ ohDim :: i -- ^ Dimensionality of the ambient space+ , ohIx :: i -- ^ index of '1'+ } deriving (Eq, Ord, G.Generic)+instance Hashable i => Hashable (OneHot i)+instance Show i => Show (OneHot i) where+ show (OH od oi) = concat ["OH_", show od, "_", show oi]++-- | Embedding dimension of the 1-hot encoded vector+onehotDim :: OneHot i -> i+onehotDim = ohDim+-- | Active ('hot') index of the 1-hot encoded vector+onehotIx :: OneHot i -> i+onehotIx = ohIx++constructorList :: SListI xs => DatatypeInfo xs -> [ConstructorName]+constructorList di = hcollapse $ hmap (\(Constructor x) -> K x) $ constructorInfo di+++-- | Create a one-hot vector+oneHotV :: Num a =>+ OneHot Int+ -> V.Vector a+oneHotV (OH n i) = V.create $ do+ vm <- VM.replicate n 0+ VM.write vm i 1+ return vm+++-- data C = C1 | C2 | C3 deriving (Eq, Show, G.Generic)
+ src/Heidi.hs view
@@ -0,0 +1,100 @@+-----------------------------------------------------------------------------+-- |+-- Module : Heidi+-- Description : tidy data in Haskell+-- Copyright : (c) Marco Zocca (2018-2020)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Heidi : tidy data in Haskell+--+-- In Heidi, a data 'Frame' is not meant to be constructed directly, but 'encode'd from a+-- collection of values. The encoding produces a simple representation which can be easily manipulated for common data analysis tasks.+--+-- +--+-----------------------------------------------------------------------------+{-# options_ghc -Wno-unused-imports #-}+module Heidi (+ -- * Frame+ Frame+ -- ** Construction+ -- *** Encoding+ , encode, Heidi, TC, VP+ -- *** Direct+ , frameFromList+ -- ** Access+ , head, take, drop, numRows+ -- ** Filtering+ , filter, filterA+ -- ** Grouping+ , groupWith+ -- ** Zipping+ , zipWith+ -- ** Scans+ , scanl, scanr+ -- * Data tidying+ , spreadWith, gatherWith+ -- * Relational operations+ , groupBy, innerJoin, leftOuterJoin+ -- ** Vector-related+ , toVector, fromVector++ -- * Row+ , Row+ -- * Construction+ , rowFromList+ -- ** Access+ , toList, keys+ -- * Filtering+ , delete, filterWithKey, filterWithKeyPrefix, filterWithKeyAny+ , deleteMany+ -- * Partitioning+ , partitionWithKey, partitionWithKeyPrefix+ -- -- ** Decoders+ -- , real, scientific, text, string, oneHot+ -- * Lookup+ , lookup+ -- , lookupThrowM+ , (!:), elemSatisfies+ -- ** Lookup utilities+ , maybeEmpty+ -- ** Comparison by lookup+ , eqByLookup, eqByLookups+ , compareByLookup+ -- * Set operations+ , union, unionWith+ , intersection, intersectionWith+ -- * Maps+ , mapWithKey+ -- * Folds+ , foldWithKey, keysOnly+ -- * Traversals+ , traverseWithKey+ -- * Lenses+ , int, bool, float, double, char, string, text, scientific, oneHot+ -- ** Lens combinators+ , at, keep+ -- *** Combinators for list-indexed rows+ , atPrefix, eachPrefixed, foldPrefixed+ -- ** Encode internals+ , tcTyN, tcTyCon, mkTyN, mkTyCon+ -- , DataException(..)+ )+ where++import Control.Monad.Catch (MonadThrow(..))++import Core.Data.Frame.List (Frame, frameFromList, head, take, drop, zipWith, numRows, filter, filterA, groupWith, scanl, scanr, toVector, fromVector)+import Core.Data.Frame.Generic (encode)+import Data.Generics.Encode.Internal (Heidi, VP(..))+-- import qualified Data.Generics.Decode as D (Decode, runDecode)+import Data.Generics.Codec (TC(..), tcTyN, tcTyCon, mkTyN, mkTyCon, TypeError(..))+import Heidi.Data.Row.GenericTrie +import Heidi.Data.Frame.Algorithms.GenericTrie (innerJoin, leftOuterJoin, gatherWith, spreadWith, groupBy)++-- import Control.Monad.Catch (MonadThrow(..))+import Prelude hiding (filter, zipWith, lookup, foldl, foldr, scanl, scanr, head, take, drop)+
+ src/Heidi/Data/Frame/Algorithms/GenericTrie.hs view
@@ -0,0 +1,273 @@+-----------------------------------------------------------------------------+-- |+-- Module : Heidi.Data.Frame.Algorithms.GenericTrie+-- Description : GenericTrie-based dataframe algorithms+-- Copyright : (c) Marco Zocca (2018-2019)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------+module Heidi.Data.Frame.Algorithms.GenericTrie (+ -- ** Row-wise operations+ unionColsWith + -- ** Filtering + -- , filterByKey+ -- ** Data tidying+ , spreadWith, gatherWith+ -- ** Relational operations+ , groupBy, innerJoin, leftOuterJoin+ ) where++import Data.Maybe (fromMaybe)+-- import Control.Applicative (Alternative(..))+import qualified Data.Foldable as F (foldMap, foldl', foldlM)+-- import Data.Foldable (foldl, foldr, foldlM, foldrM)+-- import Data.Typeable (Typeable)++-- containers+import qualified Data.Map as M+import qualified Data.Set as S (Set, fromList)+-- exception+-- import Control.Monad.Catch(Exception(..), MonadThrow(..))++-- primitive+-- import Control.Monad.Primitive (PrimMonad(..), PrimState(..))+-- scientific+-- import Data.Scientific (Scientific, toRealFloat)+-- vector+-- import qualified Data.Vector as V+-- import qualified Data.Vector.Generic.Mutable as VGM+-- vector-algorithms+-- import qualified Data.Vector.Algorithms.Merge as V (sort, sortBy, Comparison)+-- generic-trie+import qualified Data.GenericTrie as GT+-- text+-- import qualified Data.Text as T (pack)+-- import Data.Text (Text)+++-- import qualified Data.Generics.Decode as D (Decode, runDecode)+-- import Data.Generics.Decode ((>>>))+import Core.Data.Frame.List (Frame, frameFromList, zipWith)+import qualified Heidi.Data.Row.GenericTrie as GTR+-- import Core.Data.Row.Internal+-- import Data.Generics.Encode.Val (VP, getIntM, getFloatM, getDoubleM, getScientificM, getStringM, getTextM, getOneHotM)+-- import Data.Generics.Encode.OneHot (OneHot)++import Prelude hiding (filter, zipWith, lookup, foldl, foldr, scanl, scanr, head, take, drop)++++-- -- insertDecode :: (Functor f, GT.TrieKey k) =>+-- -- D.Decode f (GTR.Row k v) v -- !!! this constrains start, end value types to be identical+-- -- -> k+-- -- -> GTR.Row k v+-- -- -> f (GTR.Row k v)+-- insertDecode dec g k row = f <$> D.runDecode dec row where+-- f x = GTR.insert k (g x) row++-- -- sumCols k1 k2 = insertDecode fk where+-- -- fk = (+) <$> GTR.scientific k1 <*> GTR.scientific k2+ +++-- | Merge two frames by taking the set union of the columns+unionColsWith :: (Eq k, GT.TrieKey k) =>+ (v -> v -> v) -- ^ Element combination function+ -> Frame (GTR.Row k v)+ -> Frame (GTR.Row k v)+ -> Frame (GTR.Row k v)+unionColsWith f = zipWith (GTR.unionWith f)+++-- | Filter a 'Frame' according to predicate applied to an element pointed to by a given key.+--+-- >>> numRows <$> filterByKey "item" (/= "book") t0+-- Just 2+-- filterByKey :: (Eq k, GT.TrieKey k) =>+-- k -- ^ Key+-- -> (v -> Bool) -- ^ Predicate to be applied to the element+-- -> Frame (GTR.Row k v)+-- -> Frame (GTR.Row k v)+-- filterByKey k ff = filter (k GTR.!: ff)++++-- * Data tidying++-- | 'gatherWith' moves column names into a "key" column, gathering the column values into a single "value" column+gatherWith :: (Foldable t, Ord k, GT.TrieKey k) =>+ (k -> v)+ -> S.Set k -- ^ set of keys to gather+ -> k -- ^ "key" key+ -> k -- ^ "value" key+ -> t (GTR.Row k v) -- ^ input dataframe+ -> Frame (GTR.Row k v)+gatherWith fk ks kKey kValue = frameFromList . F.foldMap f where+ f row = gather1 fk ks row kKey kValue++-- | gather one row into a list of rows+gather1 :: (Ord k, GT.TrieKey k) =>+ (k -> v)+ -> S.Set k+ -> GTR.Row k v -- ^ row to look into+ -> k -- ^ "key" key+ -> k -- ^ "value" key+ -> [GTR.Row k v]+gather1 fk ks row kKey kValue = fromMaybe [] $ F.foldlM insf [] ks where+ rowBase = GTR.deleteMany ks row+ lookupInsert k = do+ x <- GTR.lookup k row+ let+ r' = GTR.insert kKey (fk k) rowBase+ r'' = GTR.insert kValue x r'+ pure r''+ insf acc k = do+ r' <- lookupInsert k+ pure $ r' : acc+{-# inline gather1 #-}+++++-- | 'spreadWith' moves the unique values of a key column into the column names, spreading the values of a value column across the new columns.+spreadWith :: (GT.TrieKey k, Foldable t, Ord k, Ord v) =>+ (v -> k)+ -> k -- ^ "key" key+ -> k -- ^ "value" key+ -> t (GTR.Row k v) -- ^ input dataframe+ -> Frame (GTR.Row k v)+spreadWith fk k1 k2 = frameFromList . map funion . M.toList . F.foldl' (spread1 fk k1 k2) M.empty+ where+ funion (km, vm) = GTR.union km vm+ +-- | spread1 creates a single row from multiple ones that share a subset of key-value pairs.+spread1 :: (Ord k, Ord v, GT.TrieKey k, Eq k) =>+ (v -> k)+ -> k+ -> k+ -> M.Map (GTR.Row k v) (GTR.Row k v)+ -> GTR.Row k v+ -> M.Map (GTR.Row k v) (GTR.Row k v)+spread1 fk k1 k2 hmacc row = M.insert rowBase kvNew hmacc where+ ks = S.fromList [k1, k2]+ rowBase = GTR.deleteMany ks row+ hmv = GTR.maybeEmpty $ M.lookup rowBase hmacc+ kvNew = GTR.maybeEmpty $ do+ k <- GTR.lookup k1 row+ v <- GTR.lookup k2 row+ pure $ GTR.insert (fk k) v hmv+{-# inline spread1 #-} +++++-- r0, r1, r2, r3 :: GTR.Row String String+-- r0 = GTR.fromKVs [+-- ("country", "A"), ("type", "cases"), ("count", "0.7")]+-- r1 = GTR.fromKVs [+-- ("country", "A"), ("type", "pop"), ("count", "19")]+-- r2 = GTR.fromKVs [+-- ("country", "B"), ("type", "cases"), ("count", "37")] +-- r3 = GTR.fromKVs [+-- ("country", "B"), ("type", "pop"), ("count", "172")] ++-- -- frame0 :: [GTR.Row String String]+-- frame0 = fromList [r0, r1, r2, r3] ++-- fr1 = spread id "type" "count" frame0++-- fr2 = gather id (S.fromList ["cases", "pop"]) "type" "count" fr1++++++-- * Relational operations++-- | GROUP BY : given a key and a table that uses it, split the table in multiple tables, one per value taken by the key.+--+-- >>> numRows <$> (HM.lookup "129" $ groupBy "id.0" t0)+-- Just 2+groupBy :: (Foldable t, GT.TrieKey k, Eq k, Ord v) =>+ k -- ^ Key to group by+ -> t (GTR.Row k v) -- ^ A 'Frame (GTR.Row k v) can be used here+ -> M.Map v (Frame (GTR.Row k v))+groupBy k tbl = frameFromList <$> groupL k tbl++groupL :: (Foldable t, Eq k, GT.TrieKey k, Eq v, Ord v) =>+ k -> t (GTR.Row k v) -> M.Map v [GTR.Row k v]+groupL k tbl = F.foldl' insf M.empty tbl where+ insf acc row = maybe acc (\v -> M.insertWith (++) v [row] acc) (GTR.lookup k row)+{-# inline groupL #-}++++++joinWith :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>+ (GTR.Row k v -> [GTR.Row k v] -> [GTR.Row k v])+ -> k+ -> k+ -> t (GTR.Row k v)+ -> t (GTR.Row k v)+ -> Frame (GTR.Row k v)+joinWith f k1 k2 table1 table2 = frameFromList $ F.foldl' insf [] table1 where+ insf acc row1 = maybe (f row1 acc) appendMatchRows (GTR.lookup k1 row1) where+ appendMatchRows v = map (GTR.union row1) mr2 ++ acc where+ mr2 = matchingRows k2 v table2++++-- | LEFT (OUTER) JOIN : given two dataframes and one key from each, compute the left outer join using the keys as relations.+leftOuterJoin :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>+ k+ -> k+ -> t (GTR.Row k v)+ -> t (GTR.Row k v)+ -> Frame (GTR.Row k v)+leftOuterJoin = joinWith (:)+++-- | INNER JOIN : given two dataframes and one key from each, compute the inner join using the keys as relations.+--+-- >>> head t0+-- [("id.0","129"),("qty","1"),("item","book")]+--+-- >>> head t1+-- [("id.1","129"),("price","100")]+-- +-- >>> head $ innerJoin "id.0" "id.1" t0 t1+-- [("id.1","129"),("id.0","129"),("qty","5"),("item","book"),("price","100")]+innerJoin :: (Foldable t, Ord v, GT.TrieKey k, Eq v, Eq k) =>+ k -- ^ Key into the first table+ -> k -- ^ Key into the second table+ -> t (GTR.Row k v) -- ^ First dataframe+ -> t (GTR.Row k v) -- ^ Second dataframe+ -> Frame (GTR.Row k v)+innerJoin = joinWith seq++++ +++matchingRows :: (Foldable t, GT.TrieKey k, Eq k, Ord v) =>+ k -> v -> t (GTR.Row k v) -> [GTR.Row k v]+matchingRows k v rows = fromMaybe [] (M.lookup v rowMap) where+ rowMap = hjBuild k rows+{-# INLINE matchingRows #-}+ +-- | "build" phase of the hash-join algorithm+--+-- For a given key 'k' and a set of frame rows, populates a hashmap from the _values_ corresponding to 'k' to the corresponding rows.+hjBuild :: (Foldable t, Eq k, GT.TrieKey k, Eq v, Ord v) =>+ k -> t (GTR.Row k v) -> M.Map v [GTR.Row k v]+hjBuild k = F.foldl' insf M.empty where+ insf hmAcc row = maybe hmAcc (\v -> M.insertWith (++) v [row] hmAcc) $ GTR.lookup k row+{-# INLINE hjBuild #-}+ ++
+ src/Heidi/Data/Frame/Algorithms/GenericTrie/Generic.hs view
@@ -0,0 +1,40 @@+{-# language LambdaCase #-}+{-# options_ghc -Wno-unused-imports #-}+module Heidi.Data.Frame.Algorithms.GenericTrie.Generic where++-- containers+import qualified Data.Set as S+-- generic-trie+import qualified Data.GenericTrie as GT+-- text+import qualified Data.Text as T (Text, pack, unpack)++import Heidi.Data.Row.GenericTrie (Row)+import Heidi.Data.Frame.Algorithms.GenericTrie (spreadWith, gatherWith)+import Core.Data.Frame.List (Frame)+-- import Data.Generics.Codec ()++import Data.Generics.Encode.Internal (VP(..), TC(..), tcTyCon, tcTyN, mkTyCon, mkTyN)++++-- -- a user shouldn\t have to manipulate TCs++-- spread :: Foldable t => [TC] -> [TC] -> t (Row [TC] VP) -> Frame (Row [TC] VP)+-- spread = spreadWith valueToKey++-- gather :: Foldable t =>+-- S.Set [TC]+-- -> [TC]+-- -> [TC]+-- -> t (Row [TC] VP)+-- -> Frame (Row [TC] VP)+-- gather = gatherWith keyToValue+++keyToValue :: [TC] -> VP+keyToValue = VPString . concatMap tcTyN++valueToKey :: VP -> [TC]+valueToKey = pure . mkTyN . show+
+ src/Heidi/Data/Row/GenericTrie.hs view
@@ -0,0 +1,466 @@+{-# language DeriveFunctor #-}+{-# language DeriveFoldable #-}+{-# language DeriveGeneric #-}+{-# language DeriveTraversable #-}+{-# language TemplateHaskell #-}+{-# language LambdaCase #-}+{-# language RankNTypes #-}+{-# options_ghc -Wno-unused-imports #-}+-----------------------------------------------------------------------------+-- |+-- Module : Heidi.Data.Row.GenericTrie+-- Description : A sparse dataframe row, based on GenericTrie+-- Copyright : (c) Marco Zocca (2018-2019)+-- License : BSD-style+-- Maintainer : ocramz fripost org+-- Stability : experimental+-- Portability : GHC+--+-- Rows are internally represented with prefix trees ("tries"), as provided by the+-- @generic-trie@ library; in addition to supporting the possibility of missing features in the dataset, tries provide fast insertion and lookup functionality when keyed with structured datatypes (such as lists or trees).+--+-----------------------------------------------------------------------------+module Heidi.Data.Row.GenericTrie (+ Row+ -- * Construction+ , rowFromList, empty+ -- ** (unsafe)+ , mkRow+ -- * Update+ , insert, insertMany, insertWith+ -- * Access+ , toList, keys+ -- * Filtering+ , delete, filterWithKey, filterWithKeyPrefix, filterWithKeyAny+ , deleteMany+ -- * Partitioning+ , partitionWithKey, partitionWithKeyPrefix+ -- -- ** Decoders+ -- , real, scientific, text, string, oneHot+ -- * Lookup+ , lookup+ -- , lookupThrowM+ , (!:), elemSatisfies+ -- ** Lookup utilities+ , maybeEmpty+ -- ** Comparison by lookup+ , eqByLookup, eqByLookups+ , compareByLookup+ -- * Set operations+ , union, unionWith+ , intersection, intersectionWith+ -- * Maps+ , mapWithKey+ -- * Folds+ , foldWithKey, keysOnly+ -- * Traversals+ , traverseWithKey+ -- * Lenses+ , int, bool, float, double, char, string, text, scientific, oneHot+ -- ** Lens combinators+ , at, keep+ -- *** Combinators for list-indexed rows+ , atPrefix, eachPrefixed, foldPrefixed+ ) where++-- import Control.Monad (foldM+import Data.Functor.Const (Const(..))+import Data.Functor.Identity (Identity(..))+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import Data.Monoid (Any(..), All(..))+-- import Data.Semigroup (Endo)+-- import Data.Typeable (Typeable)+-- import Control.Applicative (Alternative(..))+import qualified Data.Foldable as F+-- import Control.Monad (filterM)+-- generic-trie+import qualified Data.GenericTrie as GT+-- exceptions+-- import Control.Monad.Catch (MonadThrow(..))+-- microlens+import Lens.Micro (Lens', Traversal', Getting, (^.), (<&>), _Just, Getting, traversed, folded, to, has)+-- -- microlens-th+-- import Lens.Micro.TH (makeLenses)+-- scientific+import Data.Scientific (Scientific)+-- text+import Data.Text (Text)+++-- import qualified Data.Generics.Decode as D (Decode, mkDecode)+-- import Data.Generics.Decode ((>>>))+import Data.Generics.Encode.Internal (VP, vpInt, vpFloat, vpDouble, vpString, vpChar, vpText, vpBool, vpScientific, vpOneHot)+import Data.Generics.Encode.OneHot (OneHot)+-- import Data.Generics.Codec+-- import Core.Data.Row.Internal (KeyError(..))++import Prelude hiding (any, lookup)+++-- $setup+-- >>> import Data.Generics.Encode.Internal (VP)+-- >>> let row0 = fromList [(0, 'a'), (3, 'b')] :: Row Int Char+-- >>> let row1 = fromList [(0, 'x'), (1, 'b'), (666, 'z')] :: Row Int Char+++-- | A 'Row' type is internally a Trie:+--+-- * Fast random access+-- * Fast set operations+-- * Supports missing elements+newtype Row k v = Row { _unRow :: GT.Trie k v } deriving (Functor, Foldable, Traversable)+-- makeLenses ''Row+instance (GT.TrieKey k, Show k, Show v) => Show (Row k v) where+ show = show . GT.toList . _unRow++instance (GT.TrieKey k, Eq k, Eq v) => Eq (Row k v) where+ r1 == r2 = F.toList r1 == F.toList r2++instance (GT.TrieKey k, Eq k, Eq v, Ord k, Ord v) => Ord (Row k v) where+ r1 <= r2 = F.toList r1 <= F.toList r2++-- | Focus on a given column+at :: GT.TrieKey k => k -> Lens' (Row k a) (Maybe a)+at k f m = f mv <&> \case+ Nothing -> maybe m (const (delete k m)) mv+ Just v' -> insert k v' m+ where mv = lookup k m+{-# INLINABLE at #-}++-- | 'atPrefix' : a Lens' that takes a key prefix and relates a row having lists as keys and the subset of columns corresponding to keys having that prefix+atPrefix :: (GT.TrieKey k, Eq k) =>+ [k] -- ^ key prefix of the columns of interest+ -> Lens' (Row [k] v) [v]+atPrefix k f m = f vs <&> \case+ [] -> if null kvs then m else deleteMany ks m+ vs' -> insertMany (zip ks vs') m+ where+ kvs = toList $ filterWithKeyPrefix k m+ (ks, vs) = unzip kvs++{- | Focus on all elements that share a common key prefix++e.g.++@+>>> :t \k -> 'Lens.Micro.toListOf' (eachPrefixed k . 'vpBool')+(GT.TrieKey k, Eq k) => [k] -> Row [k] VP -> [Bool]+@+-}+eachPrefixed :: (GT.TrieKey k, Eq k) =>+ [k] -- ^ key prefix of the columns of interest+ -> Traversal' (Row [k] v) v+eachPrefixed k = atPrefix k . traversed++-- | Extract all elements that share a common key prefix into a monoidal value (e.g. a list)+foldPrefixed :: (GT.TrieKey k, Eq k, Monoid r) =>+ [k] -- ^ key prefix of the columns of interest+ -> Getting r (Row [k] v) v+foldPrefixed k = atPrefix k . folded++-- foldingPrefixed f k = atPrefix k . folding f++-- any :: Eq a => a -> a -> Any+-- any v = Any . (== v)++-- | Helper for filtering 'Frame's+--+-- e.g.+--+-- >>> :t \k -> keep (text k) (== "hello")+-- :: GT.TrieKey k => k -> Row k VP -> Bool+keep :: Getting Any row a+ -> (a -> b) -- ^ e.g. a predicate+ -> row+ -> Bool+keep l f = has (l . to f)+++-- keep :: (Eq a) => Getting Any row a -> a -> row -> Bool+-- keep l v = has (l . to (== v))++-- ** Lenses++-- | Decode a 'Bool' from the given column index+bool :: GT.TrieKey k => k -> Traversal' (Row k VP) Bool+bool k = at k . _Just . vpBool+-- | Decode a 'Int' from the given column index+int :: GT.TrieKey k => k -> Traversal' (Row k VP) Int+int k = at k . _Just . vpInt+-- | Decode a 'Float' from the given column index+float :: GT.TrieKey k => k -> Traversal' (Row k VP) Float+float k = at k . _Just . vpFloat+-- | Decode a 'Double' from the given column index+double :: GT.TrieKey k => k -> Traversal' (Row k VP) Double+double k = at k . _Just . vpDouble+-- | Decode a 'Char' from the given column index+char :: GT.TrieKey k => k -> Traversal' (Row k VP) Char+char k = at k . _Just . vpChar+-- | Decode a 'String' from the given column index+string :: GT.TrieKey k => k -> Traversal' (Row k VP) String+string k = at k . _Just . vpString+-- | Decode a 'Text' from the given column index+text :: GT.TrieKey k => k -> Traversal' (Row k VP) Text+text k = at k . _Just . vpText+-- | Decode a 'Scientific' from the given column index+scientific :: GT.TrieKey k => k -> Traversal' (Row k VP) Scientific+scientific k = at k . _Just . vpScientific+-- | Decode a 'OneHot' from the given column index+oneHot :: GT.TrieKey k => k -> Traversal' (Row k VP) (OneHot Int)+oneHot k = at k . _Just . vpOneHot++++++++-- | Construct a 'Row' from a list of key-element pairs.+--+-- >>> lookup 3 (rowFromList [(3,'a'),(4,'b')])+-- Just 'a'+-- >>> lookup 6 (rowFromList [(3,'a'),(4,'b')])+-- Nothing+rowFromList :: GT.TrieKey k => [(k, v)] -> Row k v+rowFromList = Row . GT.fromList++-- | Construct a 'Row' from a trie (unsafe).+mkRow :: GT.Trie k v -> Row k v+mkRow = Row++-- | An empty row+empty :: GT.TrieKey k => Row k v+empty = Row GT.empty++-- | Access the key-value pairs contained in the 'Row'+toList :: GT.TrieKey k => Row k v -> [(k ,v)]+toList = GT.toList . _unRow++-- | Lookup the value stored at a given key in a row+--+-- >>> lookup 0 row0+-- Just 'a'+-- >>> lookup 1 row0+-- Nothing+lookup :: (GT.TrieKey k) => k -> Row k v -> Maybe v+lookup k = GT.lookup k . _unRow++liftLookup :: GT.TrieKey k =>+ (a -> b -> c) -> k -> Row k a -> Row k b -> Maybe c+liftLookup f k r1 r2 = f <$> lookup k r1 <*> lookup k r2+++-- | Compares for ordering two rows by the values indexed at a specific key.+--+-- Returns Nothing if the key is not present in either row.+compareByLookup :: (GT.TrieKey k, Eq k, Ord a) =>+ k -> Row k a -> Row k a -> Maybe Ordering+compareByLookup = liftLookup compare++-- | Compares two rows by the values indexed at a specific key.+--+-- Returns Nothing if the key is not present in either row.+eqByLookup :: (GT.TrieKey k, Eq k, Eq a) =>+ k -> Row k a -> Row k a -> Maybe Bool+eqByLookup = liftLookup (==)++-- | Compares two rows by the values indexed at a set of keys.+--+-- Returns Nothing if a key in either row is not present.+eqByLookups :: (Foldable t, GT.TrieKey k, Eq k, Eq a) =>+ t k -> Row k a -> Row k a -> Maybe Bool+eqByLookups ks r1 r2 = F.foldlM insf True ks where+ insf b k = (&&) <$> pure b <*> eqByLookup k r1 r2++-- -- | Like 'lookup', but throws a 'KeyError' if the lookup is unsuccessful+-- lookupThrowM :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k) =>+-- k -> Row k v -> m v+-- lookupThrowM k r = maybe (throwM $ MissingKeyError k) pure (lookup k r)++-- | Returns an empty row if the argument is Nothing.+maybeEmpty :: GT.TrieKey k => Maybe (Row k v) -> Row k v+maybeEmpty = fromMaybe empty++-- | List the keys of a given row+--+-- >>> keys row0+-- [0,3]+keys :: GT.TrieKey k => Row k v -> [k]+keys = map fst . toList++-- | Takes the union of a Foldable container of 'Row's and discards the values+keysOnly :: (GT.TrieKey k, Foldable f) => f (Row k v) -> Row k ()+keysOnly ks = () <$ F.foldl' union empty ks++-- | Returns a new 'Row' that doesn't have a given key-value pair+delete :: GT.TrieKey k =>+ k -- ^ Key to remove+ -> Row k v+ -> Row k v+delete k (Row gt) = Row $ GT.delete k gt++-- | Produce a new 'Row' such that its keys do _not_ belong to a certain set.+deleteMany :: (GT.TrieKey k, Foldable t) => t k -> Row k v -> Row k v+deleteMany ks r = foldl (flip delete) r ks++-- | Map over all elements with a function of both the key and the value+mapWithKey :: GT.TrieKey k => (k -> a -> b) -> Row k a -> Row k b+mapWithKey ff (Row gt) =+ runIdentity $ Row <$> GT.traverseWithKey (\k v -> pure (ff k v)) gt+++-- | Filter a row by applying a predicate to its keys and corresponding elements.+--+-- NB : filtering _retains_ the elements that satisfy the predicate.+filterWithKey :: GT.TrieKey k => (k -> v -> Bool) -> Row k v -> Row k v+filterWithKey ff (Row gt) = Row $ GT.filterWithKey ff gt++-- | Retains the entries for which the given list is a prefix of the indexing key+filterWithKeyPrefix :: (GT.TrieKey a, Eq a) =>+ [a] -- ^ key prefix+ -> Row [a] v+ -> Row [a] v+filterWithKeyPrefix kpre = filterWithKey (\k _ -> kpre `isPrefixOf` k)++-- | Partition a 'Row' into two new ones, such as the elements that satisfy the predicate will end up in the _left_ row.+partitionWithKey :: GT.TrieKey k =>+ (k -> v -> Bool) -- ^ predicate+ -> Row k v+ -> (Row k v, Row k v) +partitionWithKey qf = foldWithKey insf (empty, empty)+ where+ insf k v (lacc, racc) | qf k v = (insert k v lacc, racc)+ | otherwise = (lacc, insert k v racc)++-- | Uses 'partitionWithKey' internally+partitionWithKeyPrefix :: (GT.TrieKey a, Eq a) =>+ [a] -- ^ key prefix+ -> Row [a] v+ -> (Row [a] v, Row [a] v)+partitionWithKeyPrefix kpre = partitionWithKey (\k _ -> kpre `isPrefixOf` k)++-- | Retains the entries for which the given item appears at any position in the indexing key+filterWithKeyAny :: (GT.TrieKey a, Eq a) => a -> Row [a] v -> Row [a] v+filterWithKeyAny kany = filterWithKey (\k _ -> kany `elem` k)+++++-- alter k m = fromMaybe m $ do+-- v <- lookup k m +-- delete k m++-- alter k f t =+-- case f (lookup k t) of+-- Just v' -> insert k v' t+-- Nothing -> delete k t++-- modify k v = +++-- | Insert a key-value pair into a row and return the updated one+-- +-- >>> keys $ insert 2 'y' row0+-- [0,2,3]+insert :: (GT.TrieKey k) => k -> v -> Row k v -> Row k v+insert k v = Row . GT.insert k v . _unRow++insertMany :: (GT.TrieKey k, Foldable t) => t (k, v) -> Row k v -> Row k v+insertMany kvs r = foldl (\acc (k, v) -> insert k v acc) r kvs++-- | Insert a key-value pair into a row and return the updated one, or updates the value by using the combination function.+insertWith :: (GT.TrieKey k) => (v -> v -> v) -> k -> v -> Row k v -> Row k v+insertWith f k v = Row . GT.insertWith f k v . _unRow++-- | Fold over a row with a function of both key and value+foldWithKey :: GT.TrieKey k => (k -> a -> r -> r) -> r -> Row k a -> r+foldWithKey fk z (Row gt) = GT.foldWithKey fk z gt++-- | Traverse a 'Row' using a function of both the key and the element.+traverseWithKey :: (Applicative f, GT.TrieKey k) => (k -> a -> f b) -> Row k a -> f (Row k b)+traverseWithKey f r = Row <$> GT.traverseWithKey f (_unRow r)+++-- | Set union of two rows+--+-- >>> keys $ union row0 row1+-- [0,1,3,666]+union :: (GT.TrieKey k) => Row k v -> Row k v -> Row k v+union r1 r2 = Row $ GT.union (_unRow r1) (_unRow r2)++-- | Set union of two rows, using a combining function for equal keys+unionWith :: (GT.TrieKey k) =>+ (v -> v -> v) -> Row k v -> Row k v -> Row k v+unionWith f r1 r2 = Row $ GT.unionWith f (_unRow r1) (_unRow r2)++-- | Set intersection of two rows+intersection :: GT.TrieKey k => Row k v -> Row k b -> Row k v+intersection r1 r2 = Row $ GT.intersection (_unRow r1) (_unRow r2)++-- | Set intersections of two rows, using a combining function for equal keys+intersectionWith :: GT.TrieKey k => (a -> b -> v) -> Row k a -> Row k b -> Row k v+intersectionWith f r1 r2 = Row $ GT.intersectionWith f (_unRow r1) (_unRow r2)+++-- | Looks up a key from a row and applies a predicate to its value (if this is found). If no value is found at that key the function returns False.+--+-- This function is meant to be used as first argument to 'filter'.+--+-- >>> elemSatisfies (== 'a') 0 row0+-- True+-- >>> elemSatisfies (== 'a') 42 row0+-- False+elemSatisfies :: (GT.TrieKey k) => (a -> Bool) -> k -> Row k a -> Bool+elemSatisfies f k row = maybe False f (lookup k row)++-- | Inline synonym for 'elemSatisfies'+(!:) :: (GT.TrieKey k) => k -> (a -> Bool) -> Row k a -> Bool+k !: f = elemSatisfies f k ++-- -- | Lookup a value from a Row indexed at the given key (returns in a MonadThrow type)+-- lookupColM :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k) =>+-- k -> D.Decode m (Row k o) o+-- lookupColM k = D.mkDecode (lookupThrowM k)++-- -- -- | Lookup a value from a Row indexed at the given key (returns in the Maybe monad)+-- -- lookupCol :: GT.TrieKey k => k -> D.Decode Maybe (Row k o) o+-- -- lookupCol k = D.mkDecode (lookup k)++++++-- -- * Decoders++-- -- | Lookup and decode a real number+-- real :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k, Alternative m) =>+-- k -> D.Decode m (Row k VP) Double+-- real k = lookupColM k >>> realM++-- -- | Lookup and decode a real 'Scientific' value+-- scientific :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k, Alternative m) =>+-- k -> D.Decode m (Row k VP) Scientific+-- scientific k = lookupColM k >>> scientificM++-- -- | Lookup and decode a text string (defaults to Text)+-- text :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k, Alternative m) =>+-- k -> D.Decode m (Row k VP) Text+-- text k = lookupColM k >>> textM++-- -- | Lookup and decode a text string (defaults to 'String')+-- string :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k, Alternative m) =>+-- k -> D.Decode m (Row k VP) String+-- string k = lookupColM k >>> stringM++-- -- | Lookup and decode a one-hot encoded enum+-- oneHot :: (MonadThrow m, Show k, Typeable k, GT.TrieKey k) =>+-- k -> D.Decode m (Row k VP) (OneHot Int)+-- oneHot k = lookupColM k >>> oneHotM+++++-- -- spork k1 k2 = (>) <$> real k1 <*> real k2++
+ stack.yaml view
@@ -0,0 +1,37 @@+# resolver: lts-9.0 # GHC 8.0.2+# resolver: lts-11.0+# resolver: lts-12.0+# resolver: lts-13.6+# resolver: lts-13.17 # GHC 8.6.4+# resolver: lts-13.21 # GHC 8.6.5+resolver: lts-14.19 # 8.6.5++packages:+- .++extra-deps: +- generic-trie-0.3.1@sha256:203cfc0086372abaf99ffb4b4b565eba8a28e6020f1104ec479cd96d0c3baeb7++# Override default flag values for local packages and extra-deps+# flags: {}++# Extra package databases containing global packages+# extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.9"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
+ test/DocTest.hs view
@@ -0,0 +1,12 @@+module Main where++import Test.DocTest (doctest)++main :: IO ()+main = doctest [+ -- "src/Data/Generics/Encode/OneHot.hs",+ -- "src/Heidi.hs"+ -- "src/Data/Generics/Encode/Internal.hs", + -- "src/Core/Data/Frame/Generic.hs",+ "src/Core/Data/Frame/List.hs" + ]
+ test/Main.hs view
@@ -0,0 +1,23 @@+module Main where++import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.Hspec (Spec, testSpec, parallel)++import qualified Unit.GenericTrie as UGTR++main :: IO ()+main = do+ test_gtr <- testSpec "GenericTrie-based rows" spec_Frame_GTR+ defaultMain $ do+ testGroup "Heidi.Data.Frame.Algorithms" [test_gtr]+ +spec_Frame_GTR :: Spec+spec_Frame_GTR = parallel $ do + UGTR.test_innerJoin+ UGTR.test_leftOuterJoin+ UGTR.test_groupBy ++-- spec :: Spec+-- spec = parallel $ do+-- it "is trivially true" $ do+-- True `shouldBe` True
+ test/Unit/GenericTrie.hs view
@@ -0,0 +1,62 @@+module Unit.GenericTrie where++import Test.Tasty.Hspec (Spec, it, shouldBe)++import Heidi.Data.Frame.Algorithms.GenericTrie (innerJoin, leftOuterJoin, groupBy)+import Heidi (Frame, frameFromList, Row, rowFromList)++test_innerJoin :: Spec+test_innerJoin = it "innerJoin" $ do+ let jt = innerJoin "id.dep" "id.dep" employee department+ length jt `shouldBe` 5++test_leftOuterJoin :: Spec+test_leftOuterJoin = it "leftOuterJoin" $ do+ let jt = leftOuterJoin "id.dep" "id.dep" employee department+ length jt `shouldBe` 6 ++test_groupBy :: Spec+test_groupBy = it "groupBy" $ do+ let gt = groupBy "id.dep" employee+ length gt `shouldBe` 3++++-- example data from https://en.wikipedia.org/wiki/Join_(SQL)++employee :: Frame (Row String String)+employee = frameFromList [e1, e2, e3, e4, e5, e6] where+ e1 = rowFromList [("name", "Rafferty"), ("id.dep", "31")]+ e2 = rowFromList [("name", "Jones"), ("id.dep", "33")]+ e3 = rowFromList [("name", "Heisenberg"), ("id.dep", "33")]+ e4 = rowFromList [("name", "Robinson"), ("id.dep", "34")]+ e5 = rowFromList [("name", "Smith"), ("id.dep", "34")]+ e6 = rowFromList [("name", "Williams")] ++department :: Frame (Row String String)+department = frameFromList [d1, d2, d3, d4] where+ d1 = rowFromList [("id.dep", "31"), ("dept", "Sales")]+ d2 = rowFromList [("id.dep", "33"), ("dept", "Engineering")]+ d3 = rowFromList [("id.dep", "34"), ("dept", "Clerical")]+ d4 = rowFromList [("id.dep", "35"), ("dept", "Marketing")] +++++++t0 :: Frame (Row String String)+t0 = frameFromList [ book1, ball, bike, book2 ]+ where+ book1 = rowFromList [("item", "book"), ("id.0", "129"), ("qty", "1")]+ book2 = rowFromList [("item", "book"), ("id.0", "129"), ("qty", "5")] + ball = rowFromList [("item", "ball"), ("id.0", "234"), ("qty", "1")] + bike = rowFromList [("item", "bike"), ("id.0", "410"), ("qty", "1")]++t1 :: Frame (Row String String)+t1 = frameFromList [ r1, r2, r3, r4 ] + where+ r1 = rowFromList [("id.1", "129"), ("price", "100")]+ r2 = rowFromList [("id.1", "234"), ("price", "50")] + r3 = rowFromList [("id.1", "3"), ("price", "150")]+ r4 = rowFromList [("id.1", "99"), ("price", "30")]