javelin-frames (empty) → 0.1.0.0
raw patch · 8 files changed
+2232/−0 lines, 8 filesdep +basedep +containersdep +criterion
Dependencies added: base, containers, criterion, deepseq, hedgehog, javelin-frames, tasty, tasty-hedgehog, tasty-hunit, these, vector, vector-algorithms
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- benchmarks/Main.hs +61/−0
- javelin-frames.cabal +78/−0
- src/Data/Frame.hs +1094/−0
- src/Data/Frame/Tutorial.hs +651/−0
- test/Main.hs +11/−0
- test/Test/Data/Frame.hs +312/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for javelin-frames + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Laurent Rene de Cotret + +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.
+ benchmarks/Main.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TypeFamilies #-} + +import Control.DeepSeq ( NFData, rnf ) +import Control.Exception ( evaluate ) +import Criterion.Main ( bench, bgroup, nf, defaultMain ) + +import Data.Function (on) +import Data.Frame ( Column, Frameable, Indexable, Row, Frame ) +import qualified Data.Frame as Frame +import qualified Data.Vector as Vector + +import GHC.Generics ( Generic ) + + +data Bench t + = MkBench { field1 :: Column t Int + , field2 :: Column t Int + , field3 :: Column t Int + , field4 :: Column t Int + , field5 :: Column t Int + , field6 :: Column t Int + } + deriving (Generic, Frameable) + +instance NFData (Row Bench) +instance NFData (Frame Bench) + +instance Indexable Bench where + type Key Bench = Int + + index = field1 + + +main :: IO () +main = do + let rs = Vector.fromList [MkBench ix 0 0 0 0 0 | ix <- [0::Int .. 100_000]] + fr = Frame.fromRows rs + reversed = Frame.fromRows $ Vector.reverse rs + evaluate $ rnf rs + evaluate $ rnf fr + evaluate $ rnf reversed + defaultMain + [ bgroup "Row-wise operations" + [ bench "fromRows" $ nf (Frame.fromRows) rs + , bench "toRows" $ nf (Frame.toRows) fr + , bench "toRows . fromRows" $ nf (Frame.fromRows . Frame.toRows) fr + , bench "fromRows . toRows" $ nf (Frame.toRows . Frame.fromRows) rs + , bench "sortRowsBy" $ nf (Frame.sortRowsBy (compare `on` field1)) reversed + , bench "sortRowsByKey" $ nf (Frame.sortRowsByKey) reversed + ] + , bgroup "Lookups" + [ bench "lookup" $ nf (Frame.lookup 100) fr + , bench "ilookup" $ nf (Frame.ilookup 99) fr + , bench "at" $ nf (`Frame.at` (100, field5)) fr + , bench "iat" $ nf (`Frame.iat` (99, field5)) fr + ] + , bgroup "Merging" + [ bench "mergeWithStrategy" $ nf (Frame.mergeWithStrategy (Frame.matchedStrategy (\_ r1 _ -> r1)) fr) reversed + ] + ]
+ javelin-frames.cabal view
@@ -0,0 +1,78 @@+cabal-version: 3.0 +name: javelin-frames +version: 0.1.0.0 +synopsis: Type-safe data frames based on higher-kinded types. +-- description: +license: MIT +license-file: LICENSE +author: Laurent P. René de Cotret +maintainer: laurent.decotret@outlook.com +category: Data, Data Structures, Data Science +build-type: Simple +extra-doc-files: CHANGELOG.md +tested-with: GHC ==9.12.1 + || ==9.10.1 + || ==9.8.4 + || ==9.6.4 + || ==9.4.8 + +description: + + This package implements data frames, a data structure + where record types defined by the user can be transformed + into records of columns. See ["Data.Frame.Tutorial"] a user guide. + +source-repository head + type: git + location: https://github.com/LaurentRDC/javelin + +common common + default-language: GHC2021 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + -fhide-source-paths + -Wpartial-fields + +library + import: common + exposed-modules: Data.Frame + Data.Frame.Tutorial + build-depends: base >=4.15.0.0 && <4.22, + containers >=0.6 && <0.8, + these ^>=1.2, + vector >=0.12.3.0 && <0.14, + vector-algorithms ^>=0.9 + hs-source-dirs: src + default-language: GHC2021 + +test-suite javelin-frames-test + import: common + default-language: GHC2021 + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: Test.Data.Frame + build-depends: base >=4.15.0.0 && <4.22, + containers, + hedgehog, + javelin-frames, + tasty, + tasty-hedgehog, + tasty-hunit, + vector + +benchmark bench-frames + import: common + type: exitcode-stdio-1.0 + ghc-options: -rtsopts + hs-source-dirs: benchmarks + main-is: Main.hs + build-depends: base >=4.15.0.0 && <4.22, + criterion ^>=1.6, + deepseq, + javelin-frames, + vector
+ src/Data/Frame.hs view
@@ -0,0 +1,1094 @@+{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-} +----------------------------------------------------------------------------- +-- | +-- Module : $header +-- Copyright : (c) Laurent P. René de Cotret +-- License : MIT +-- Maintainer : laurent.decotret@outlook.com +-- Portability : portable +-- Stability : experimental +-- +-- This is an experimental interface to dataframes. +-- +-- This module defines the type machinery and some functions to +-- process data frames. Data frames are structures where every +-- row corresponds to an object, but data is stored in +-- contiguous arrays known as columns. +-- +-- A user guide is provided in the "Data.Frame.Tutorial" module. + +module Data.Frame ( + -- * Defining dataframe types + Column, Frameable, Row, Frame, + + -- * Construction and deconstruction + fromRows, toRows, fields, + + -- * Operations on rows + null, length, mapRows, mapRowsM, filterRows, foldlRows, + -- ** Sorting rows in frames + sortRowsBy, sortRowsByUnique, + sortRowsByKey, sortRowsByKeyUnique, sortRowsByKeyUniqueOn, + + -- * Displaying frames + display, + -- ** Customizing the display of frames + displayWith, DisplayOptions(..), defaultDisplayOptions, + + -- * Indexing operations + -- ** Based on integer indices + ilookup, iat, + -- ** Based on indexable frames + Indexable(Key, index), lookup, at, + + -- * Merging dataframes + -- ** Zipping rows in order + zipRowsWith, + -- ** Merging using an index + mergeWithStrategy, mergeWithStrategyOn, matchedStrategy, + -- *** Helpers to define your own merge strategies + These(..), +) where + + +import Control.Exception (assert) +import Control.Monad.ST ( runST ) +import Data.Bifunctor (second) +import qualified Data.Foldable +import Data.Function (on) +import Data.Functor ((<&>)) +import Data.Functor.Identity (Identity(..)) +import Data.Kind (Type) +import qualified Data.List as List ( intersperse, foldl' ) +import Data.Maybe (catMaybes) +import Data.Sequence (Seq(..)) +import qualified Data.Sequence as Seq +import Data.Semigroup (Max(..)) +import qualified Data.Set as Set +import Data.These (These(..)) +import Data.Tuple (swap) +import Data.Vector (Vector) +import qualified Data.Vector +import qualified Data.Vector.Algorithms.Tim as TimSort (sortBy, sortUniqBy) +import Prelude hiding (lookup, null, length) +import qualified Prelude +import GHC.Generics ( Selector, Generic(..), S, D, C, K1(..), Rec0, M1(..), type (:*:)(..), selName ) + + +-- $setup +-- >>> import qualified Data.Vector as Vector + +-- | Build a dataframe from a container of rows. +-- +-- For the inverse operation, see `toRows`. +fromRows :: (Frameable t, Foldable f) + => f (Row t) + -> Frame t +fromRows = pack . Data.Vector.fromList . Data.Foldable.toList +{-# INLINE[~2] fromRows #-} + + +-- | Deconstruct a dataframe into its rows. +-- +-- For the inverse operation, see `fromRows`. +toRows :: Frameable t + => Frame t + -> Vector (Row t) +toRows = unpack +{-# INLINE[~2] toRows #-} + + +-- TODO: Chaining operations such as `mapRows` and `filterRows` +-- should benefit from optimizing as `toRows . fromRows = id` +-- ( and `fromRows . toRows = id` as well). +-- See the rules below. +-- It's not clear if I'm using the rewrite system correctly, +-- by looking at the benchmark resuylts +{-# RULES +"fromRows/toRows" [2] fromRows . toRows = id +"toRows/fromRows" [2] toRows . fromRows = id + #-} + +-- | Returns `True` if a dataframe has no rows. +null :: Frameable t + => Frame t + -> Bool +-- TODO: we can use yet another typeclass deriving +-- from generic to only look at ONE of the columns, +-- rather than reconstructing the first row +null = Data.Vector.null . toRows + + +-- | Access the length of a dataframe, i.e. the number of rows. +length :: Frameable t + => Frame t + -> Int +-- TODO: we can use yet another typeclass deriving +-- from generic to only look at ONE of the columns, +-- rather than reconstructing all rows. +length = Data.Vector.length . toRows + + +-- | Map a function over each row individually. +-- +-- For mapping with a monadic action, see `mapRowsM`. +mapRows :: (Frameable t1, Frameable t2) + => (Row t1 -> Row t2) + -> Frame t1 + -> Frame t2 +mapRows f = fromRows + . Data.Vector.map f + . toRows + + +-- | Map each element of a dataframe to a monadic action, evaluate +-- these actions from left to right, and collect the result +-- in a new dataframe. +-- +-- For mapping without a monadic action, see `mapRows`. +mapRowsM :: (Frameable t1, Frameable t2, Monad m) + => (Row t1 -> m (Row t2)) + -> Frame t1 + -> m (Frame t2) +mapRowsM f = fmap fromRows + . Data.Vector.mapM f + . toRows + + +-- | Filter rows from a @`Frame` t@, only keeping +-- the rows where the predicate is `True`. +filterRows :: (Frameable t) + => (Row t -> Bool) + -> Frame t + -> Frame t +filterRows f = fromRows + . Data.Vector.filter f + . toRows + + +-- | Zip two frames together using a combination function. +-- Rows from each frame are matched in order; the resulting +-- frame will only contain as many rows as the shortest of +-- the two input frames +zipRowsWith :: (Frameable t1, Frameable t2, Frameable t3) + => (Row t1 -> Row t2 -> Row t3) + -> Frame t1 + -> Frame t2 + -> Frame t3 +zipRowsWith f xs ys + = fromRows + $ Data.Vector.zipWith f + (toRows xs) + (toRows ys) + + +-- | Left-associative fold of a structure, with strict application of the operator. +foldlRows :: Frameable t + => (b -> Row t -> b) -- ^ Reduction function that takes in individual rows + -> b -- ^ Initial value for the accumulator + -> Frame t -- ^ Data frame + -> b +foldlRows f start + = Data.Vector.foldl' f start . toRows + + +-- | Access a row from a dataframe by its integer index. Indexing +-- starts at 0, representing the first row. +-- +-- If the index is larger than the number of rows, this function +-- returns `Nothing`. +-- +-- To access a specific row AND column, `iat` is much more efficient. +-- +-- To lookup a row based on a non-integer index, see `lookup`. +ilookup :: Frameable t + => Int + -> Frame t + -> Maybe (Row t) +ilookup = iindex + + +-- | Sort the rows of a frame using a custom comparison function. +-- +-- Use the function `on` from "Data.Function" to easily create +-- comparison functions. See the example below. +-- +-- If you wish to prune rows with duplicates, see `sortRowsByUnique`. +-- If your dataframe has an instance of `Indexable`, see `sortRowsByKey`. +-- +-- For example, let's say we want to sort +-- a dataframe of students by their first name: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- students = fromRows +-- [ MkStudent "Erika" 13 'D' +-- , MkStudent "Beatrice" 13 'B' +-- , MkStudent "David" 13 'A' +-- , MkStudent "Albert" 12 'C' +-- , MkStudent "Frank" 11 'C' +-- , MkStudent "Clara" 12 'A' +-- ] +-- :} +-- +-- >>> import Data.Function (on) +-- >>> putStrLn $ display $ sortRowsBy (compare `on` studentName) students +-- studentName | studentAge | studentMathGrade +-- ----------- | ---------- | ---------------- +-- "Albert" | 12 | 'C' +-- "Beatrice" | 13 | 'B' +-- "Clara" | 12 | 'A' +-- "David" | 13 | 'A' +-- "Erika" | 13 | 'D' +-- "Frank" | 11 | 'C' +-- +-- The underlying sorting algorithm is timsort (via +-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number +-- of comparisons used. +sortRowsBy :: Frameable t + => (Row t -> Row t -> Ordering) + -> Frame t + -> Frame t +sortRowsBy cmp df + = let rs = toRows df + in fromRows $ runST $ do + mutVec <- Data.Vector.thaw rs + TimSort.sortBy cmp mutVec + Data.Vector.freeze mutVec <&> Data.Vector.force +{-# INLINABLE sortRowsBy #-} + + +-- | Sort the rows of a frame using a custom comparison function. +-- +-- Use the function `on` from "Data.Function" to easily create +-- comparison functions. See the example below. +-- +-- If your dataframe has an instance of `Indexable`, see `sortRowsByKey`. +-- +-- For example, let's say we want to sort +-- a dataframe of students by their first name: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- students = fromRows +-- [ MkStudent "Erika" 13 'D' +-- , MkStudent "Beatrice" 13 'B' +-- , MkStudent "David" 13 'A' +-- , MkStudent "Albert" 12 'C' +-- , MkStudent "Frank" 11 'C' +-- , MkStudent "Clara" 12 'A' +-- ] +-- :} +-- +-- >>> import Data.Function (on) +-- >>> putStrLn $ display $ sortRowsBy (compare `on` studentName) students +-- studentName | studentAge | studentMathGrade +-- ----------- | ---------- | ---------------- +-- "Albert" | 12 | 'C' +-- "Beatrice" | 13 | 'B' +-- "Clara" | 12 | 'A' +-- "David" | 13 | 'A' +-- "Erika" | 13 | 'D' +-- "Frank" | 11 | 'C' +-- +-- The underlying sorting algorithm is timsort (via +-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number +-- of comparisons used. +sortRowsByUnique :: Frameable t + => (Row t -> Row t -> Ordering) + -> Frame t + -> Frame t +sortRowsByUnique cmp df + = let rs = toRows df + in fromRows $ runST $ do + mutVec <- Data.Vector.thaw rs + TimSort.sortUniqBy cmp mutVec >>= Data.Vector.freeze <&> Data.Vector.force +{-# INLINABLE sortRowsByUnique #-} + + +-- | Sort the rows of a frame using the index defined by +-- the `Indexable` typeclass. +-- +-- If your dataframe does not have an instance of `Indexable`, +-- see `sortRowsBy`. +-- +-- To prune rows with duplicate keys, see `sortRowsByKeyUnique`. +-- +-- For example: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- instance Indexable Student where +-- type Key Student = String +-- index = studentName +-- students = fromRows +-- [ MkStudent "Erika" 13 'D' +-- , MkStudent "Beatrice" 13 'B' +-- , MkStudent "David" 13 'A' +-- , MkStudent "Albert" 12 'C' +-- , MkStudent "Frank" 11 'C' +-- , MkStudent "Clara" 12 'A' +-- ] +-- :} +-- +-- >>> import Data.Function (on) +-- >>> putStrLn $ display $ sortRowsByKey students +-- studentName | studentAge | studentMathGrade +-- ----------- | ---------- | ---------------- +-- "Albert" | 12 | 'C' +-- "Beatrice" | 13 | 'B' +-- "Clara" | 12 | 'A' +-- "David" | 13 | 'A' +-- "Erika" | 13 | 'D' +-- "Frank" | 11 | 'C' +-- +-- The underlying sorting algorithm is timsort (via +-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number +-- of comparisons used. +sortRowsByKey :: (Indexable t) + => Frame t + -> Frame t +sortRowsByKey df = + -- I had trouble defining a method whereby one could either + -- build a vector of keys from a `Frame` (without converting to rows), + -- or extract a key from a single `Row`. See "NOTE: Indexable key and index" below + -- + -- Instead, we extract the index vector, sort it while keeping track + -- of the initial integer positions, and finally backpermuting. + let ix = Data.Vector.map swap + $ Data.Vector.indexed (index df) + -- TODO: is it possible to run `Data.Vector.map snd` + -- within the `ST` context? + sortedIx = Data.Vector.map snd $ runST $ do + mutVec <- Data.Vector.thaw ix + TimSort.sortBy (compare `on` fst) mutVec + + Data.Vector.freeze mutVec <&> Data.Vector.force + in fromRows $ Data.Vector.backpermute (toRows df) sortedIx -- sortRowsBy (compare `on` index) +{-# INLINABLE sortRowsByKey #-} + + +-- | Sort the rows of a frame using the index defined by +-- the `Indexable` typeclass, but prune rows with duplicate keys. +-- +-- The underlying sorting algorithm is timsort (via +-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number +-- of comparisons used. +sortRowsByKeyUnique :: (Indexable t) + => Frame t + -> Frame t +sortRowsByKeyUnique = sortRowsByKeyUniqueOn id + + +-- | Sort the rows of a frame by mapping the index defined by +-- the `Indexable` typeclass, to another key type @k@. +-- Also prune rows with duplicate keys. +-- +-- The underlying sorting algorithm is timsort (via +-- `Data.Vector.Algorithms.Tim.sortBy`), which minimizes the number +-- of comparisons used. +sortRowsByKeyUniqueOn :: (Ord k, Indexable t) + => (Key t -> k) + -> Frame t + -> Frame t +sortRowsByKeyUniqueOn mapkey df = + -- I had trouble defining a method whereby one could either + -- build a vector of keys from a `Frame` (without converting to rows), + -- or extract a key from a single `Row`. + -- + -- Instead, we extract the index vector, sort it while keeping track + -- of the initial integer positions, and finally backpermuting. + let ix = Data.Vector.map swap + $ Data.Vector.indexed (Data.Vector.map mapkey $ index df) + -- TODO: is it possible to run `Data.Vector.map snd` + -- within the `ST` context? + sortedIx = Data.Vector.map snd $ runST $ do + mutVec <- Data.Vector.thaw ix + TimSort.sortUniqBy (compare `on` fst) mutVec >>= Data.Vector.freeze <&> Data.Vector.force + in fromRows $ Data.Vector.backpermute (toRows df) sortedIx -- sortRowsBy (compare `on` index) +{-# INLINABLE sortRowsByKeyUniqueOn #-} + + +-- | Look up a row in a data frame by key. The specific key +-- is defined by the `Indexable` instance of type @t@. +-- +-- The first row whose index matches the supplied key is +-- returned. If no row has a matching key, returns `Nothing`. +-- +-- If you need to look up a particular row and column, +-- `at` is much more efficient. +-- +-- To lookup a row based on an integer index, see `ilookup`. +lookup :: (Indexable t) + => Key t + -> Frame t + -> Maybe (Row t) +lookup key fr + = Data.Vector.findIndex (==key) (index fr) + >>= flip ilookup fr + + +-- | Lookup an element of a frame by row and column. +-- +-- This is much more efficient than looking up an entire row +-- using `lookup`, and then selecting a specific field from a row. +-- +-- To lookup an element by integer row index instead, see `iat`. +at :: (Indexable t) + => Frame t + -> (Key t, Frame t -> Vector a) + -> Maybe a +fr `at` (row, col) + = Data.Vector.findIndex (==row) (index fr) + >>= \ix -> (col fr) Data.Vector.!? ix + + +-- | Lookup an element of the frame by row index and column +-- +-- This is much more efficient than looking up an entire row +-- using `ilookup`, and then selecting a specific field from a row. +-- +-- To lookup an element by row key instead, see `at`. +iat :: Frame t + -> (Int, Frame t -> Vector a) + -> Maybe a +fr `iat` (rowIx, col) = (col fr) Data.Vector.!? rowIx + + +-- | Merge two dataframes using a merging strategy, where the indexes +-- of the dataframes have the same type. See `mergeWithStrategyOn` +-- to merge dataframes with different indexes. +-- +-- A merging strategy handles the possibility of rows missing in the +-- left and/or right dataframes. Merge strategies can be user-defined, +-- or you can use predefined strategies (e.g. `matchedStrategy`). +-- +-- Note that (@`Key` t1 ~ `Key` t2@) means that the type of keys in +-- in both dataframes must be the same. +-- +-- In the example below, we have two dataframes: one containing +-- store names, and one containing addresses. Both dataframes +-- have use a unique identification number to relate their data +-- to specific stores. +-- +-- We want to build a summary of information about stores, +-- containing each store's name and address. +-- +-- >>> :{ +-- data Store f +-- = MkStore { storeId :: Column f Int +-- , storeName :: Column f String +-- } +-- deriving (Generic, Frameable) +-- instance Indexable Store where +-- type Key Store = Int +-- index = storeId +-- :} +-- +-- >>> :{ +-- data Address f +-- = MkAddress { addressStoreId :: Column f Int +-- , addressCivicNumber :: Column f Int +-- , addressStreetName :: Column f String +-- } +-- deriving (Generic, Frameable) +-- instance Show (Row Address) where +-- show (MkAddress _ civicNum streetName) = mconcat [show civicNum, " ", streetName] +-- instance Indexable Address where +-- type Key Address = Int +-- index = addressStoreId +-- :} +-- +-- >>> :{ +-- data StoreSummary f +-- = MkStoreSummary { storeSummaryName :: Column f String +-- , storeSummaryAddress :: Column f (Row Address) +-- } +-- deriving (Generic, Frameable) +-- deriving instance Show (Row StoreSummary) +-- :} +-- +-- >>> :{ +-- stores = fromRows +-- [ MkStore 1 "Maxi" +-- , MkStore 2 "Metro" +-- , MkStore 3 "Sobeys" +-- , MkStore 4 "Loblaws" +-- ] +-- :} +-- +-- >>> :{ +-- addresses = fromRows +-- [ MkAddress 1 1982 "14th Avenue" +-- , MkAddress 2 10 "Main Street" +-- , MkAddress 3 914 "Prima Street" +-- -- Missing address for store id 4 +-- , MkAddress 5 1600 "Cosgrove Lane" +-- ] +-- :} +-- +-- >>> :{ +-- putStrLn +-- $ display +-- $ mergeWithStrategy +-- (matchedStrategy (\_ store address -> MkStoreSummary (storeName store) address)) +-- stores +-- addresses +-- :} +-- storeSummaryName | storeSummaryAddress +-- ---------------- | ------------------- +-- "Maxi" | 1982 14th Avenue +-- "Metro" | 10 Main Street +-- "Sobeys" | 914 Prima Street +mergeWithStrategy :: ( Indexable t1, Indexable t2, Frameable t3 + , Key t1 ~ Key t2 + ) + => MergeStrategy (Key t1) t1 t2 t3 + -> Frame t1 + -> Frame t2 + -> Frame t3 +mergeWithStrategy = mergeWithStrategyOn id id + + +-- | Merge two dataframes using a merging strategy, where the indexes +-- of the dataframes are mapped to some key of type @k@. +-- +-- See `mergeWithStrategy` for further notes and examples. +mergeWithStrategyOn :: ( Ord k, Indexable t1, Indexable t2, Frameable t3) + => (Key t1 -> k) -- ^ How to map the index of the left dataframe onto a key of type @k@ + -> (Key t2 -> k) -- ^ How to map the index of the right dataframe onto a key of type @k@ + -> MergeStrategy k t1 t2 t3 + -> Frame t1 + -> Frame t2 + -> Frame t3 +mergeWithStrategyOn mapk1 mapk2 strat df1Unsorted df2Unsorted + = let df1 = sortRowsByKeyUniqueOn mapk1 df1Unsorted + df2 = sortRowsByKeyUniqueOn mapk2 df2Unsorted + ix1 = Data.Vector.map mapk1 $ index df1 + ix2 = Data.Vector.map mapk2 $ index df2 + -- Since df1 and df2 are sorted by key and their keys are unique, we + -- can safely use `Set.fromDistinctAscList`. + fullIx = (Set.fromDistinctAscList $ Data.Vector.toList ix1) + `Set.union` + (Set.fromDistinctAscList $ Data.Vector.toList ix2) + + fullLeft = reindex fullIx (Data.Vector.zip ix1 (toRows df1)) + fullRight = reindex fullIx (Data.Vector.zip ix2 (toRows df2)) + in fromRows $ Data.Vector.catMaybes + $ Data.Vector.zipWith (\t1 t2 -> uncurry strat (asThese t1 t2)) + fullLeft + fullRight + + where + asThese :: Eq k => (k, Maybe a) -> (k, Maybe b) -> (k, These a b) + asThese (k1, Just a) (k2, Nothing) = assert (k1==k2) (k1, This a) + asThese (k1, Nothing) (k2, Just b) = assert (k1==k2) (k1, That b) + asThese (k1, Just a) (k2, Just b) = assert (k1==k2) (k1, These a b) + -- The following line is unreachable since we know that the key `k` + -- will be present in at least one of the two rows. + asThese _ _ = error "impossible" + + reindex :: Ord k => Set.Set k -> Vector (k, Row t) -> Vector (k, Maybe (Row t)) + reindex fullix vs = Data.Vector.fromListN (Set.size fullix) + $ Data.Foldable.toList + $ go Empty + (Seq.fromList $ Set.toAscList fullix) + (Seq.fromList $ Data.Vector.toList vs) + where + -- We use `Seq` for the O(1) append + -- Note that this function REQUIRES the rows to be sorted in + -- ascending values of their key + go :: Ord k + => Seq (k, Maybe (Row t)) -- Accumulator + -> Seq k -- Full index + -> Seq (k, Row t) -- Rows + -> Seq (k, Maybe (Row t)) + go acc Empty _ = acc + go acc keys Empty = acc Seq.>< fmap (, Nothing) keys + go acc (k:<|ks) queue@((rk, row):<|rs) = case k `compare` rk of + EQ -> go (acc Seq.|> (k, Just row)) ks rs + LT -> go (acc Seq.|> (k, Nothing)) ks queue + -- Since the full index includes all keys, it's not possible + -- the following case + GT -> error "impossible" + + +-- | A merge strategy is a function that describes how to +-- merge two rows together. +-- +-- A merge strategy must handle three cases: +-- +-- * Only the left row (v`This`); +-- * Only the right row (v`That`); +-- * Both the left and right rows (v`These`). +-- +-- The simplest merge strategy is `matchedStrategy`. +-- +-- See examples in the documentation of `mergeWithStrategy`. +type MergeStrategy k t1 t2 t3 + = (k -> These (Row t1) (Row t2) -> Maybe (Row t3)) + + +-- | Merge strategy which only works if both the left and right +-- rows are found. +-- +-- If you are familiar with relational databases, `matchedStrategy` +-- is an inner join. +matchedStrategy :: (k -> Row t1 -> Row t2 -> Row t3) + -> MergeStrategy k t1 t2 t3 +matchedStrategy f k (These r1 r2) = Just $ f k r1 r2 +matchedStrategy _ _ _ = Nothing + + +-- | Type family which allows for higher-kinded record types +-- in two forms: +-- +-- * Single record type using t`Identity`, where @`Column` Identity a ~ a@ ; +-- * Record type whose elements are some other functor (usually `Vector`). +-- +-- Types are created like regular record types, but each element +-- must have the type @`Column` f a@ instead of @a@. For example: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- :} +type family Column (f :: Type -> Type) x where + Column Identity x = x + Column f x = f x + +-- | Type synonym for a record type with scalar elements +type Row (dt :: (Type -> Type) -> Type) = dt Identity + +-- | Type synonym for a record type whose elements are arrays (columns) +type Frame (dt :: (Type -> Type) -> Type) = dt Vector + + +-- | Typeclass to generically derive the function `fromRows`. +class GFromRows tI tV where + gfromRows :: Vector (tI a) -> (tV a) + +instance GFromRows (Rec0 a) (Rec0 (Vector a)) where + gfromRows = K1 . Data.Vector.map unK1 + {-# INLINEABLE gfromRows #-} + +instance (GFromRows tI1 tV1, GFromRows tI2 tV2) + => GFromRows (tI1 :*: tI2) (tV1 :*: tV2) where + gfromRows vs = let (xs, ys) = Data.Vector.unzip $ Data.Vector.map (\(x :*: y) -> (x, y)) vs + in gfromRows xs :*: gfromRows ys + {-# INLINEABLE gfromRows #-} + +instance GFromRows tI tV => GFromRows (M1 i c tI) (M1 i c tV) where + gfromRows vs = M1 (gfromRows (Data.Vector.map unM1 vs)) + {-# INLINEABLE gfromRows #-} + + +-- | Typeclass to generically derive the function `toRows`. +class GToRows tI tV where + gtoRows :: tV a -> Vector (tI a) + +instance GToRows (Rec0 a) (Rec0 (Vector a)) where + gtoRows = Data.Vector.map K1 . unK1 + {-# INLINEABLE gtoRows #-} + +instance (GToRows tI1 tV1, GToRows tI2 tV2) + => GToRows (tI1 :*: tI2) (tV1 :*: tV2) where + gtoRows (xs :*: ys) = Data.Vector.zipWith (:*:) (gtoRows xs) (gtoRows ys) + {-# INLINEABLE gtoRows #-} + +instance (GToRows tI tV) => GToRows (M1 i c tI) (M1 i c tV) where + -- gtoRows :: M1 i c tV a -> Vector (M1 i c tI a) + gtoRows = Data.Vector.map M1 . gtoRows . unM1 + {-# INLINEABLE gtoRows #-} + +class GILookup tI tV where + gilookup :: Int -> tV a -> Maybe (tI a) + +instance GILookup (Rec0 a) (Rec0 (Vector a)) where + gilookup ix vs = K1 <$> (unK1 vs) Data.Vector.!? ix + +instance (GILookup tI1 tV1, GILookup tI2 tV2) + => GILookup (tI1 :*: tI2) (tV1 :*: tV2) where + gilookup ix (xs :*: ys) + = (:*:) + <$> (gilookup ix xs) + <*> (gilookup ix ys) + +instance (GILookup tI tV) => GILookup (M1 i c tI) (M1 i c tV) where + gilookup ix = fmap M1 . gilookup ix . unM1 + + +class GFields r where + gfields :: r a -> [(String, String)] + +instance GFields r => GFields (M1 D x r) where + gfields = gfields . unM1 + +instance GFields t => GFields (M1 C x t) where + gfields = gfields . unM1 + +instance (Show r, Selector s) => GFields (M1 S s (Rec0 r)) where + gfields (M1 (K1 r)) = [(selName (undefined :: M1 S s (Rec0 r) ()), show r)] + +instance (GFields f, GFields g) => GFields (f :*: g) where + gfields (x :*: y) = gfields x ++ gfields y + +-- | Typeclass that endows any record type @t@ with the ability to be packaged +-- as a dataframe. +-- +-- Under no circumstances should you write instances for `Frameable`; instead, +-- simply derive an instance of `Generic` for @t@. For example: +-- +-- >>> :set -XDeriveAnyClass +-- >>> :{ +-- data Store f +-- = MkStore { storeName :: Column f String +-- , storeId :: Column f Int +-- , storeAddress :: Column f String +-- } +-- deriving (Generic, Frameable) +-- :} +class Frameable t where + + -- | Package single rows of type @t@ into a @`Frame` t@. + pack :: Vector (Row t) -> Frame t + + default pack :: ( Generic (Row t) + , Generic (Frame t) + , GFromRows (Rep (Row t)) (Rep (Frame t)) + ) + => Vector (Row t) + -> Frame t + pack = to . gfromRows . Data.Vector.map from + {-# INLINABLE pack #-} + + -- | Unpack a dataframe into rows + unpack :: Frame t -> Vector (Row t) + + default unpack :: ( Generic (Row t) + , Generic (Frame t) + , GToRows (Rep (Row t)) (Rep (Frame t)) + ) + => Frame t + -> Vector (Row t) + unpack = Data.Vector.map to . gtoRows . from + {-# INLINABLE unpack #-} + + + -- | Look up a row from the frame by integer index + iindex :: Int -> Frame t -> Maybe (Row t) + + default iindex :: ( Generic (Frame t) + , Generic (Row t) + , GILookup (Rep (Row t)) (Rep (Frame t)) + ) + => Int + -> Frame t + -> Maybe (Row t) + iindex ix = fmap to . gilookup ix . from + + -- | Return the field names associated with a row or frame. + -- This is useful to display frames via `display`. + fields :: Row t -> [(String, String)] + + default fields :: ( Generic (Row t) + , GFields (Rep (Row t)) + ) + => Row t + -> [(String, String)] + fields = gfields . from + + +-- | Typeclass for dataframes with an index, a column or set of columns that can +-- be used to search through rows. +-- +-- An index need not be unique, but the type of its keys must be an instance of `Eq`. +class ( Frameable t + , Eq (Key t) -- Effectively required for lookups + , Ord (Key t) -- Effectively required for joins + ) => Indexable t where + + -- | A type representing a lookup key for a dataframe. + -- This can be a single field, or a compound key composed + -- of multiple fields + type Key t + + -- | How to create an index from a frame (@`Frame` t@). + -- This is generally done by using record selectors. + index :: Frame t -> Vector (Key t) + +{- NOTE: Indexable key and index + +Ideally, the `Indexable` class provides two methods: + +* key :: Row t -> Key t +* index :: Frame t -> Vector (Key t) + +However, asking users to implement both methods is redundant and +could lead to errors, since both methods must be coherent +with each other. Consider the following example: + +@ +data Person f + = MkPerson { firstName :: Column f String + , lastName :: Column f String + } + deriving (Generic, Frameable) + +instance Indexable Person where + type Key Person = String + key = firstName + index = lastName -- oops +@ + +We could instead use the `key` function to build the `index`, but this requires +converting a `Frame t` to rows, which is wasteful: + +class Indexable t where + type Key t + + key :: Row t -> Key t + + index :: Frame t -> Vector (Key t) + index = Data.Vector.fromList . map key . toRows + +Ideally, we would have a single method in the `Indexable` class: + +@ +class Indexable t where + type Key t + + index :: t f -> Column f (Key t) +@ + +which would work for both f=t`Identity` and f=`Vector`. This actually works +for simple record selectors, e.g.: + +@ +instance Indexable Person where + type Key Person = String + index :: Person f -> Column f (Key Person) + index = firstName +@ + +The problem arises with compound keys. How would you write this? + +@ +instance Indexable Person where + type Key Person = (String, String) + index :: Person f -> Column f (Key Person) + -- Implementation for `Row t`: + index row = (,) <$> firstName row <*> lastName row + -- implementation for `Frame t`: + index frame = Data.Vector.zipWith (,) (firstName frame) (lastName frame) +@ + +We can unify the signature of `index` in this case with: + +@ + index x = compound (firstName x, lastName x) + where + compound :: ( Person f -> Column f a + , Person f -> Column f b + ) + -> Person f + -> Column f (a, b) +@ + +We can create a typeclass to do this (and implement instances for f=t`Identity` +and f=`Vector`): + +@ +class Compound f where + compound :: ( Person f -> Column f a + , Person f -> Column f b + ) + -> Person f + -> Column f (a, b) + +instance Compound Identity where + compound (f, g) x = (f x, g x) + +instance Compound Vector where + compound (f, g) x = Data.Vector.zipWith (,) (f x) (g x) +@ + +Unfortunately, even with AllowAmbiguousTypes, I haven't been able to write +an instance where type inference worked, e.g.: + +@ +instance Indexable Person where + type Key Person = (String, String) + + index :: Compound f => Person f -> Column f (Key Person) + index = compound (firstName, lastName) +@ + +-} + + +-- | Control how `displayWith` behaves. +data DisplayOptions t + = DisplayOptions + { maximumNumberOfRows :: Int + -- ^ Maximum number of rows shown. These rows will be distributed evenly + -- between the start of the frame and the end + , rowDisplayFunction :: Row t -> [(String, String)] + -- ^ Function used to display rows from the frame. This should be a map from + -- record name to value. + } + + +-- | Default @`Frame` t@ display options. +defaultDisplayOptions :: Frameable t => DisplayOptions t +defaultDisplayOptions + = DisplayOptions { maximumNumberOfRows = 6 + , rowDisplayFunction = fields + } + + +-- | Display a @`Frame` t@ using default t'DisplayOptions'. +-- +-- Although this is up to you, we strongly recommend that the `Show` +-- instance for @`Frame` t@ be: +-- +-- @ +-- instance Show (Frame t) where show = display +-- @ +-- +-- Example: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- :} +-- +-- >>> students = fromRows $ Vector.fromList [MkStudent "Albert" 12 'C', MkStudent "Beatrice" 13 'B', MkStudent "Clara" 12 'A'] +-- >>> putStrLn (display students) +-- studentName | studentAge | studentMathGrade +-- ----------- | ---------- | ---------------- +-- "Albert" | 12 | 'C' +-- "Beatrice" | 13 | 'B' +-- "Clara" | 12 | 'A' +display :: Frameable t + => Frame t + -> String +display = displayWith defaultDisplayOptions + + +-- | Display a @`Frame` t@ using custom t'DisplayOptions'. +-- +-- Example: +-- +-- >>> :{ +-- data Student f +-- = MkStudent { studentName :: Column f String +-- , studentAge :: Column f Int +-- , studentMathGrade :: Column f Char +-- } +-- deriving (Generic, Frameable) +-- :} +-- +-- >>> :{ +-- students = fromRows +-- $ Vector.fromList +-- [ MkStudent "Albert" 12 'C' +-- , MkStudent "Beatrice" 13 'B' +-- , MkStudent "Clara" 12 'A' +-- , MkStudent "David" 13 'A' +-- , MkStudent "Erika" 13 'D' +-- , MkStudent "Frank" 11 'C' +-- ] +-- :} +-- +-- >>> putStrLn (displayWith (defaultDisplayOptions{maximumNumberOfRows=2}) students) +-- studentName | studentAge | studentMathGrade +-- ----------- | ---------- | ---------------- +-- "Albert" | 12 | 'C' +-- ... | ... | ... +-- "Frank" | 11 | 'C' +displayWith :: (Frameable t) + => DisplayOptions t + -> Frame t + -> String +displayWith DisplayOptions{..} df + = if null df + then "<Empty dataframe>" -- TODO: it IS possible to determine the record names + -- without having any rows, but it requires + -- an additional generic typeclass + else formatGrid rows + + where + len = length df + n = max 1 (maximumNumberOfRows `div` 2) + -- We prevent overlap between the 'head' rows and 'tail' rows + -- by favoring removing duplicate integer indices from the tail rows + headIxs = Set.fromList [0 .. n - 1] + tailIxs = Set.fromList [len - n ..len] `Set.difference` headIxs + headRows = catMaybes [ilookup i df | i <- Set.toList headIxs] + tailRows = catMaybes [ilookup j df | j <- Set.toList tailIxs] + + firstRow = case headRows of + [] -> error "Impossible!" -- We already checked that `df` won't be empty + [xs] -> xs + (xs:_) -> xs + + spacerRow = + if len > maximumNumberOfRows + then [(map (second (const "...")) (fields firstRow))] + else mempty + rows = (fields <$> headRows) ++ spacerRow ++ (fields <$> tailRows) + + (headerLengths :: [(String, Int)]) = (map (\(k, _) -> (k, Prelude.length k)) (fields firstRow)) + (colWidths :: [(String, Int)]) + = map (second getMax) + $ List.foldl' + (\acc mp -> zipWith (\(k1, v1) (k2, v2) -> ((assert (k1 == k2) k1, v1 <> v2))) acc (map (second (Max . Prelude.length)) mp)) + (map (second Max) headerLengths) + rows + + -- | Format a grid represented by a list of rows, where every row is a list of items + -- All columns will have a fixed width + formatGrid :: [ [(String, String)]] -- List of rows + -> String + formatGrid rs = mconcat $ List.intersperse "\n" + $ [ mconcat $ List.intersperse " | " [ (pad w k) | (k, w) <- colWidths]] + ++ [ mconcat $ List.intersperse " | " [ (pad w (replicate w '-')) | (_, w) <- colWidths]] + ++ [ mconcat $ List.intersperse " | " [ (pad w v) + | ((_, v), (_, w)) <- zip mp colWidths + ] + | mp <- rs + ] + where + -- | Pad a string to a minimum of @n@ characters wide. + pad :: Int -> String -> String + pad minNumChars s + | minNumChars <= Prelude.length s = s + | otherwise = replicate (minNumChars - Prelude.length s) ' ' <> s
+ src/Data/Frame/Tutorial.hs view
@@ -0,0 +1,651 @@+{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +-- | +-- Module : $header +-- Copyright : (c) Laurent P. René de Cotret +-- License : MIT +-- Maintainer : laurent.decotret@outlook.com +-- Portability : portable +-- +module Data.Frame.Tutorial ( + -- * Introduction + -- $introduction + + -- * Quick start + -- $quickstart + + -- * Defining types + -- $construction + + -- * Advanced indexing + -- $advindexing + + -- * Merging dataframes + -- ** Zipping + -- $zipping + + -- ** Merging by key + -- $merging + +) where + +import Data.Frame as Frame +import Data.Functor.Identity (Identity) +import qualified Data.List (zipWith) +import Data.Vector (Vector) +import qualified Data.Vector as Vector +import GHC.Generics (Generic) + +{- $introduction + +This is a short user guide on how to get started using @javelin-frames@. + +The central data structure at the heart of this package is the dataframe. +A dataframe, represented by @`Frame` t@ for some record-type @t@, is a +record whose values are arrays representing columns. + +-} + +{- $quickstart +Let's look at a real example. We'll import the "Data.Frame" module to disambiguate +some functions: + +>>> import Data.Frame as Frame + +and we need extensions to derive instances automatically: + +>>> :set -XDeriveGeneric +>>> :set -XDeriveAnyClass + +We define + +>>> :{ + data Student f + = MkStudent { studentName :: Column f String + , studentAge :: Column f Int + , studentMathGrade :: Column f Char + } + deriving (Generic) + deriving instance Frameable Student + -- We need to derive other instances (Show, Eq, ...) + -- separately + deriving instance Show (Row Student) +:} + +It is key to derive the instance of @`Frameable` Student@, which unlocks +almost all of the functionality of this package. + +We use `fromRows` to pack individual students into a dataframe: + +>>> :{ + students = fromRows + [ MkStudent "Albert" 12 'C' + , MkStudent "Beatrice" 13 'B' + , MkStudent "Clara" 12 'A' + ] + :} + +We can render the dataframe @students@ into a nice string using `display` +(and print that string using using `putStrLn`): + +>>> putStrLn (display students) +studentName | studentAge | studentMathGrade +----------- | ---------- | ---------------- + "Albert" | 12 | 'C' + "Beatrice" | 13 | 'B' + "Clara" | 12 | 'A' + +== Operations on columns + +A dataframe is a columnar data structure; operations on columns are very efficient. + +We can query for a column using a field selector, just like a normal record: + +>>> studentName students +["Albert","Beatrice","Clara"] + +Although the notation suggests that this is a list, columns are really `Vector`: + +>>> :t (studentName students) +(studentName students) :: Vector [Char] + +This means that you can use the efficient operations provided by the "Data.Vector" +module to operate on columns. + +== Operations on rows + +Many operations that treat a dataframe as an array +of rows are provided. + +There's `mapRows` to map each row to a new structure: + +>>> :{ + putStrLn + $ display + $ mapRows + (\(MkStudent name age grade) -> MkStudent name (2*age) grade) + students +:} +studentName | studentAge | studentMathGrade +----------- | ---------- | ---------------- + "Albert" | 24 | 'C' + "Beatrice" | 26 | 'B' + "Clara" | 24 | 'A' + +There's `filterRows` to keep specific rows: + +>>> :{ + putStrLn + $ display + $ filterRows + (\(MkStudent _ _ grade) -> grade < 'C') + students +:} +studentName | studentAge | studentMathGrade +----------- | ---------- | ---------------- + "Beatrice" | 13 | 'B' + "Clara" | 12 | 'A' + +Finally, there's `foldlRows` to summarize a dataframe by using whole rows: + +>>> import Data.Char (ord) +>>> :{ + foldlRows + (\acc (MkStudent _ age grade) -> acc + age + ord grade) + (0 :: Int) + students +:} +235 + +== Lookups + +Since dataframes are highly structured, we can efficiently query +them in two flavours: querying by integer index, and querying by key. + +=== Querying by integer index + +Querying by integer index is supported for all dataframes. Use +the `ilookup` function to retrive a row: + +>>> ilookup 0 students +Just (MkStudent {studentName = "Albert", studentAge = 12, studentMathGrade = 'C'}) +>>> ilookup 2 students +Just (MkStudent {studentName = "Clara", studentAge = 12, studentMathGrade = 'A'}) +>>> ilookup 1000 students +Nothing + +If we need the specific field of a specific row, it is much more efficient +to use `iat`: + +>>> students `iat` (1, studentMathGrade) +Just 'B' + +=== Querying by key + +Querying by integer index may not be natural, and could be error-prone. +We can specify a column (or set of columns) that represent our +dataframe index. Just like a database table, an index speeds up +the lookup of a dataframe by key. + +To do this, we must write an instance of `Indexable` for our type @Student@, +where we want to be able to efficiently search by student name: + +>>> :set -XTypeFamilies +>>> :{ + instance Indexable Student where + type Key Student = String + index = studentName +:} + +Now, we can use the functions `Frame.lookup` and `at` (similar to `ilookup` +and `iat`, respectively) which take key (in our case, student names) +instead of integer indices. + +>>> Frame.lookup "Beatrice" students +Just (MkStudent {studentName = "Beatrice", studentAge = 13, studentMathGrade = 'B'}) + +>>> Frame.lookup "Vivienne" students +Nothing + +>>> students `at` ("Albert", studentAge) +Just 12 + +And there you have it! This was a quick tour. Read on to learn more details +and more advanced functionality. +-} + +{- $construction + +To start using the machinery of this package, one must define the appropriate type. +Types that can be turned into dataframes are non-empty, higher-kinded record types. +In particular, every field must make use of the `Column` type family. + +Let's look at an example: + +>>> newtype Address = MkAddress String deriving (Show, Eq) +>>> data Merchandise = Clothes | Food | Cars deriving (Show, Eq) +>>> :{ + data Store f + = MkStore { storeName :: Column f String + , storeAddress :: Column f Address + , storeId :: Column f Int + , storeMerchandise :: Column f Merchandise + } + deriving (Generic) +:} + +Here, we define a higher-kinded record type @Store@ with four fields. +The type parameter @f@ allows the various functions in this package +to switch between a column-oriented format and single-rows. + +In practice the type @f@ can only be `Identity` (for a single row), +or `Vector` (for a dataframe) + +For ergonomics, the type synonym @`Row` t@ is provided to represent a +single row. The type synonym @`Frame` t@ is provided to represent +a dataframe. + +One caveat of this design is that instances (e.g. for `Show` or `Eq`) +must be defined in separate expressions: + +>>> deriving instance Show (Row Store) +>>> deriving instance Eq (Row Store) + +Let's consider a single @Store@: + +>>> (MkStore "Maxi" (MkAddress "17 Delicious Av.") 1 Food) :: Row Store +MkStore {storeName = "Maxi", storeAddress = MkAddress "17 Delicious Av.", storeId = 1, storeMerchandise = Food} + +so @`Row` Store@ is exactly what we would expect from Haskell's regular +record types. + +In order to access dataframe functionality, we need to ask our code +to generate some boilerplate automatically. We do this by deriving an +instance of `Frameable`: + +>>> :set -XDeriveAnyClass +>>> deriving instance Frameable Store + +Note that deriving an instance of `Frameable` requires that our type @Store@ have +a `Generic` instance. This allows @javelin-frames@ to inspect our type @Store@ +and write an implementation of `Frameable` automatically. + +** Limitations + +At this time, `Frameable` can only be derived for higher-kinded record types that +do NOT nest. For example, consider the following hierarchy: + +>>> :{ + data Location f + = MkLocation { longitude :: Column f Double + , latitude :: Column f Double + , elevation :: Column f Double + } + deriving (Generic, Frameable) + data Company f + = MkCompany { companyName :: Column f String + , companyId :: Column f Int + , companyAddress :: Location f -- Nesting happens here + } + deriving (Generic) +:} + +The following will unfortunately fail with a potentially confusing type error: + +@ +deriving instance Frameable Company +@ + +Are you an expert in generics who wants to help us figure it out? Feel free to +[raise an issue or open a pull request](https://github.com/LaurentRDC/javelin). +-} + +{- $advindexing + +For some record type @t@ with an instance of `Frameable`, we can query for specific +rows and elements using `ilookup` and `iat` respectively. + +However, many types can naturally be indexed by a subset of the columns, which becomes a key +This key is similar to primary keys in databases. + +We can derive an instance of `Indexable` to allow us to query data from a +dataframe not by the integer index of the rows, but by some key instead. + +** Simple keys + +The simplest example is that of keys derived from a single column. + +We start with a data definition: + +>>> :{ + newtype Address = Addr String deriving (Show) + data Store f + = MkStore { storeName :: Column f String + , storeAddress :: Column f Address + , storeId :: Column f Int + } + deriving (Generic, Frameable) + deriving instance Show (Row Store) +:} + +In this example, we assume that the @storeId@ column is unique. We will +therefore use it as a key. All we need to do is derive an instance of `Indexable`: + +>>> :set -XTypeFamilies +>>> :{ + instance Indexable Store where + type Key Store = Int + index = storeId +:} + +As an example, let's build a dataframe of stores: + +>>> :{ + stores = fromRows + [ MkStore "Store A" (Addr "8712 1st Avenue") 787123745 + , MkStore "Store B" (Addr "90 2st Street") 188712313 + , MkStore "Store C" (Addr "109 3rd Street") 910823870 + ] +:} + +Finally, we can look up @Store A@ by its unique ID using `Frame.lookup`: + +>>> Frame.lookup 787123745 stores +Just (MkStore {storeName = "Store A", storeAddress = Addr "8712 1st Avenue", storeId = 787123745}) + +** Compound keys + +Sometimes, it is preferable to identify rows through multiple columns. Again in +in analogy with databases, the key is a _compound key_. + +Let's consider another example, that of movie actors: + +>>> :{ + data Actor f + = MkActor { actorFirstName :: Column f String + , actorLastName :: Column f String + , actorAge :: Column f Int + } + deriving (Generic, Frameable) + deriving instance Show (Row Actor) +:} + +In this case, we can identify actors by their first and last name, +which creates a compound key: + +>>> :{ + instance Indexable Actor where + type Key Actor = (String, String) + index :: Frame Actor -> Vector (Key Actor) + index df = Vector.zipWith (,) (actorFirstName df) (actorLastName df) +:} + +We define some data + +>>> :{ + actors = fromRows + [ MkActor "George" "Clooney" 63 + , MkActor "Brad" "Pitt" 61 + , MkActor "George" "Takei" 87 + ] +:} + +Finally, we can look up George Clooney's age using `at`: + +>>> actors `at` ( ("George", "Clooney"), actorAge ) +Just 63 + +-} + +{- $zipping + +The simplest way to combine dataframes is analogous to the `Data.List.zipWith` operation +for lists: two dataframes can be combined row-by-row, in order, using `zipRowsWith`. + +Here is an example: + +>>> data Race = Cat | Dog deriving Show +>>> :{ + data Pet f + = MkPet { petName :: Column f String + , petAge :: Column f Int + } + deriving (Generic, Frameable) + pets = fromRows + [ MkPet "Milo" 10 + , MkPet "Litchi" 4 + , MkPet "Piccolo" 15 + , MkPet "Cloud" 3 + ] +:} + +>>> :{ + data PetInfo f + = MkPetInfo { petInfoName :: Column f String + , petInfoRace :: Column f Race + } + deriving (Generic, Frameable) + petInfos = fromRows + [ MkPetInfo "Milo" Cat + , MkPetInfo "Cloud" Cat + , MkPetInfo "Piccolo" Dog + , MkPetInfo "Litchi" Dog + ] +:} + +>>> :{ + data PetSummary f + = MkPetSummary { petSummaryName :: Column f String + , petSummaryAge :: Column f Int + , petSummaryRace :: Column f Race + } + deriving (Generic, Frameable) + deriving instance Show (Row PetSummary) +:} + +>>> :{ + putStrLn + $ display + $ zipRowsWith + (\(MkPet name age) (MkPetInfo _ race) -> MkPetSummary name age race) + pets + petInfos +:} +petSummaryName | petSummaryAge | petSummaryRace +-------------- | ------------- | -------------- + "Milo" | 10 | Cat + "Litchi" | 4 | Cat + "Piccolo" | 15 | Dog + "Cloud" | 3 | Dog + + +Hmm this doesn't look right, if you manually inspect the two source dataframes. +This is because rows are combined in order. You may want to sort rows using +`sortRowsBy` or `sortRowsByUnique`, before applying `zipRowsWith`: + +>>> import Data.Function (on) +>>> :{ + putStrLn + $ display + $ zipRowsWith + (\(MkPet name age) (MkPetInfo _ race) -> MkPetSummary name age race) + (sortRowsBy (compare `on` petName) pets) + (sortRowsBy (compare `on` petInfoName) petInfos) +:} +petSummaryName | petSummaryAge | petSummaryRace +-------------- | ------------- | -------------- + "Cloud" | 3 | Cat + "Litchi" | 4 | Dog + "Milo" | 10 | Cat + "Piccolo" | 15 | Dog + +There is a more robust way to merge dataframes, if each dataframe has a natural +key (in the case above, pet names). See below. +-} + +{- $merging + +If you want to merge dataframes whose rows have a natural key (i.e. have an instance of `Indexable`), +then you should take a look at `mergeWithStrategy`. +In this function, for each key present in __either__ dataframe, +a merging strategy is applied. This strategy encodes how the merge should proceed in three cases: + +* The key is present in the left dataframe, but not the right; +* The key is present in the right dataframe, but not the left; +* The key is present in both dataframes. + +Let's see how to make use of this functionality by combining the information +about containers being shipped. Unfortunately, the data is spotty, so +we will need to make decisions about missing data. + +>>> :{ + data ContainerOrigin f + = MkContainerOrigin { containerOriginId :: Column f Int + , containerOriginCountry :: Column f String + } + deriving (Generic, Frameable) + instance Indexable ContainerOrigin where + type Key ContainerOrigin = Int + index = containerOriginId + containerOrigins = fromRows + [ MkContainerOrigin 1 "Canada" + , MkContainerOrigin 2 "Mexico" + -- missing container origin for container #3 + , MkContainerOrigin 4 "Poland" + , MkContainerOrigin 5 "N/A" -- bad data + ] +:} + +>>> :{ + data ContainerDest f -- Container destination + = MkContainerDest { containerDestId :: Column f Int + , containerDestCountry :: Column f String + } + deriving (Generic, Frameable) + instance Indexable ContainerDest where + type Key ContainerDest = Int + index = containerDestId + containerDests = fromRows + [ MkContainerDest 1 "Japan" + , MkContainerDest 2 "Canada" + , MkContainerDest 3 "USA" + -- missing container destination for #4 + , MkContainerDest 5 "France" + ] +:} + +We will first start by merging the dataframes only when we have complete data +(i.e. an inner join). We first define the shape of the resulting dataframe: + +>>> :{ + data ContainerJourney f + = MkContainerJourney { containerJourneyId :: Column f Int + , containerJourneyOrig :: Column f String + , containerJourneyDest :: Column f String + } + deriving (Generic, Frameable) + deriving instance Show (Row ContainerJourney) +:} + +and define our merging strategy. The three row-wise merge cases are handled by the constructor +t`These`, namely the constructors: + +* v`This`: The key is present in the left dataframe, but not the right; +* v`That`: The key is present in the right dataframe, but not the left; +* v`These`: The key is present in both dataframes (not to be confused with the type constructor t`These`). + +In the simplest case, we only care about keys present in both dataframe (v`These`) +>>> :{ + completeDataStrategy :: Int -> These (Row ContainerOrigin) (Row ContainerDest) -> Maybe (Row ContainerJourney) + completeDataStrategy containerId (These (MkContainerOrigin _ origin) (MkContainerDest _ dest)) + = Just $ MkContainerJourney containerId origin dest + completeDataStrategy _ _ = Nothing -- not enough data +:} + +Sidenote: @completeDataStrategy@ is equivalent to `matchedStrategy`. We re-defined it for illustrative purposes. +>>> :{ + putStrLn + $ display + $ mergeWithStrategy + completeDataStrategy + containerOrigins + containerDests +:} +containerJourneyId | containerJourneyOrig | containerJourneyDest +------------------ | -------------------- | -------------------- + 1 | "Canada" | "Japan" + 2 | "Mexico" | "Canada" + 5 | "N/A" | "France" + +As expected, we do not have enough information to reconstruct the journey for container 3 (no known origin) +and container 4 (no known destination). +However, container 5's origin isn't valid data. We can further tweak the merge strategy to take this into account. + +We crudely define what is a valid country name: + +>>> validCountry name = not (name == "N/A") + +and we can now define a new merging strategy. Returning a `Nothing` result from a merging strategy +effectively cancels the merge: + +>>> :{ + completeDataStrategy' :: Int -> These (Row ContainerOrigin) (Row ContainerDest) -> Maybe (Row ContainerJourney) + completeDataStrategy' containerId (These (MkContainerOrigin _ origin) (MkContainerDest _ dest)) + | validCountry origin && validCountry dest = Just $ MkContainerJourney containerId origin dest + | otherwise = Nothing + completeDataStrategy' _ _ = Nothing -- not enough data +:} + +>>> :{ + putStrLn + $ display + $ mergeWithStrategy + completeDataStrategy' + containerOrigins + containerDests +:} +containerJourneyId | containerJourneyOrig | containerJourneyDest +------------------ | -------------------- | -------------------- + 1 | "Canada" | "Japan" + 2 | "Mexico" | "Canada" + +What if we can tolerate some missing data? Here, we only care where the container is going, but not +necessarily its origin. Let's redefine our resulting dataframe to take this into account: + +>>> :{ + data PartialContainerJourney f + = MkPartialContainerJourney { partialContainerJourneyId :: Column f Int + , partialContainerJourneyOrig :: Column f (Maybe String) + , partialContainerJourneyDest :: Column f String + } + deriving (Generic, Frameable) + deriving instance Show (Row PartialContainerJourney) +:} + +>>> :{ + maybeOriginStrategy :: Int -> These (Row ContainerOrigin) (Row ContainerDest) -> Maybe (Row PartialContainerJourney) + maybeOriginStrategy containerId (These (MkContainerOrigin _ origin) (MkContainerDest _ dest)) + | validCountry origin && validCountry dest = Just $ MkPartialContainerJourney containerId (Just origin) dest + | validCountry dest = Just $ MkPartialContainerJourney containerId Nothing dest + | otherwise = Nothing + maybeOriginStrategy containerId (That (MkContainerDest _ dest)) + = Just $ MkPartialContainerJourney containerId Nothing dest + maybeOriginStrategy _ (This _) = Nothing -- we require a destination +:} + +>>> :{ + putStrLn + $ display + $ mergeWithStrategy + maybeOriginStrategy + containerOrigins + containerDests +:} +partialContainerJourneyId | partialContainerJourneyOrig | partialContainerJourneyDest +------------------------- | --------------------------- | --------------------------- + 1 | Just "Canada" | "Japan" + 2 | Just "Mexico" | "Canada" + 3 | Nothing | "USA" + 5 | Nothing | "France" +-}
+ test/Main.hs view
@@ -0,0 +1,11 @@+module Main (main) where + +import qualified Test.Data.Frame + +import Test.Tasty ( defaultMain, testGroup ) + +main :: IO () +main = defaultMain + $ testGroup "Test suite" + [ Test.Data.Frame.tests + ]
+ test/Test/Data/Frame.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +module Test.Data.Frame (tests) where + +import Control.Monad (guard, forM_) + +import Data.Frame as Frame hiding (length) +import Data.Function (on) +import qualified Data.List as List (intersperse) +import qualified Data.Set as Set +import qualified Data.Vector as Vector + +import GHC.Generics (Generic) + +import Hedgehog ( property, forAll, (===), assert ) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +import Test.Tasty ( testGroup, TestTree ) +import Test.Tasty.Hedgehog ( testProperty ) +import Test.Tasty.HUnit ( testCase, assertEqual ) + +tests :: TestTree +tests = testGroup "Data.Frame" [ testToFromRowsTripping + , testLookup + , testFields + , testSortRowsBy + , testSortRowsByKey + , testMergeWithStrategy + , testDisplay + ] + +data User f + -- Note that the fields are NOT ordered alphabetically, + -- which is important for the display test cases. + -- We want to present dataframes as the user intended it. + = MkUser { userName :: Column f String + , userAge :: Column f Int + } + deriving (Generic) + + +instance Frameable User +deriving instance Show (Row User) +instance Show (Frame User) where show = Frame.display +deriving instance Eq (Row User) +deriving instance Eq (Frame User) + +instance Indexable User where + type Key User = String + index = userName + +testToFromRowsTripping :: TestTree +testToFromRowsTripping = testProperty "Ensure that `toRows` and `fromRows` are inverses" $ property $ do + users <- forAll $ Vector.fromList <$> + Gen.list (Range.linear 0 100) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + users === toRows (fromRows users) + +testLookup :: TestTree +testLookup = testProperty "Ensure that `lookup` works" $ property $ do + users <- forAll $ Vector.fromList <$> + Gen.list (Range.linear 0 100) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + -- This property only makes sense for a unique index + guard (unique (Vector.map userName users)) + + let df = fromRows users + + forM_ users $ \user -> do + Frame.lookup (userName user) df === Just user + + where + unique :: Ord a => Vector.Vector a -> Bool + unique vs = length (Set.fromList (Vector.toList vs)) == Vector.length vs + + +testFields :: TestTree +testFields = testCase "Appropriately accessing field names and values" $ do + let row = MkUser "Alice" 37 + assertEqual mempty ([("userName", "\"Alice\""), ("userAge", "37")]) (fields row) + + +testSortRowsBy :: TestTree +testSortRowsBy + = testGroup "sortRowsBy" + [ testSortRowsByUnit + , testSortRowsByIdempotence + ] + + where + testSortRowsByUnit :: TestTree + testSortRowsByUnit = testCase "sorting rows" $ do + let frame = fromRows [ MkUser "Clara" 39 + , MkUser "Bob" 38 + , MkUser "David" 40 + , MkUser "Alice" 37 + ] + expectation = fromRows [ MkUser "Alice" 37 + , MkUser "Bob" 38 + , MkUser "Clara" 39 + , MkUser "David" 40 + ] + + assertEqual mempty expectation (sortRowsBy (compare `on` userName) frame) + + testSortRowsByIdempotence :: TestTree + testSortRowsByIdempotence = testProperty "Sorting rows is idempotent" $ property $ do + users <- forAll $ Vector.fromList <$> + Gen.list (Range.linear 0 100) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + -- This property only makes sense for a unique index + guard (unique (Vector.map userName users)) + + let df = fromRows users + sorted = sortRowsBy (compare `on` userName) df + + sorted === (sortRowsBy (compare `on` userName) sorted) + + where + unique :: Ord a => Vector.Vector a -> Bool + unique vs = length (Set.fromList (Vector.toList vs)) == Vector.length vs + + +testSortRowsByKey :: TestTree +testSortRowsByKey + = testGroup "sortRowsByKey" + [ testSortRowsByKeyUnit + , testSortRowsByKeyUniqueOnUnit + , testSortRowsByKeyIdempotence + , testSortRowsByKeyUniqueOnIdempotence + ] + + where + testSortRowsByKeyUnit :: TestTree + testSortRowsByKeyUnit = testCase "sorting rows" $ do + let frame = fromRows [ MkUser "Clara" 39 + , MkUser "Bob" 38 + , MkUser "David" 40 + , MkUser "Alice" 37 + ] + expectation = fromRows [ MkUser "Alice" 37 + , MkUser "Bob" 38 + , MkUser "Clara" 39 + , MkUser "David" 40 + ] + + assertEqual mempty expectation (sortRowsByKey frame) + + testSortRowsByKeyUniqueOnUnit :: TestTree + testSortRowsByKeyUniqueOnUnit = testCase "sorting rows by mapping keys" $ do + let frame = fromRows [ MkUser "Clarice" 39 + , MkUser "Bobby" 38 + , MkUser "Davidson" 40 + , MkUser "Abe" 37 + ] + expectation = fromRows [ MkUser "Abe" 37 + , MkUser "Bobby" 38 + , MkUser "Clarice" 39 + , MkUser "Davidson" 40 + ] + + assertEqual mempty expectation (sortRowsByKeyUniqueOn (length) frame) + + testSortRowsByKeyIdempotence :: TestTree + testSortRowsByKeyIdempotence = testProperty "Sorting rows by key is idempotent" $ property $ do + users <- forAll $ Vector.fromList <$> + Gen.list (Range.linear 0 100) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + let df = fromRows users + sorted = sortRowsByKey df + + sorted === (sortRowsByKey sorted) + + + testSortRowsByKeyUniqueOnIdempotence :: TestTree + testSortRowsByKeyUniqueOnIdempotence + = testProperty "Sorting rows by mapping key is idempotent" + $ property + $ do + users <- forAll $ Vector.fromList <$> + Gen.list (Range.linear 0 100) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + let df = fromRows users + sorted = sortRowsByKeyUniqueOn length df + + sorted === (sortRowsByKeyUniqueOn length sorted) + + +testMergeWithStrategy :: TestTree +testMergeWithStrategy + = testGroup "mergeWithStrategy" + [ testMergeWithStrategyUnion + , testMergeWithStrategySelf + , testMergeWithStrategyOn + ] + where + testMergeWithStrategyUnion :: TestTree + testMergeWithStrategyUnion + = testProperty "The index of a merged dataframe contains a subset of the union of the indices" + $ property + $ do + + users1 <- fmap fromRows <$> forAll $ + Gen.list (Range.linear 0 50) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + users2 <- fmap fromRows <$> forAll $ + Gen.list (Range.linear 0 25) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + let merged = Frame.mergeWithStrategy strategy users1 users2 + mergedIx = Set.fromList $ Vector.toList (index merged) + ix1 = Set.fromList $ Vector.toList (index users1) + ix2 = Set.fromList $ Vector.toList (index users2) + + + assert (mergedIx `Set.isSubsetOf` (ix1 `Set.union` ix2)) + + where + strategy :: String -> These (Row User) (Row User) -> Maybe (Row User) + strategy _ (This left) = Just left + strategy _ (That right) = Just right + strategy name (These _ _) = Just $ MkUser name 18 + + testMergeWithStrategySelf :: TestTree + testMergeWithStrategySelf + = testProperty "Merging a dataframe onto itself should be the identity function if the index is unique" + $ property $ do + users <- fmap fromRows <$> forAll $ + Gen.list (Range.linear 0 50) + (MkUser <$> Gen.string (Range.linear 0 100) Gen.alpha + <*> Gen.integral (Range.linear 10 25) + ) + + Frame.mergeWithStrategy (Frame.matchedStrategy (\_ u _ -> u)) users users === Frame.sortRowsByKeyUnique users + + testMergeWithStrategyOn :: TestTree + testMergeWithStrategyOn = testCase "mergeWithStrategyOn" $ do + let users1 = fromRows [ MkUser "A" 39 + , MkUser "BB" 98 + , MkUser "CCC" 51 + , MkUser "DDDD" 37 + ] + users2 = fromRows [ MkUser "X" 1 + , MkUser "XXX" 3 + , MkUser "XX" 2 + , MkUser "XXXXXXXXX" 37 + ] + + expectation = fromRows [ MkUser "1" (39 + 1) + , MkUser "2" (98 + 2) + , MkUser "3" (51 + 3) + ] + -- We join the frames on the LENGTH of the names. + assertEqual mempty expectation + $ Frame.mergeWithStrategyOn length + length + (Frame.matchedStrategy $ \k (MkUser _ age1) (MkUser _ age2) -> MkUser (show k) (age1 + age2)) + users1 + users2 + +testDisplay :: TestTree +testDisplay = + let frame = fromRows [ MkUser "Alice" 37 + , MkUser "Bob" 38 + , MkUser "Clara" 39 + , MkUser "David" 40 + ] + in testGroup "displaytWith" [ + testCase "Appropriately displaying all rows" $ do + let displayed = Frame.displayWith (Frame.defaultDisplayOptions {maximumNumberOfRows = 4}) frame + expectation = unlines' [ "userName | userAge" + , "-------- | -------" + , " \"Alice\" | 37" + , " \"Bob\" | 38" + , " \"Clara\" | 39" + , " \"David\" | 40" + ] + + assertEqual mempty expectation displayed, + testCase "Appropriately eliding some rows" $ do + let displayed = Frame.displayWith (Frame.defaultDisplayOptions {maximumNumberOfRows = 2}) frame + expectation = unlines' [ "userName | userAge" + , "-------- | -------" + , " \"Alice\" | 37" + , " ... | ..." + , " \"David\" | 40" + ] + + assertEqual mempty expectation displayed + ] + where + unlines' = mconcat . List.intersperse "\n"